branch master updated: pack: Allow setting a custom image tag for Docker images

[guix-commits]

This is an automated email from the git hooks/post-receive script.

mothacehe pushed a commit to branch master
in repository guix.

The following commit(s) were added to refs/heads/master by this push:
     new 435090fa3f pack: Allow setting a custom image tag for Docker images
435090fa3f is described below

commit 435090fa3f406a76c83e11de9cd01f61ef89dcca
Author: Sören Tempel <soeren@soeren-tempel.net>
AuthorDate: Sun Oct 1 15:06:15 2023 +0200

    pack: Allow setting a custom image tag for Docker images
    
    Previously, the image repository name was automatically computed from
    the packages in the manifest without allowing the user to set a custom
    one. As such, changing the packages in the manifest would result in a
    new image name. Thereby requiring updating documentation et cetera when
    using `docker load` directory on the resulting image.
    
    Inspired by `docker build -t`, this commit adds a new Docker-specific
    option to `guix pack` which allows setting a custom repository name for
    the resulting image. If this option is not specified, pack falls back
    to computing the name from the manifest. Therefore, this change is
    entirely backwards compatible.
    
    Documentation has been added with: 373ec2cf8ce97d5f89191c3d9211ee3a5c2067dc.
    
    * guix/scripts/pack.scm (guix-pack): Add --image-tag option.
    (%docker-format-options): New constant.
    (show-docker-format-options): New procedure.
    (show-docker-format-options/detailed): New procedure.
    (docker-image): Allow setting a custom
    repository name for the created docker image via extra-options.
    
    Signed-off-by: Sören Tempel <soeren@soeren-tempel.net>
    Signed-off-by: Mathieu Othacehe <othacehe@gnu.org>
---
 guix/scripts/pack.scm | 70 ++++++++++++++++++++++++++++++++++++---------------
 1 file changed, 50 insertions(+), 20 deletions(-)

diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index 01995c48b7..78044fd625 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -507,7 +507,7 @@ added to the pack."
 image is a tarball conforming to the Docker Image Specification, compressed
 with COMPRESSOR.  It can be passed to 'docker load'.  If TARGET is true, it
 must a be a GNU triplet and it is used to derive the architecture metadata in
-the image."
+the image.  EXTRA-OPTIONS may contain the IMAGE-TAG keyword argument."
   (define database
     (and localstatedir?
          (file-append (store-database (list profile))
@@ -531,7 +531,7 @@ the image."
                          (guix build utils)
                          (guix profiles) (guix search-paths)
                          (srfi srfi-1) (srfi srfi-19)
-                         (ice-9 match))
+                         (ice-9 match) (ice-9 optargs))
 
             #$(procedure-source manifest->friendly-name)
 
@@ -560,23 +560,30 @@ the image."
 
             (setenv "PATH" #+(file-append archiver "/bin"))
 
-            (build-docker-image #$output
-                                (map store-info-item
-                                     (call-with-input-file "profile"
-                                       read-reference-graph))
-                                #$profile
-                                #:repository (manifest->friendly-name
-                                              (profile-manifest #$profile))
-                                #:database #+database
-                                #:system (or #$target %host-type)
-                                #:environment environment
-                                #:entry-point
-                                #$(and entry-point
-                                       #~(list (string-append #$profile "/"
-                                                              #$entry-point)))
-                                #:extra-files directives
-                                #:compressor #+(compressor-command compressor)
-                                #:creation-time (make-time time-utc 0 1))))))
+            (let-keywords '#$extra-options #f
+                          ((image-tag #f))
+              (build-docker-image #$output
+                                  (map store-info-item
+                                       (call-with-input-file "profile"
+                                         read-reference-graph))
+                                  #$profile
+                                  #:repository
+                                  (or image-tag
+                                      (manifest->friendly-name
+                                       (profile-manifest #$profile)))
+                                  #:database #+database
+                                  #:system (or #$target %host-type)
+                                  #:environment environment
+                                  #:entry-point
+                                  #$(and entry-point
+                                         #~(list
+                                            (string-append #$profile "/"
+                                                           #$entry-point)))
+                                  #:extra-files directives
+                                  #:compressor
+                                  #+(compressor-command compressor)
+                                  #:creation-time
+                                  (make-time time-utc 0 1)))))))
 
   (gexp->derivation (string-append name ".tar"
                                    (compressor-extension compressor))
@@ -1287,6 +1294,20 @@ last resort for relocation."
                    (alist-cons symbol arg result)
                    rest))))
 
+(define %docker-format-options
+  (list (required-option 'image-tag)))
+
+(define (show-docker-format-options)
+  (display (G_ "
+      --help-docker-format  list options specific to the docker format")))
+
+(define (show-docker-format-options/detailed)
+  (display (G_ "
+      --image-tag=NAME
+                         Use the given NAME for the Docker image repository"))
+  (newline)
+  (exit 0))
+
 (define %deb-format-options
   (list (required-option 'control-file)
         (required-option 'postinst-file)
@@ -1407,6 +1428,10 @@ last resort for relocation."
                  (lambda (opt name arg result)
                    (alist-cons 'bootstrap? #t result)))
 
+         (option '("help-docker-format") #f #f
+                 (lambda args
+                   (show-docker-format-options/detailed)))
+
          (option '("help-deb-format") #f #f
                  (lambda args
                    (show-deb-format-options/detailed)))
@@ -1415,7 +1440,8 @@ last resort for relocation."
                  (lambda args
                    (show-rpm-format-options/detailed)))
 
-         (append %deb-format-options
+         (append %docker-format-options
+                 %deb-format-options
                  %rpm-format-options
                  %transformation-options
                  %standard-build-options
@@ -1433,6 +1459,7 @@ Create a bundle of PACKAGE.\n"))
   (newline)
   (show-transformation-options-help)
   (newline)
+  (show-docker-format-options)
   (show-deb-format-options)
   (show-rpm-format-options)
   (newline)
@@ -1586,6 +1613,9 @@ Create a bundle of PACKAGE.\n"))
                                       manifest)))
                    (pack-format (assoc-ref opts 'format))
                    (extra-options (match pack-format
+                                    ('docker
+                                     (list #:image-tag
+                                           (assoc-ref opts 'image-tag)))
                                     ('deb
                                      (list #:control-file
                                            (process-file-arg opts 
'control-file)