diff options
Diffstat (limited to 'gnu/installer/parted.scm')
| -rw-r--r-- | gnu/installer/parted.scm | 115 |
1 files changed, 71 insertions, 44 deletions
diff --git a/gnu/installer/parted.scm b/gnu/installer/parted.scm index b0c73b837e..9ef263d1f9 100644 --- a/gnu/installer/parted.scm +++ b/gnu/installer/parted.scm @@ -36,10 +36,12 @@ #:use-module (guix utils) #:use-module (guix i18n) #:use-module (parted) + #:use-module (ice-9 format) #:use-module (ice-9 match) #:use-module (ice-9 regex) #:use-module (rnrs io ports) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-19) #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) @@ -317,7 +319,7 @@ PARTED-OBJECT field equals PARTITION, return #f if not found." fail. See rereadpt function in wipefs.c of util-linux for an explanation." ;; Kernel always return EINVAL for BLKRRPART on loopdevices. (and (not (string-match "/dev/loop*" file-name)) - (let loop ((try 4)) + (let loop ((try 16)) (usleep 250000) (let ((in-use? (device-in-use? file-name))) (if (and in-use? (> try 0)) @@ -338,15 +340,12 @@ fail. See rereadpt function in wipefs.c of util-linux for an explanation." (define (non-install-devices) "Return all the available devices, except the busy one, allegedly the install device. DEVICE-IS-BUSY? is a parted call, checking if the device is -mounted. The install image uses an overlayfs so the install device does not -appear as mounted and won't be considered as busy. So use also DEVICE-IN-USE? -from (guix build syscalls) module, who will try to re-read the device's -partition table to determine whether or not it is already used (like sfdisk -from util-linux)." +mounted." + ;; FIXME: The install image uses an overlayfs so the install device does not + ;; appear as mounted and won't be considered as busy. (remove (lambda (device) (let ((file-name (device-path device))) - (or (device-is-busy? device) - (with-delay-device-in-use? file-name)))) + (device-is-busy? device))) (devices))) @@ -526,56 +525,54 @@ determined by MAX-LENGTH-COLUMN procedure." (size (user-partition-size user-partition)) (mount-point (user-partition-mount-point user-partition))) `(,@(if has-name? - `((name . ,(string-append "Name: " (or name "None")))) + `((name . ,(format #f (G_ "Name: ~a") + (or name (G_ "None"))))) '()) ,@(if (and has-extended? (freespace-partition? partition) (not (eq? type 'logical))) - `((type . ,(string-append "Type: " type-name))) + `((type . ,(format #f (G_ "Type: ~a") type-name))) '()) ,@(if (eq? type 'extended) '() - `((fs-type . ,(string-append "Filesystem type: " fs-type-name)))) + `((fs-type . ,(format #f (G_ "File system type: ~a") + fs-type-name)))) ,@(if (or (eq? type 'extended) (eq? fs-type 'swap) (not has-extended?)) '() - `((bootable . ,(string-append "Bootable flag: " - (if bootable? "On" "Off"))))) + `((bootable . ,(format #f (G_ "Bootable flag: ~:[off~;on~]") + bootable?)))) ,@(if (and (not has-extended?) (not (eq? fs-type 'swap))) - `((esp? . ,(string-append "ESP flag: " - (if esp? "On" "Off")))) + `((esp? . ,(format #f (G_ "ESP flag: ~:[off~;on~]") esp?))) '()) ,@(if (freespace-partition? partition) (let ((size-formatted - (or size (unit-format device + (or size (unit-format device ;XXX: i18n (partition-length partition))))) - `((size . ,(string-append "Size : " size-formatted)))) + `((size . ,(format #f (G_ "Size: ~a") size-formatted)))) '()) ,@(if (or (eq? type 'extended) (eq? fs-type 'swap)) '() `((crypt-label - . ,(string-append - "Encryption: " - (if crypt-label - (format #f "Yes (label ~a)" crypt-label) - "No"))))) + . ,(format #f (G_ "Encryption: ~:[No~a~;Yes (label '~a')~]") + crypt-label (or crypt-label ""))))) ,@(if (or (freespace-partition? partition) (eq? fs-type 'swap)) '() `((need-formatting? - . ,(string-append "Format the partition? : " - (if need-formatting? "Yes" "No"))))) + . ,(format #f (G_ "Format the partition? ~:[No~;Yes~]") + need-formatting?)))) ,@(if (or (eq? type 'extended) (eq? fs-type 'swap)) '() `((mount-point - . ,(string-append "Mount point : " - (or mount-point - (and esp? (default-esp-mount-point)) - "None")))))))) + . ,(format #f (G_ "Mount point: ~a") + (or mount-point + (and esp? (default-esp-mount-point)) + (G_ "None"))))))))) ;; @@ -759,11 +756,33 @@ cause them to cross." dev-constraint)) (no-constraint (constraint-any device)) ;; Try to create a partition with an optimal alignment - ;; constraint. If it fails, fallback to creating a partition with - ;; no specific constraint. + ;; constraint. If it fails, fallback to creating a partition + ;; with no specific constraint. + (partition-constraint-ok? + (disk-add-partition disk partition final-constraint)) + (partition-no-contraint-ok? + (or partition-constraint-ok? + (disk-add-partition disk partition no-constraint))) (partition-ok? - (or (disk-add-partition disk partition final-constraint) - (disk-add-partition disk partition no-constraint)))) + (or partition-constraint-ok? partition-no-contraint-ok?))) + (syslog "Creating partition: +~/type: ~a +~/filesystem-type: ~a +~/start: ~a +~/end: ~a +~/start-range: [~a, ~a] +~/end-range: [~a, ~a] +~/constraint: ~a +~/no-constraint: ~a +" + partition-type + (filesystem-type-name filesystem-type) + start-sector* + end-sector + (geometry-start start-range) (geometry-end start-range) + (geometry-start end-range) (geometry-end end-range) + partition-constraint-ok? + partition-no-contraint-ok?) ;; Set the partition name if supported. (when (and partition-ok? has-name? name) (partition-set-name partition name)) @@ -911,13 +930,13 @@ exists." (let* ((start-partition (and (not has-extended?) - (not esp-partition) (if (efi-installation?) - (user-partition - (fs-type 'fat32) - (esp? #t) - (size new-esp-size) - (mount-point (default-esp-mount-point))) + (and (not esp-partition) + (user-partition + (fs-type 'fat32) + (esp? #t) + (size new-esp-size) + (mount-point (default-esp-mount-point)))) (user-partition (fs-type 'ext4) (bootable? #t) @@ -1327,7 +1346,12 @@ USER-PARTITIONS, or return nothing." ,@(initrd-configuration user-partitions) ,@(if (null? swap-devices) '() - `((swap-devices (list ,@swap-devices)))) + (let* ((uuids (map (lambda (file) + (uuid->string (read-partition-uuid file))) + swap-devices))) + `((swap-devices (list ,@(map (lambda (uuid) + `(uuid ,uuid)) + uuids)))))) ,@(if (null? encrypted-partitions) '() `((mapped-devices @@ -1364,9 +1388,12 @@ the devices not to be used before returning." (let ((device-file-names (map device-path devices))) (for-each force-device-sync devices) (for-each (lambda (file-name) - (let ((in-use? (with-delay-device-in-use? file-name))) - (and in-use? - (error - (format #f (G_ "Device ~a is still in use.") - file-name))))) + (let/time ((time in-use? + (with-delay-device-in-use? file-name))) + (if in-use? + (error + (format #f (G_ "Device ~a is still in use.") + file-name)) + (syslog "Syncing ~a took ~a seconds.~%" + file-name (time-second time))))) device-file-names))) |