mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-11-07 07:26:13 -05:00
gnu: build: file-systems: Add find-uuid procedure.
* gnu/build/file-systems.scm (block-devices, uuids, find-uuid): Add procedures. * gnu/system/uuid.scm (file-system->uuid-type): Add procedure. Change-Id: I8b4f3ad9fe5138d5c09ce24ded70fa53364550dc
This commit is contained in:
parent
92ecc0adfa
commit
5b7b514e4d
2 changed files with 32 additions and 3 deletions
|
@ -9,6 +9,7 @@
|
||||||
;;; Copyright © 2022 Oleg Pykhalov <go.wigust@gmail.com>
|
;;; Copyright © 2022 Oleg Pykhalov <go.wigust@gmail.com>
|
||||||
;;; Copyright © 2024 Nicolas Graves <ngraves@ngraves.fr>
|
;;; Copyright © 2024 Nicolas Graves <ngraves@ngraves.fr>
|
||||||
;;; Copyright © 2024 Richard Sent <richard@freakingpenguin.com>
|
;;; Copyright © 2024 Richard Sent <richard@freakingpenguin.com>
|
||||||
|
;;; Copyright © 2024 Herman Rimm <herman@rimm.ee>
|
||||||
;;;
|
;;;
|
||||||
;;; This file is part of GNU Guix.
|
;;; This file is part of GNU Guix.
|
||||||
;;;
|
;;;
|
||||||
|
@ -45,6 +46,7 @@ (define-module (gnu build file-systems)
|
||||||
#:use-module (srfi srfi-1)
|
#:use-module (srfi srfi-1)
|
||||||
#:use-module (srfi srfi-26)
|
#:use-module (srfi srfi-26)
|
||||||
#:export (disk-partitions
|
#:export (disk-partitions
|
||||||
|
block-devices
|
||||||
partition-label-predicate
|
partition-label-predicate
|
||||||
partition-uuid-predicate
|
partition-uuid-predicate
|
||||||
partition-luks-uuid-predicate
|
partition-luks-uuid-predicate
|
||||||
|
@ -57,6 +59,9 @@ (define-module (gnu build file-systems)
|
||||||
read-partition-uuid
|
read-partition-uuid
|
||||||
read-luks-partition-uuid
|
read-luks-partition-uuid
|
||||||
|
|
||||||
|
uuids
|
||||||
|
find-uuid
|
||||||
|
|
||||||
cleanly-unmounted-ext2?
|
cleanly-unmounted-ext2?
|
||||||
|
|
||||||
bind-mount
|
bind-mount
|
||||||
|
@ -994,6 +999,20 @@ (define (partition? name major minor)
|
||||||
(loop (cons name parts))
|
(loop (cons name parts))
|
||||||
(loop parts))))))))))
|
(loop parts))))))))))
|
||||||
|
|
||||||
|
(define (block-devices)
|
||||||
|
"Return the block devices of valid disk partitions."
|
||||||
|
(map (cut string-append "/dev/" <>) (disk-partitions)))
|
||||||
|
|
||||||
|
(define (uuids)
|
||||||
|
"Return the uuids in use by the system as a list of <uuid> records."
|
||||||
|
(filter-map read-partition-uuid (block-devices)))
|
||||||
|
|
||||||
|
(define (find-uuid str)
|
||||||
|
"Return the current UUID which gets printed as STR, or #f otherwise."
|
||||||
|
(define (str? uuid)
|
||||||
|
(and (string=? str (uuid->string uuid)) uuid))
|
||||||
|
(any str? (uuids)))
|
||||||
|
|
||||||
(define (ENOENT-safe proc)
|
(define (ENOENT-safe proc)
|
||||||
"Wrap the one-argument PROC such that ENOENT, EIO, and ENOMEDIUM errors are
|
"Wrap the one-argument PROC such that ENOENT, EIO, and ENOMEDIUM errors are
|
||||||
caught and lead to a warning and #f as the result."
|
caught and lead to a warning and #f as the result."
|
||||||
|
@ -1123,9 +1142,7 @@ (define (find-partition predicate)
|
||||||
"Return the first partition found that matches PREDICATE, or #f if none
|
"Return the first partition found that matches PREDICATE, or #f if none
|
||||||
were found."
|
were found."
|
||||||
(lambda (expected)
|
(lambda (expected)
|
||||||
(find (predicate expected)
|
(find (predicate expected) (block-devices))))
|
||||||
(map (cut string-append "/dev/" <>)
|
|
||||||
(disk-partitions)))))
|
|
||||||
|
|
||||||
(define find-partition-by-label
|
(define find-partition-by-label
|
||||||
(find-partition partition-label-predicate))
|
(find-partition partition-label-predicate))
|
||||||
|
|
|
@ -2,6 +2,8 @@
|
||||||
;;; Copyright © 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
|
;;; Copyright © 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
|
||||||
;;; Copyright © 2017 Danny Milosavljevic <dannym@scratchpost.org>
|
;;; Copyright © 2017 Danny Milosavljevic <dannym@scratchpost.org>
|
||||||
;;; Copyright © 2019–2020, 2024 Tobias Geerinckx-Rice <me@tobias.gr>
|
;;; Copyright © 2019–2020, 2024 Tobias Geerinckx-Rice <me@tobias.gr>
|
||||||
|
;;; Copyright © 2024 Lilah Tascheter <lilah@lunabee.space>
|
||||||
|
;;; Copyright © 2024 Herman Rimm <herman@rimm.ee>
|
||||||
;;;
|
;;;
|
||||||
;;; This file is part of GNU Guix.
|
;;; This file is part of GNU Guix.
|
||||||
;;;
|
;;;
|
||||||
|
@ -32,6 +34,7 @@ (define-module (gnu system uuid)
|
||||||
uuid-bytevector
|
uuid-bytevector
|
||||||
uuid=?
|
uuid=?
|
||||||
|
|
||||||
|
file-system->uuid-type
|
||||||
bytevector->uuid
|
bytevector->uuid
|
||||||
|
|
||||||
uuid->string
|
uuid->string
|
||||||
|
@ -268,6 +271,15 @@ (define %uuid-printers
|
||||||
('exfat 'fat32 'fat16 'fat => fat-uuid->string)
|
('exfat 'fat32 'fat16 'fat => fat-uuid->string)
|
||||||
('ntfs => ntfs-uuid->string)))
|
('ntfs => ntfs-uuid->string)))
|
||||||
|
|
||||||
|
(define (file-system->uuid-type str)
|
||||||
|
"Convert a file system STR into a uuid-type symbol."
|
||||||
|
(match str
|
||||||
|
;; XXX: (When) do "fat" and "fat32" occur?
|
||||||
|
((or "exfat" "vfat" "fat32" "fat16") 'fat)
|
||||||
|
("ntfs" 'ntfs)
|
||||||
|
("iso9660" 'iso9660)
|
||||||
|
((? string?) 'dce)))
|
||||||
|
|
||||||
(define* (string->uuid str #:optional (type 'dce))
|
(define* (string->uuid str #:optional (type 'dce))
|
||||||
"Parse STR as a UUID of the given TYPE. On success, return the
|
"Parse STR as a UUID of the given TYPE. On success, return the
|
||||||
corresponding bytevector; otherwise return #f."
|
corresponding bytevector; otherwise return #f."
|
||||||
|
|
Loading…
Reference in a new issue