ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-07 07:26:13 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

gnu: build: file-systems: Return uuid records.

Browse source 
* 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
This commit is contained in:
Herman Rimm 2024-10-01 13:35:08 +02:00 committed by Ryan Schanzenbacher
parent ecbf0794d7
commit 92ecc0adfa
Signed by: ryan77627
GPG key ID: 81B0E222A3E2308E
7 changed files with 45 additions and 49 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
gnu/bootloader.scm
View file

@ -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))

69
gnu/build/file-systems.scm
View file

@ -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 <uuid> 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 <uuid> 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 <uuid>."
(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 <uuid> 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
<uuid> 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 <uuid> 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 <uuid> 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 <uuid>. 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 <uuid> 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
"Return the <uuid> for F2FS superblock SBLOCK."
(bytevector->uuid (sub-bytevector sblock
(- (+ #x460 12)
;; subtract superblock offset
#x400)
16))
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 <uuid> 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 <uuid> 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 <uuid> 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

5
gnu/build/image.scm
View file

@ -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))
'()))))

2
gnu/installer/parted.scm
View file

@ -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

4
gnu/services/base.scm
View file

@ -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)))

2
gnu/system/image.scm
View file

@ -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))

2
gnu/system/uuid.scm
View file

@ -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