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>

1 files 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)