01/01: installer: partition: Fix swaping and use syscalls.

[guix-commits]

mothacehe pushed a commit to branch wip-newt-installer
in repository guix.

commit 1100fa0b608eea7477403f2c6f3c9ae3811ee92c
Author: Mathieu Othacehe <address@hidden>
Date:   Thu Dec 6 12:05:42 2018 +0900

    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(-)

diff --git a/gnu/installer/parted.scm b/gnu/installer/parted.scm
index 3fe9381..b0fe672 100644
--- a/gnu/installer/parted.scm
+++ b/gnu/installer/parted.scm
@@ -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