summary refs log tree commit diff
diff options
context:
space:
mode:
authorMathieu Othacehe <m.othacehe@gmail.com>2018-12-06 12:05:42 +0900
committerLudovic Courtès <ludo@gnu.org>2019-01-17 14:04:26 +0100
commitb624206d6bfadd99ea903a35fe1d3e7fc11b5ba3 (patch)
tree4e434dbb5f5b4f86a600ccff0ccf7a4cc7ca8c8c
parenta7b2a4649fdbc4c9d2e49c6ee3b0e9a94048861c (diff)
downloadguix-b624206d6bfadd99ea903a35fe1d3e7fc11b5ba3.tar.gz
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.
-rw-r--r--gnu/installer/parted.scm67
1 files changed, 29 insertions, 38 deletions
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 @@ 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