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 @@ bit bucket." | ||||||
|   (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 @@ comes last. This is useful to mount/umount partitions in a coherent order." | ||||||
| 
 | 
 | ||||||
| (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 @@ FS-TYPE equal to 'swap." | ||||||
|                        (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 @@ list of <file-system> records." | ||||||
|             (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 | ||||||
|  |  | ||||||
		Reference in a new issue