From 5b7b514e4d770d66e194c41562ed986aac91077d Mon Sep 17 00:00:00 2001
From: Herman Rimm <herman@rimm.ee>
Date: Sun, 29 Sep 2024 11:24:51 +0200
Subject: [PATCH] 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
---
 gnu/build/file-systems.scm | 23 ++++++++++++++++++++---
 gnu/system/uuid.scm        | 12 ++++++++++++
 2 files changed, 32 insertions(+), 3 deletions(-)

diff --git a/gnu/build/file-systems.scm b/gnu/build/file-systems.scm
index a80894951d..2739cace73 100644
--- a/gnu/build/file-systems.scm
+++ b/gnu/build/file-systems.scm
@@ -9,6 +9,7 @@
 ;;; Copyright © 2022 Oleg Pykhalov <go.wigust@gmail.com>
 ;;; Copyright © 2024 Nicolas Graves <ngraves@ngraves.fr>
 ;;; Copyright © 2024 Richard Sent <richard@freakingpenguin.com>
+;;; Copyright © 2024 Herman Rimm <herman@rimm.ee>
 ;;;
 ;;; 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-26)
   #:export (disk-partitions
+            block-devices
             partition-label-predicate
             partition-uuid-predicate
             partition-luks-uuid-predicate
@@ -57,6 +59,9 @@ (define-module (gnu build file-systems)
             read-partition-uuid
             read-luks-partition-uuid
 
+            uuids
+            find-uuid
+
             cleanly-unmounted-ext2?
 
             bind-mount
@@ -994,6 +999,20 @@ (define (partition? name major minor)
                      (loop (cons name 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)
   "Wrap the one-argument PROC such that ENOENT, EIO, and ENOMEDIUM errors are
 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
 were found."
   (lambda (expected)
-    (find (predicate expected)
-          (map (cut string-append "/dev/" <>)
-               (disk-partitions)))))
+    (find (predicate expected) (block-devices))))
 
 (define find-partition-by-label
   (find-partition partition-label-predicate))
diff --git a/gnu/system/uuid.scm b/gnu/system/uuid.scm
index 432c2e82f7..66909e16e0 100644
--- a/gnu/system/uuid.scm
+++ b/gnu/system/uuid.scm
@@ -2,6 +2,8 @@
 ;;; Copyright © 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2017 Danny Milosavljevic <dannym@scratchpost.org>
 ;;; 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.
 ;;;
@@ -32,6 +34,7 @@ (define-module (gnu system uuid)
             uuid-bytevector
             uuid=?
 
+            file-system->uuid-type
             bytevector->uuid
 
             uuid->string
@@ -268,6 +271,15 @@ (define %uuid-printers
    ('exfat 'fat32 'fat16 'fat => fat-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))
   "Parse STR as a UUID of the given TYPE.  On success, return the
 corresponding bytevector; otherwise return #f."