me/guix
Archived
1
0
Fork 0
Code Activity

installer: partition: Fix swaping and use syscalls.

Browse source 
* gnu/installer/parted.scm (start-swaping): Remove it,
(stop-swaping): Remove it,
(start-swapping): New procedure using swapon syscall,
(stop-swapping): New procedure using swapoff syscall,
(with-mounted-partitions): Use previous start-swapping and stop-swapping
procedures.
This commit is contained in:
Mathieu Othacehe 2018-12-06 12:05:42 +09:00 • committed by Ludovic Courtès
parent a7b2a4649f
commit b624206d6b
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 29 additions and 38 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

67
gnu/installer/parted.scm
View file

@ -1013,16 +1013,6 @@ bit bucket."
(with-null-output-ports
(invoke "mkswap" "-f" partition)))
(define (start-swaping partition)
"Start swaping on PARTITION path."
(with-null-output-ports
(invoke "swapon" partition)))
(define (stop-swaping partition)
"Stop swaping on PARTITION path."
(with-null-output-ports
(invoke "swapoff" partition)))
(define (format-user-partitions user-partitions)
"Format the <user-partition> records in USER-PARTITIONS list with
NEED-FORMATING? field set to #t."
@ -1060,8 +1050,7 @@ comes last. This is useful to mount/umount partitions in a coherent order."
(define (mount-user-partitions user-partitions)
"Mount the <user-partition> records in USER-PARTITIONS list on their
respective mount-points. Also start swaping on <user-partition> records with
FS-TYPE equal to 'swap."
respective mount-points."
(let* ((mount-partitions (filter user-partition-mount-point user-partitions))
(sorted-partitions (sort-partitions mount-partitions)))
(for-each (lambda (user-partition)
@ -1075,44 +1064,54 @@ FS-TYPE equal to 'swap."
(mount-type
(user-fs-type->mount-type fs-type))
(path (user-partition-path user-partition)))
(case fs-type
((swap)
(start-swaping path))
(else
(mkdir-p target)
(mount path target mount-type)))))
(mkdir-p target)
(mount path target mount-type)))
sorted-partitions)))
(define (umount-user-partitions user-partitions)
"Unmount all the <user-partition> records in USER-PARTITIONS list. Also stop
swaping on <user-partition> with FS-TYPE set to 'swap."
"Unmount all the <user-partition> records in USER-PARTITIONS list."
(let* ((mount-partitions (filter user-partition-mount-point user-partitions))
(sorted-partitions (sort-partitions mount-partitions)))
(for-each (lambda (user-partition)
(let* ((mount-point
(user-partition-mount-point user-partition))
(fs-type
(user-partition-fs-type user-partition))
(path (user-partition-path user-partition))
(target
(string-append (%installer-target-dir)
mount-point)))
(case fs-type
((swap)
(stop-swaping path))
(else
(umount target)))))
(umount target)))
(reverse sorted-partitions))))
(define (find-swap-user-partitions user-partitions)
"Return the subset of <user-partition> records in USER-PARTITIONS list with
the FS-TYPE field set to 'swap, return the empty list if none found."
(filter (lambda (user-partition)
(let ((fs-type (user-partition-fs-type user-partition)))
(eq? fs-type 'swap)))
user-partitions))
(define (start-swapping user-partitions)
"Start swaping on <user-partition> records with FS-TYPE equal to 'swap."
(let* ((swap-user-partitions (find-swap-user-partitions user-partitions))
(swap-devices (map user-partition-path swap-user-partitions)))
(for-each swapon swap-devices)))
(define (stop-swapping user-partitions)
"Stop swaping on <user-partition> records with FS-TYPE equal to 'swap."
(let* ((swap-user-partitions (find-swap-user-partitions user-partitions))
(swap-devices (map user-partition-path swap-user-partitions)))
(for-each swapoff swap-devices)))
(define-syntax-rule (with-mounted-partitions user-partitions exp ...)
"Mount USER-PARTITIONS within the dynamic extent of EXP."
"Mount USER-PARTITIONS and start swapping within the dynamic extent of EXP."
(dynamic-wind
(lambda ()
(mount-user-partitions user-partitions))
(mount-user-partitions user-partitions)
(start-swapping user-partitions))
(lambda ()
exp ...)
(lambda ()
(umount-user-partitions user-partitions)
(stop-swapping user-partitions)
#f)))
(define (user-partition->file-system user-partition)
@ -1140,14 +1139,6 @@ list of <file-system> records."
(user-partition->file-system user-partition))))
user-partitions))
(define (find-swap-user-partitions user-partitions)
"Return the subset of <user-partition> records in USER-PARTITIONS list with
the FS-TYPE field set to 'swap, return the empty list if none found."
(filter (lambda (user-partition)
(let ((fs-type (user-partition-fs-type user-partition)))
(eq? fs-type 'swap)))
user-partitions))
(define (bootloader-configuration user-partitions)
"Return the bootloader configuration field for USER-PARTITIONS."
(let* ((root-partition