Subject: Re: [bug#43101] [PATCH v2] Add version number in release ISO

From: Julien Lepiller <[email-masked]>
Date: Sun, 30 Aug 2020 21:52:30 +0200

Here's v2 of the patch series. I've added one patch to (gnu ci) to set
the version number in generated ISOs, and fixed other issues in the
previous version of the patches.

Le Sun, 30 Aug 2020 11:11:08 -0400,
Julien Lepiller <[email-masked]> a écrit :

> Yes, it makes sense! I'll send a patch for that too. Thank you!
> 
> Le 30 août 2020 11:05:27 GMT-04:00, Mathieu Othacehe
> <[email-masked]> a écrit :
> >
> >Hello Julien,
> >
> >Thanks for this patch!
> >  
> >>>Please include (gnu image) and avoid ‘@’.  
> >>
> >> (gnu image) is already imported, but conflicts with another module
> >>  
> >for partition, leading to a compilation error. What should I do?
> >
> >You can maybe write something like:
> >
> >--8<---------------cut here---------------start------------->8---
> >#:use-module ((srfi srfi-1) #:hide (partition))
> >--8<---------------cut here---------------end--------------->8---
> >  
> >> I'll add the architecture in there too, as per discussion in the  
> >osinfo-db MR.
> >
> >Do you think it could be useful to add the same mechanism to ISO
> >images built by the CI? In that case, you could maybe use the same
> >mechanism in
> >(gnu ci) and label the boot partition with %guix-version?
> >
> >Thanks,
> >
> >Mathieu  

From a502fa70b0230d3f91ddf05410f24a1f4fcad521 Mon Sep 17 00:00:00 2001
From: Julien Lepiller <[email-masked]>
Date: Sat, 29 Aug 2020 15:34:56 +0200
Subject: [PATCH 1/3] 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.
---
 doc/guix.texi           |  4 +++-
 guix/scripts/system.scm | 27 ++++++++++++++++++++++-----
 2 files changed, 25 insertions(+), 6 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 6206a93857..56b1cd8976 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -28836,7 +28836,9 @@ the @option{--image-size} option is ignored in the case of
 @code{docker-image}.
 
 You can specify the root file system type by using the
-@option{--file-system-type} option.  It defaults to @code{ext4}.
+@option{--file-system-type} option.  It defaults to @code{ext4}.  When its
+value is @code{iso9660}, the @option{--label} option can be used to specify
+a volume ID with @code{disk-image}.
 
 When using @code{vm-image}, the returned image is in qcow2 format, which
 the QEMU emulator can efficiently use. @xref{Running Guix in a VM},
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index f6d20382b6..33f4c8e4e8 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -6,6 +6,7 @@
 ;;; Copyright © 2018 Ricardo Wurmus <[email-masked]>
 ;;; Copyright © 2019 Christopher Baines <[email-masked]>
 ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <[email-masked]>
+;;; Copyright © 2020 Julien Lepiller <[email-masked]>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -67,7 +68,7 @@
   #:use-module (gnu services)
   #:use-module (gnu services shepherd)
   #:use-module (gnu services herd)
-  #:use-module (srfi srfi-1)
+  #:use-module ((srfi srfi-1) #:hide (partition))
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-19)
   #:use-module (srfi srfi-26)
