From 036f23f053ee6bd34c6d387debb4a9166561dd02 Mon Sep 17 00:00:00 2001
From: Julien Lepiller <julien@lepiller.eu>
Date: Sat, 29 Aug 2020 15:34:56 +0200
Subject: guix: system: Add `--label' option.

* guix/scripts/system.scm (%options): Add `--label'.
(system-derivation-for-action): Take a #:label key to set volume ID.
(perform-action): Take a #:label key.
(%default-options): Add default label value.
(process-action): Pass label value from command-line to perform-action.
* gnu/system/image.scm (image-with-label): New procedure.
---
 gnu/system/image.scm | 17 ++++++++++++++++-
 1 file changed, 16 insertions(+), 1 deletion(-)

(limited to 'gnu/system')

diff --git a/gnu/system/image.scm b/gnu/system/image.scm
index c1a718d607..733f2bfa8d 100644
--- a/gnu/system/image.scm
+++ b/gnu/system/image.scm
@@ -63,7 +63,8 @@
             iso9660-image
 
             find-image
-            system-image))
+            system-image
+            image-with-label))
 
 
 ;;;
@@ -407,6 +408,20 @@ used in the image. "
                                #:references-graphs ,inputs
                                #:substitutable? ,substitutable?))))
 
+(define (image-with-label base-image label)
+  "The volume ID of an ISO is the label of the first partition.  This procedure
+returns an image record where the first partition's label is set to <label>."
+  (image
+    (inherit base-image)
+    (partitions
+      (match (image-partitions base-image)
+        ((boot others ...)
+         (cons
+           (partition
+             (inherit boot)
+             (label label))
+           others))))))
+
 
 ;;
 ;; Image creation.
-- 
cgit v1.2.3