From 92ecc0adfac2fc4186e1ff28807be2b1105099fe Mon Sep 17 00:00:00 2001 From: Herman Rimm Date: Tue, 1 Oct 2024 13:35:08 +0200 Subject: [PATCH] gnu: build: file-systems: Return uuid records. * gnu/bootloader.scm (menu-entry->sexp, sexp->menu-entry): Swap order in match subprocedures. * gnu/build/file-systems.scm (ext2-superblock-uuid, linux-swap-superblock-uuid, bcachefs-superblock-external-uuid, btrfs-superblock-uuid, exfat-superblock-uuid, fat32-superblock-uuid, fat16-superblock-uuid, iso9660-superblock-uuid, jfs-superblock-uuid, f2fs-superblock-uuid, luks-header-uuid, ntfs-superblock-uuid, xfs-superblock-uuid): Wrap bytevector in uuid record. * gnu/build/image.scm (make-iso9660-image): Take uuid as string. * gnu/installer/parted.scm (user-partition->file-system): Do not provide uuid-type. * gnu/system/image.scm (system-iso9660-image): Convert uuid to string. * gnu/system/uuid.scm (dce-uuid->string, iso9660-uuid->string): Do not export. Change-Id: I35435de0d808e66e17fd9b54247a7a11a93ecd62 --- gnu/bootloader.scm | 4 +- gnu/build/file-systems.scm | 75 +++++++++++++++++++------------------- gnu/build/image.scm | 5 +-- gnu/installer/parted.scm | 2 +- gnu/services/base.scm | 4 +- gnu/system/image.scm | 2 +- gnu/system/uuid.scm | 2 - 7 files changed, 45 insertions(+), 49 deletions(-) diff --git a/gnu/bootloader.scm b/gnu/bootloader.scm index 5e4578add0..f602150506 100644 --- a/gnu/bootloader.scm +++ b/gnu/bootloader.scm @@ -185,7 +185,7 @@ (define (menu-entry->sexp entry) (define (device->sexp device) (match device ((? uuid? uuid) - `(uuid ,(uuid-type uuid) ,(uuid->string uuid))) + `(uuid ,(uuid->string uuid) ,(uuid-type uuid))) ((? file-system-label? label) `(label ,(file-system-label->string label))) (_ device))) @@ -229,7 +229,7 @@ (define (sexp->menu-entry sexp) (define subvol #f) (define (sexp->device device-sexp) (match device-sexp - (('uuid type uuid-string) + (('uuid uuid-string type) (uuid uuid-string type)) (('label label) (file-system-label label)) diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm index 41e1c9e282..a80894951d 100644 --- a/gnu/build/file-systems.scm +++ b/gnu/build/file-systems.scm @@ -230,8 +230,8 @@ (define EXT3_FEATURE_INCOMPAT_RECOVER #x0004) ;journal needs recovery (else (error "invalid ext2 superblock state" state))))) (define (ext2-superblock-uuid sblock) - "Return the UUID of ext2 superblock SBLOCK as a 16-byte bytevector." - (sub-bytevector sblock 104 16)) + "Return the for ext2 superblock SBLOCK." + (bytevector->uuid (sub-bytevector sblock 104 16) 'ext2)) (define (ext2-superblock-volume-name sblock) "Return the volume name of ext2 superblock SBLOCK as a string of at most 16 @@ -293,8 +293,8 @@ (define (read-linux-swap-superblock device) ;; See 'union swap_header' in 'include/linux/swap.h'. (define (linux-swap-superblock-uuid sblock) - "Return the UUID of Linux-swap superblock SBLOCK as a 16-byte bytevector." - (sub-bytevector sblock (+ 1024 4 4 4) 16)) + "Return the for Linux-swap superblock SBLOCK." + (bytevector->uuid (sub-bytevector sblock (+ 1024 4 4 4) 16))) (define (linux-swap-superblock-volume-name sblock) "Return the label of Linux-swap superblock SBLOCK as a string." @@ -363,9 +363,8 @@ (define (read-bcachefs-superblock device) (read-superblock device 4096 104 bcachefs-superblock?)) (define (bcachefs-superblock-external-uuid sblock) - "Return the external UUID of bcachefs superblock SBLOCK as a 16-byte -bytevector." - (sub-bytevector sblock 56 16)) + "Return the external UUID of bcachefs superblock SBLOCK as an ." + (bytevector->uuid (sub-bytevector sblock 56 16) 'bcachefs)) (define (bcachefs-superblock-volume-name sblock) "Return the volume name of bcachefs superblock SBLOCK as a string of at most @@ -416,8 +415,8 @@ (define (read-btrfs-superblock device) (read-superblock device 65536 4096 btrfs-superblock?)) (define (btrfs-superblock-uuid sblock) - "Return the UUID of a btrfs superblock SBLOCK as a 16-byte bytevector." - (sub-bytevector sblock 32 16)) + "Return the for a btrfs superblock SBLOCK." + (bytevector->uuid (sub-bytevector sblock 32 16) 'btrfs)) (define (btrfs-superblock-volume-name sblock) "Return the volume name of btrfs superblock SBLOCK as a string of at most 256 @@ -535,10 +534,11 @@ (define (exfat-superblock-volume-name sblock) #f)))) (define (exfat-superblock-uuid sblock) - "Return the Volume Serial Number of exFAT superblock SBLOCK as a bytevector. -This 4-byte identifier is guaranteed to exist, unlike the optional 16-byte -Volume GUID from section 7.5 of the exFAT specification." - (sub-bytevector sblock 100 4)) + "Return the Volume Serial Number of exFAT superblock SBLOCK as a + record. This 4-byte identifier is guaranteed to exist, unlike +the optional 16-byte Volume GUID from section 7.5 of the exFAT +specification." + (bytevector->uuid (sub-bytevector sblock 100 4) 'exfat)) (define (check-exfat-file-system device force? repair) "Return the health of an unmounted exFAT file system on DEVICE. If FORCE? @@ -576,8 +576,8 @@ (define (read-fat32-superblock device) (read-superblock device 0 90 fat32-superblock?)) (define (fat32-superblock-uuid sblock) - "Return the Volume ID of a fat superblock SBLOCK as a 4-byte bytevector." - (sub-bytevector sblock 67 4)) + "Return the Volume ID of a fat superblock SBLOCK as a record." + (bytevector->uuid (sub-bytevector sblock 67 4) 'fat32)) (define (fat32-superblock-volume-name sblock) "Return the volume name of fat superblock SBLOCK as a string of at most 11 @@ -616,8 +616,8 @@ (define (read-fat16-superblock device) (read-superblock device 0 62 fat16-superblock?)) (define (fat16-superblock-uuid sblock) - "Return the Volume ID of a fat superblock SBLOCK as a 4-byte bytevector." - (sub-bytevector sblock 39 4)) + "Return the Volume ID of a fat superblock SBLOCK as a record." + (bytevector->uuid (sub-bytevector sblock 39 4) 'fat16)) (define (fat16-superblock-volume-name sblock) "Return the volume name of fat superblock SBLOCK as a string of at most 11 @@ -667,7 +667,7 @@ (define (read-iso9660-superblock device) (define (iso9660-superblock-uuid sblock) "Return the modification time of an iso9660 primary volume descriptor -SBLOCK as a bytevector. If that's not set, returns the creation time." +SBLOCK as a . If that's not set, returns the creation time." ;; Drops GMT offset for compatibility with Grub, blkid and /dev/disk/by-uuid. ;; Compare Grub: "2014-12-02-19-30-23-00". ;; Compare blkid result: "2014-12-02-19-30-23-00". @@ -678,7 +678,7 @@ (define (iso9660-superblock-uuid sblock) (time (if (bytevector=? unset-time modification-time) creation-time modification-time))) - (sub-bytevector time 0 16))) ; strips GMT offset. + (bytevector->uuid (sub-bytevector time 0 16)) 'iso9660)) ; strips GMT offset. (define (iso9660-superblock-volume-name sblock) "Return the volume name of iso9660 superblock SBLOCK as a string. The volume @@ -709,8 +709,8 @@ (define (read-jfs-superblock device) (read-superblock device 32768 184 jfs-superblock?)) (define (jfs-superblock-uuid sblock) - "Return the UUID of JFS superblock SBLOCK as a 16-byte bytevector." - (sub-bytevector sblock 136 16)) + "Return the for JFS superblock SBLOCK." + (bytevector->uuid (sub-bytevector sblock 136 16) 'jfs)) (define (jfs-superblock-volume-name sblock) "Return the volume name of JFS superblock SBLOCK as a string of at most 16 @@ -775,12 +775,13 @@ (define (read-f2fs-superblock device) f2fs-superblock?)) (define (f2fs-superblock-uuid sblock) - "Return the UUID of F2FS superblock SBLOCK as a 16-byte bytevector." - (sub-bytevector sblock - (- (+ #x460 12) - ;; subtract superblock offset - #x400) - 16)) + "Return the for F2FS superblock SBLOCK." + (bytevector->uuid (sub-bytevector sblock + (- (+ #x460 12) + ;; subtract superblock offset + #x400) + 16) + 'f2fs)) (define (f2fs-superblock-volume-name sblock) "Return the volume name of F2FS superblock SBLOCK as a string of at most 512 @@ -847,11 +848,10 @@ (define (read-luks-header file) (read-superblock file 0 592 luks-superblock?)) (define (luks-header-uuid header) - "Return the LUKS UUID from HEADER, as a 16-byte bytevector." - ;; 40 bytes are reserved for the UUID, but in practice, it contains the 36 - ;; bytes of its ASCII representation. - (let ((uuid (sub-bytevector header 168 36))) - (string->uuid (utf8->string uuid)))) + "Return the LUKS UUID from HEADER, as a record." + ;; 40 bytes are reserved for the UUID, but in practice, it contains + ;; the 36 bytes of its ASCII representation. + (bytevector->uuid (utf8->string (sub-bytevector header 168 36)) 'luks)) ;;; @@ -875,8 +875,8 @@ (define (read-ntfs-superblock device) (read-superblock device 0 511 ntfs-superblock?)) (define (ntfs-superblock-uuid sblock) - "Return the UUID of NTFS superblock SBLOCK as a 8-byte bytevector." - (sub-bytevector sblock 72 8)) + "Return the for the NTFS superblock SBLOCK." + (bytevector->uuid (sub-bytevector sblock 72 8) 'ntfs)) ;; TODO: Add ntfs-superblock-volume-name. The partition label is not stored ;; in the BOOT SECTOR like the UUID, but in the MASTER FILE TABLE, which seems @@ -917,8 +917,8 @@ (define (read-xfs-superblock device) (read-superblock device 0 120 xfs-superblock?)) (define (xfs-superblock-uuid sblock) - "Return the UUID of XFS superblock SBLOCK as a 16-byte bytevector." - (sub-bytevector sblock 32 16)) + "Return the for XFS superblock SBLOCK." + (bytevector->uuid (sub-bytevector sblock 32 16) 'xfs)) (define (xfs-superblock-volume-name sblock) "Return the volume name of XFS superblock SBLOCK as a string of at most 12 @@ -1178,8 +1178,7 @@ (define (resolve find-partition spec fmt) identity)) ((? uuid?) (resolve find-partition-by-uuid - (uuid-bytevector spec) - uuid->string)))) + spec uuid->string)))) (define (check-file-system device type force? repair) "Check an unmounted TYPE file system on DEVICE. Do nothing but warn if it is diff --git a/gnu/build/image.scm b/gnu/build/image.scm index 0b4dbc87ac..f1482d2c1d 100644 --- a/gnu/build/image.scm +++ b/gnu/build/image.scm @@ -281,7 +281,7 @@ (define grub-mkrescue-sed.sh ;; On 32-bit systems the 2nd argument must be ;; lower than 2^32. - (string-hash (iso9660-uuid->string volume-uuid) + (string-hash volume-uuid (- (expt 2 32) 1)) #x77777777) @@ -329,6 +329,5 @@ (define grub-mkrescue-sed.sh `("-volume_date" "uuid" ,(string-filter (lambda (value) (not (char=? #\- value))) - (iso9660-uuid->string - volume-uuid))) + volume-uuid)) '())))) diff --git a/gnu/installer/parted.scm b/gnu/installer/parted.scm index da19a57878..bfcddd22aa 100644 --- a/gnu/installer/parted.scm +++ b/gnu/installer/parted.scm @@ -1418,7 +1418,7 @@ (define (user-partition->file-system user-partition) (upper-file-name (user-partition-upper-file-name user-partition)) ;; Only compute uuid if partition is not encrypted. (uuid (or crypt-label - (uuid->string (read-partition-uuid file-name) fs-type)))) + (uuid->string (read-partition-uuid file-name))))) `(file-system (mount-point ,mount-point) (device ,@(if crypt-label diff --git a/gnu/services/base.scm b/gnu/services/base.scm index 819d063673..dcd2213b1d 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -2626,7 +2626,7 @@ (define device-lookup (cond ((swap-space? swap) (let ((target (swap-space-target swap))) (cond ((uuid? target) - #~(find-partition-by-uuid #$(uuid-bytevector target))) + #~(find-partition-by-uuid #$target)) ((file-system-label? target) #~(find-partition-by-label #$(file-system-label->string target))) @@ -2634,7 +2634,7 @@ (define device-lookup target)))) ; TODO Remove after deprecation ((uuid? swap) - #~(find-partition-by-uuid #$(uuid-bytevector swap))) + #~(find-partition-by-uuid #$swap)) ((file-system-label? swap) #~(find-partition-by-label #$(file-system-label->string swap))) diff --git a/gnu/system/image.scm b/gnu/system/image.scm index 6201b36334..d70078c102 100644 --- a/gnu/system/image.scm +++ b/gnu/system/image.scm @@ -620,7 +620,7 @@ (define root-label (define root-uuid (match (image-partitions image) ((partition) - (uuid-bytevector (partition-uuid partition))))) + (and=> (partition-uuid partition) uuid->string)))) (let* ((os (image-operating-system image)) (compression? (image-compression? image)) diff --git a/gnu/system/uuid.scm b/gnu/system/uuid.scm index e6add06aba..432c2e82f7 100644 --- a/gnu/system/uuid.scm +++ b/gnu/system/uuid.scm @@ -35,7 +35,6 @@ (define-module (gnu system uuid) bytevector->uuid uuid->string - dce-uuid->string string->uuid string->dce-uuid string->iso9660-uuid @@ -48,7 +47,6 @@ (define-module (gnu system uuid) string->jfs-uuid string->ntfs-uuid string->xfs-uuid - iso9660-uuid->string ;; XXX: For lack of a better place. sub-bytevector