[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
50/68: installer: partition: Fix swaping and use syscalls.
From: |
guix-commits |
Subject: |
50/68: installer: partition: Fix swaping and use syscalls. |
Date: |
Thu, 17 Jan 2019 08:05:19 -0500 (EST) |
civodul pushed a commit to branch master
in repository guix.
commit b624206d6bfadd99ea903a35fe1d3e7fc11b5ba3
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
- 56/68: installer: Various renamings., (continued)
- 56/68: installer: Various renamings., guix-commits, 2019/01/17
- 52/68: installer: partionment: Add encryption support., guix-commits, 2019/01/17
- 27/68: installer: Add new pages., guix-commits, 2019/01/17
- 57/68: installer: Various renamins follow-up., guix-commits, 2019/01/17
- 44/68: installer: partition: Differenciate Back button from Exit button., guix-commits, 2019/01/17
- 28/68: installer: Redirect to TTY3 root shell for unguided install., guix-commits, 2019/01/17
- 58/68: installer: parted: Do not call BLKRRPART on loop devices., guix-commits, 2019/01/17
- 53/68: installer: Clear screen upon exit., guix-commits, 2019/01/17
- 49/68: installer: menu: Fix typo., guix-commits, 2019/01/17
- 43/68: installer: network: Do not show an empty technology list., guix-commits, 2019/01/17
- 50/68: installer: partition: Fix swaping and use syscalls.,
guix-commits <=
- 51/68: installer: partition: Fix typo., guix-commits, 2019/01/17
- 55/68: installer: parted: Use read-luks-partition-uuid instead of find-partition-by-luks-uuid., guix-commits, 2019/01/17
- 30/68: installer: Fix comments., guix-commits, 2019/01/17
- 59/68: installer: Rename "Ok" buttons to "OK"., guix-commits, 2019/01/17
- 47/68: installer: Display an eventual backtrace in a page., guix-commits, 2019/01/17
- 26/68: installer: Add hostname., guix-commits, 2019/01/17
- 10/68: guix: self: Do not install (gnu system install)., guix-commits, 2019/01/17
- 25/68: installer: Add services page., guix-commits, 2019/01/17
- 11/68: gnu: installer: Launch the installer as kmscon login-program., guix-commits, 2019/01/17
- 13/68: installer: Move everything to the build side., guix-commits, 2019/01/17