@@ -116,6 +116,7 @@
Copyright @copyright{} 2023 Karl Hallsby@*
Copyright @copyright{} 2023 Nathaniel Nicandro@*
Copyright @copyright{} 2023 Tanguy Le Carrour@*
+Copyright @copyright{} 2023 Graham James Addis@*
Permission is granted to copy, distribute and/or modify this document
under the terms of the GNU Free Documentation License, Version 1.3 or
@@ -7346,7 +7347,7 @@ Invoking guix pack
@env{GUIX_EXECUTION_ENGINE} environment variable accordingly.
@end quotation
-@cindex entry point, for Docker images
+@cindex entry point, for Docker and Singularity images
@item --entry-point=@var{command}
Use @var{command} as the @dfn{entry point} of the resulting pack, if the pack
format supports it---currently @code{docker} and @code{squashfs} (Singularity)
@@ -7369,6 +7370,19 @@ Invoking guix pack
docker run @var{image-id}
@end example
+@cindex entry point, for Docker images
+@item --docker-entry-point=@var{command}
+Use @var{command} as the @dfn{entry point} of the resulting pack. This option
+overrides any value passed to @code{--entry-point} and can appear multiple
+times on the command line. The first instance of @var{command} is used as th
+@dfn{entry point} and subsequent values are used as the parameters.
+@var{command} must be relative to the profile contained in the
+pack.
+
+@example
+guix pack -f docker --docker-entry-point=bin/guile --docker-entry-point="--help" guile
+@end example
+
@item --expression=@var{expr}
@itemx -e @var{expr}
Consider the package @var{expr} evaluates to.
@@ -8,6 +8,7 @@
;;; Copyright © 2020, 2021, 2022, 2023 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2020 Eric Bavier <bavier@posteo.net>
;;; Copyright © 2022 Alex Griffin <a@ajgrf.com>
+;;; Copyright © 2023 Graham James Addis <graham@addis.org.uk>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -193,6 +194,16 @@ (define (symlink-spec-option-parser opt name arg result)
(leave (G_ "~a: invalid symlink specification~%")
arg))))
+(define (docker-entry-point-spec-option-parser opt name arg result)
+ "A SRFI-37 opion parser for the --docker-entry-point option. The spec
+takes multiple occurances. The entries are used in the exec form for the
+docker entry-point. The first is used as the command and subsequent values
+are used as parameters."
+ (let ((docker-entry-point (assoc-ref result 'docker-entry-point)))
+ (alist-cons 'docker-entry-point
+ (append docker-entry-point (list arg))
+ (alist-delete 'docker-entry-point result eq?))))
+
(define (set-utf8-locale profile)
"Configure the environment to use the \"en_US.utf8\" locale provided by the
GLIBC-UT8-LOCALES package."
@@ -626,6 +637,7 @@ (define* (docker-image name profile
(guix build utils)
(guix profiles) (guix search-paths)
(srfi srfi-1) (srfi srfi-19)
+ (ice-9 optargs)
(ice-9 match))
#$(procedure-source manifest->friendly-name)
@@ -653,31 +665,50 @@ (define* (docker-image name profile
`((directory "/tmp" ,(getuid) ,(getgid) #o1777)
,@(append-map symlink->directives '#$symlinks)))
- (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))))))
-
- (gexp->derivation (string-append name ".tar"
- (compressor-extension compressor))
- build
- #:target target
- #:references-graphs `(("profile" ,profile))))
+ (define (form-entry-point
+ docker-entry-point
+ prefix entry-point)
+ ;; construct entry-point parameter for build-docker-image
+ ;; overriding the legacy use of --entry-point from the command
+ ;; line when the --docker-entry-point options are used
+ (cond
+ ;; if CLI --docker-entry-point values are available use them
+ ((and docker-entry-point (not (null? docker-entry-point))
+ (cons
+ (string-append prefix "/" (car docker-entry-point))
+ (cdr docker-entry-point))))
+ ;; legacy behaviour uses --entry-point and prefixes with #$profile
+ (entry-point (list (string-append prefix "/" entry-point)))
+ ('()))) ;empty list returned if no conditions are met
+
+ (let-keywords '#$extra-options #f ((docker-entry-point #f))
+
+ (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 (form-entry-point
+ docker-entry-point
+ #$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))
+ build
+ #:target target
+ #:references-graphs `(("profile" ,profile))))
;;;
@@ -1346,6 +1377,7 @@ (define %default-options
(debug . 0)
(verbosity . 1)
(symlinks . ())
+ (docker-entry-point . ())
(compressor . ,(first %compressors))))
(define %formats
@@ -1428,6 +1460,29 @@ (define (show-rpm-format-options/detailed)
(newline)
(exit 0))
+
+(define %docker-format-options
+ (list (option '("docker-entry-point") #t #f
+ docker-entry-point-spec-option-parser)))
+
+(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_ "
+ --docker-entry-point=COMMAND/PARAMETER
+ Value(s) to use for the Docker EntryPoint field.
+ Multiple instances are accepted. The first use is
+ supplied as the COMMAND in the Docker EntryPoint,
+ subsequent uses are supplied as PARAMETERs in the
+ Docker EntryPoint.
+ This overrides any COMMAND provided in the
+ --entry-point option."))
+ (newline)
+ (exit 0))
+
(define %options
;; Specifications of the command-line options.
(cons* (option '(#\h "help") #f #f
@@ -1508,8 +1563,13 @@ (define %options
(lambda args
(show-rpm-format-options/detailed)))
+ (option '("help-docker-format") #f #f
+ (lambda args
+ (show-docker-format-options/detailed)))
+
(append %deb-format-options
%rpm-format-options
+ %docker-format-options
%transformation-options
%standard-build-options
%standard-cross-build-options
@@ -1528,6 +1588,7 @@ (define (show-help)
(newline)
(show-deb-format-options)
(show-rpm-format-options)
+ (show-docker-format-options)
(newline)
(display (G_ "
-f, --format=FORMAT build a pack in the given FORMAT"))
@@ -1696,6 +1757,8 @@ (define-command (guix-pack . args)
(process-file-arg opts 'preun-file)
#:postun-file
(process-file-arg opts 'postun-file)))
+ ('docker
+ (list #:docker-entry-point (assoc-ref opts 'docker-entry-point)))
(_ '())))
(target (assoc-ref opts 'target))
(bootstrap? (assoc-ref opts 'bootstrap?))