mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2025-01-12 06:06:53 -05:00
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.
This commit is contained in:
parent
a7b2a4649f
commit
b624206d6b
1 changed files with 29 additions and 38 deletions
|
@ -1013,16 +1013,6 @@ (define (create-swap-partition partition)
|
||||||
(with-null-output-ports
|
(with-null-output-ports
|
||||||
(invoke "mkswap" "-f" partition)))
|
(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)
|
(define (format-user-partitions user-partitions)
|
||||||
"Format the <user-partition> records in USER-PARTITIONS list with
|
"Format the <user-partition> records in USER-PARTITIONS list with
|
||||||
NEED-FORMATING? field set to #t."
|
NEED-FORMATING? field set to #t."
|
||||||
|
@ -1060,8 +1050,7 @@ (define (sort-partitions user-partitions)
|
||||||
|
|
||||||
(define (mount-user-partitions user-partitions)
|
(define (mount-user-partitions user-partitions)
|
||||||
"Mount the <user-partition> records in USER-PARTITIONS list on their
|
"Mount the <user-partition> records in USER-PARTITIONS list on their
|
||||||
respective mount-points. Also start swaping on <user-partition> records with
|
respective mount-points."
|
||||||
FS-TYPE equal to 'swap."
|
|
||||||
(let* ((mount-partitions (filter user-partition-mount-point user-partitions))
|
(let* ((mount-partitions (filter user-partition-mount-point user-partitions))
|
||||||
(sorted-partitions (sort-partitions mount-partitions)))
|
(sorted-partitions (sort-partitions mount-partitions)))
|
||||||
(for-each (lambda (user-partition)
|
(for-each (lambda (user-partition)
|
||||||
|
@ -1075,44 +1064,54 @@ (define (mount-user-partitions user-partitions)
|
||||||
(mount-type
|
(mount-type
|
||||||
(user-fs-type->mount-type fs-type))
|
(user-fs-type->mount-type fs-type))
|
||||||
(path (user-partition-path user-partition)))
|
(path (user-partition-path user-partition)))
|
||||||
(case fs-type
|
(mkdir-p target)
|
||||||
((swap)
|
(mount path target mount-type)))
|
||||||
(start-swaping path))
|
|
||||||
(else
|
|
||||||
(mkdir-p target)
|
|
||||||
(mount path target mount-type)))))
|
|
||||||
sorted-partitions)))
|
sorted-partitions)))
|
||||||
|
|
||||||
(define (umount-user-partitions user-partitions)
|
(define (umount-user-partitions user-partitions)
|
||||||
"Unmount all the <user-partition> records in USER-PARTITIONS list. Also stop
|
"Unmount all the <user-partition> records in USER-PARTITIONS list."
|
||||||
swaping on <user-partition> with FS-TYPE set to 'swap."
|
|
||||||
(let* ((mount-partitions (filter user-partition-mount-point user-partitions))
|
(let* ((mount-partitions (filter user-partition-mount-point user-partitions))
|
||||||
(sorted-partitions (sort-partitions mount-partitions)))
|
(sorted-partitions (sort-partitions mount-partitions)))
|
||||||
(for-each (lambda (user-partition)
|
(for-each (lambda (user-partition)
|
||||||
(let* ((mount-point
|
(let* ((mount-point
|
||||||
(user-partition-mount-point user-partition))
|
(user-partition-mount-point user-partition))
|
||||||
(fs-type
|
|
||||||
(user-partition-fs-type user-partition))
|
|
||||||
(path (user-partition-path user-partition))
|
|
||||||
(target
|
(target
|
||||||
(string-append (%installer-target-dir)
|
(string-append (%installer-target-dir)
|
||||||
mount-point)))
|
mount-point)))
|
||||||
(case fs-type
|
(umount target)))
|
||||||
((swap)
|
|
||||||
(stop-swaping path))
|
|
||||||
(else
|
|
||||||
(umount target)))))
|
|
||||||
(reverse sorted-partitions))))
|
(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 ...)
|
(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
|
(dynamic-wind
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(mount-user-partitions user-partitions))
|
(mount-user-partitions user-partitions)
|
||||||
|
(start-swapping user-partitions))
|
||||||
(lambda ()
|
(lambda ()
|
||||||
exp ...)
|
exp ...)
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(umount-user-partitions user-partitions)
|
(umount-user-partitions user-partitions)
|
||||||
|
(stop-swapping user-partitions)
|
||||||
#f)))
|
#f)))
|
||||||
|
|
||||||
(define (user-partition->file-system user-partition)
|
(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-partition->file-system user-partition))))
|
||||||
user-partitions))
|
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)
|
(define (bootloader-configuration user-partitions)
|
||||||
"Return the bootloader configuration field for USER-PARTITIONS."
|
"Return the bootloader configuration field for USER-PARTITIONS."
|
||||||
(let* ((root-partition
|
(let* ((root-partition
|
||||||
|
|
Loading…
Reference in a new issue