@@ -662,7 +663,7 @@ checking this by themselves in their 'check' procedure."
 (define* (system-derivation-for-action os base-image action
                                        #:key image-size file-system-type
                                        full-boot? container-shared-network?
-                                       mappings)
+                                       mappings label)
   "Return as a monadic value the derivation for OS according to ACTION."
   (case action
     ((build init reconfigure)
@@ -688,7 +689,14 @@ checking this by themselves in their 'check' procedure."
        (image
         (inherit base-image)
         (size image-size)
-        (operating-system os)))))
+        (operating-system os)
+        (partitions (match (image-partitions base-image)
+                      ((boot others ...)
+                       (cons
+                         (partition
+                           (inherit boot)
+                           (label (or label (partition-label boot))))
+                         others))))))))
     ((docker-image)
      (system-docker-image os #:shared-network? container-shared-network?))))
 
@@ -741,7 +749,7 @@ and TARGET arguments."
                          install-bootloader?
                          dry-run? derivations-only?
                          use-substitutes? bootloader-target target
-                         image-size file-system-type full-boot?
+                         image-size file-system-type full-boot? label
                          container-shared-network?
                          (mappings '())
                          (gc-root #f))
@@ -795,6 +803,7 @@ static checks."
       ((target*   (current-target-system))
        (image ->  (find-image file-system-type target*))
        (sys       (system-derivation-for-action os image action
+                                                #:label label
                                                 #:file-system-type file-system-type
                                                 #:image-size image-size
                                                 #:full-boot? full-boot?
@@ -942,6 +951,8 @@ Some ACTIONS support additional ARGS.\n"))
       --image-size=SIZE  for 'vm-image', produce an image of SIZE"))
   (display (G_ "
       --no-bootloader    for 'init', do not install a bootloader"))
+  (display (G_ "
+      --label=LABEL      for 'disk-image', label disk image with LABEL"))
   (display (G_ "
       --save-provenance  save provenance information"))
   (display (G_ "
@@ -1008,6 +1019,9 @@ Some ACTIONS support additional ARGS.\n"))
          (option '("no-bootloader" "no-grub") #f #f
                  (lambda (opt name arg result)
                    (alist-cons 'install-bootloader? #f result)))
+         (option '("label") #t #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'label arg result)))
          (option '("full-boot") #f #f
                  (lambda (opt name arg result)
                    (alist-cons 'full-boot? #t result)))
@@ -1065,7 +1079,8 @@ Some ACTIONS support additional ARGS.\n"))
     (validate-reconfigure . ,ensure-forward-reconfigure)
     (file-system-type . "ext4")
     (image-size . guess)
-    (install-bootloader? . #t)))
+    (install-bootloader? . #t)
+    (label . #f)))
 
 (define (verbosity-level opts)
   "Return the verbosity level based on OPTS, the alist of parsed options."
@@ -1119,6 +1134,7 @@ resulting from command-line parsing."
 
          (dry?        (assoc-ref opts 'dry-run?))
          (bootloader? (assoc-ref opts 'install-bootloader?))
+         (label       (assoc-ref opts 'label))
          (target-file (match args
                         ((first second) second)
                         (_ #f)))
@@ -1169,6 +1185,7 @@ resulting from command-line parsing."
                                                         (_ #f))
                                                       opts)
                                #:install-bootloader? bootloader?
+                               #:label label
                                #:target target-file
                                #:bootloader-target bootloader-target
                                #:gc-root (assoc-ref opts 'gc-root)))))
-- 
2.28.0

From d98a5b9d36a74d47348a5a838209993f6b2539e0 Mon Sep 17 00:00:00 2001
From: Julien Lepiller <[email-masked]>
Date: Sun, 30 Aug 2020 20:43:42 +0200
Subject: [PATCH 2/3] gnu: ci: Set label in iso9660 jobs.

* gnu/ci.scm (image-jobs): Set label of generated ISOs.
---
 gnu/ci.scm | 12 +++++++++++-
 1 file changed, 11 insertions(+), 1 deletion(-)

diff --git a/gnu/ci.scm b/gnu/ci.scm
index af0bb66775..c15baa99d3 100644
--- a/gnu/ci.scm
+++ b/gnu/ci.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <[email-masked]>
 ;;; Copyright © 2017 Jan Nieuwenhuizen <[email-masked]>
 ;;; Copyright © 2018, 2019 Clément Lassieur <[email-masked]>
+;;; Copyright © 2020 Julien Lepiller <[email-masked]>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -25,6 +26,7 @@
   #:use-module (guix profiles)
   #:use-module (guix packages)
   #:use-module (guix channels)
+  #:use-module (guix config)
   #:use-module (guix derivations)
   #:use-module (guix build-system)
   #:use-module (guix monads)
@@ -234,7 +236,15 @@ system.")
                 (build-image
                  (image
                   (inherit iso9660-image)
-                  (operating-system installation-os))))
+                  (operating-system installation-os)
+                  (partitions (match (image-partitions iso9660-image)
+                                ((boot others ...)
+                                 (cons
+                                   (partition
+                                     (inherit boot)
+                                     (label (string-append "GUIX_" system "_"
+                                                           %guix-version)))
+                                   others)))))))
         ;; Only cross-compile Guix System images from x86_64-linux for now.
         ,@(if (string=? system "x86_64-linux")
               (map (lambda (image)
-- 
2.28.0

>From 2e8ca2e8ece588932d00d1bc12182e9a9a7f53e3 Mon Sep 17 00:00:00 2001
From: Julien Lepiller <[email-masked]>
Date: Sat, 29 Aug 2020 15:36:40 +0200
Subject: [PATCH 3/3] Makefile.am: Set iso label.

* Makefile.am (release): Add version number in disk image label.
---
 Makefile.am | 1 +
 1 file changed, 1 insertion(+)

diff --git a/Makefile.am b/Makefile.am
index 4c10bd37bc..063556c7ac 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -834,6 +834,7 @@ release: dist-with-updated-version
 	  image=`$(top_builddir)/pre-inst-env						\
 	    guix system disk-image							\
 	    --file-system-type=iso9660							\
+	    --label="GUIX_$${system}_$(VERSION)"						\
             --system=$$system --fallback						\
 	    gnu/system/install.scm` ;							\
 	  if [ ! -f "$$image" ] ; then							\
-- 
2.28.0