uuid: Support XFS.

* gnu/system/uuid.scm (string->xfs-uuid): New procedure.
(%uuid-parsers, %uuid-printers): Add ‘xfs’ file system type.
This commit is contained in:
Tobias Geerinckx-Rice 2021-09-23 13:16:39 +02:00
parent 2a9db30eec
commit 90604348e1
No known key found for this signature in database
GPG key ID: 0DB0FF884F556D79

View file

@ -47,6 +47,7 @@ (define-module (gnu system uuid)
string->fat-uuid string->fat-uuid
string->jfs-uuid string->jfs-uuid
string->ntfs-uuid string->ntfs-uuid
string->xfs-uuid
iso9660-uuid->string iso9660-uuid->string
;; XXX: For lack of a better place. ;; XXX: For lack of a better place.
@ -239,7 +240,9 @@ (define string->ext3-uuid string->dce-uuid)
(define string->ext4-uuid string->dce-uuid) (define string->ext4-uuid string->dce-uuid)
(define string->bcachefs-uuid string->dce-uuid) (define string->bcachefs-uuid string->dce-uuid)
(define string->btrfs-uuid string->dce-uuid) (define string->btrfs-uuid string->dce-uuid)
(define string->f2fs-uuid string->dce-uuid)
(define string->jfs-uuid string->dce-uuid) (define string->jfs-uuid string->dce-uuid)
(define string->xfs-uuid string->dce-uuid)
(define-syntax vhashq (define-syntax vhashq
(syntax-rules (=>) (syntax-rules (=>)
@ -253,14 +256,16 @@ (define-syntax vhashq
(define %uuid-parsers (define %uuid-parsers
(vhashq (vhashq
('dce 'ext2 'ext3 'ext4 'bcachefs 'btrfs 'jfs 'luks => string->dce-uuid) ('dce 'ext2 'ext3 'ext4 'bcachefs 'btrfs 'f2fs 'jfs 'xfs 'luks
=> string->dce-uuid)
('fat32 'fat16 'fat => string->fat-uuid) ('fat32 'fat16 'fat => string->fat-uuid)
('ntfs => string->ntfs-uuid) ('ntfs => string->ntfs-uuid)
('iso9660 => string->iso9660-uuid))) ('iso9660 => string->iso9660-uuid)))
(define %uuid-printers (define %uuid-printers
(vhashq (vhashq
('dce 'ext2 'ext3 'ext4 'bcachefs 'btrfs 'jfs 'luks => dce-uuid->string) ('dce 'ext2 'ext3 'ext4 'bcachefs 'btrfs 'f2fs 'jfs 'xfs 'luks
=> dce-uuid->string)
('iso9660 => iso9660-uuid->string) ('iso9660 => iso9660-uuid->string)
('fat32 'fat16 'fat => fat-uuid->string) ('fat32 'fat16 'fat => fat-uuid->string)
('ntfs => ntfs-uuid->string))) ('ntfs => ntfs-uuid->string)))