summaryrefslogtreecommitdiff
path: root/gnu/installer/parted.scm
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 /gnu/installer/parted.scm
parenta7b2a4649fdbc4c9d2e49c6ee3b0e9a94048861c (diff)
downloadguix-patches-b624206d6bfadd99ea903a35fe1d3e7fc11b5ba3.tar
guix-patches-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.
Diffstat (limited to 'gnu/installer/parted.scm')
-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