From b624206d6bfadd99ea903a35fe1d3e7fc11b5ba3 Mon Sep 17 00:00:00 2001 From: Mathieu Othacehe Date: Thu, 6 Dec 2018 12:05:42 +0900 Subject: installer: partition: Fix swaping and use syscalls. * 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. --- gnu/installer/parted.scm | 67 +++++++++++++++++++++--------------------------- 1 file changed, 29 insertions(+), 38 deletions(-) (limited to 'gnu') diff --git a/gnu/installer/parted.scm b/gnu/installer/parted.scm index 3fe938124f..b0fe672131 100644 --- a/gnu/installer/parted.scm +++ b/gnu/installer/parted.scm @@ -1013,16 +1013,6 @@ (define (create-swap-partition partition) (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 records in USER-PARTITIONS list with NEED-FORMATING? field set to #t." @@ -1060,8 +1050,7 @@ (define (sort-partitions user-partitions) (define (mount-user-partitions user-partitions) "Mount the records in USER-PARTITIONS list on their -respective mount-points. Also start swaping on 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 @@ (define (mount-user-partitions user-partitions) (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 records in USER-PARTITIONS list. Also stop -swaping on with FS-TYPE set to 'swap." + "Unmount all the 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 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 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 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 @@ (define (user-partitions->file-systems user-partitions) (user-partition->file-system user-partition)))) user-partitions)) -(define (find-swap-user-partitions user-partitions) - "Return the subset of 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 -- cgit v1.2.3