* guix/scripts/pack.scm: add support for parameters in entry-point
(entry-point-argument-spec-option-parser): add function to parse --entry-point-argument
(docker-image): Add function (form_entry_point) to handle --entry-point
vs --entry-point-argument merging
(docker-image): change call to (build-docker-image) to use (form-entry-point)
(%default-options): add dafault for --entry-point-argument option
(%docker-format-options): parser for --entry-point-argument
(show-docker-format-options): help for --docker-format-options
(show-docker-format-options/detailed): detailed help for --docker-format-options
(%options): add flag for --help-docker-format and add parser for --docker-format-options
(extra-options): add entry-point-argument option
(guix.texi): add documentation
---
doc/guix.texi | 14 +++++-
guix/scripts/pack.scm | 107 ++++++++++++++++++++++++++++++++----------
2 files changed, 95 insertions(+), 26 deletions(-)
Toggle diff (219 lines)
diff --git a/doc/guix.texi b/doc/guix.texi
index 4e7faf8aea..10d220c7b9 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -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
@@ -7410,7 +7411,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)
@@ -7433,6 +7434,17 @@ Invoking guix pack
docker run @var{image-id}
@end example
+@cindex entry point arguments, for docker images
+@item --entry-point-argument=@var{command}
+@itemx -A @var{command}
+Use @var{command} as an argument to @dfn{entry point} of the resulting pack.
+This option is only valid in conjunction with @code{--entry-point} and can
+appear multiple times on the command line.
+
+@example
+guix pack -f docker --entry-point=bin/guile --entry-point-argument="--help" guile
+@end example
+
@item --expression=@var{expr}
@itemx -e @var{expr}
Consider the package @var{expr} evaluates to.
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index 0dc9979194..c620eb9dc0 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -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 (entry-point-argument-spec-option-parser opt name arg result)
+ "A SRFI-37 opion parser for the --entry-point-argument option. The spec
+takes multiple occurances. The entries are used in the exec form for the
+docker entry-point. The values are used as parameters in conjunction with
+the --entry-point option which is used as the first value in the exec form."
+ (let ((entry-point-argument (assoc-ref result 'entry-point-argument)))
+ (alist-cons 'entry-point-argument
+ (append entry-point-argument (list arg))
+ (alist-delete 'entry-point-argument 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,48 @@ (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
+ prefix entry-point
+ entry-point-argument)
+ ;; construct entry-point parameter for build-docker-image
+ ;; the first entry is constructed by prefixing the entry-point
+ ;; with the supplied index subsequent entries are taken from
+ ;; the --entry-point-argument options
+ (cond
+ (entry-point
+ (cons*
+ (string-append prefix "/" entry-point)
+ entry-point-argument)
+ )
+ ('()))) ;empty list returned if no conditions are met
+
+ (let-keywords '#$extra-options #f ((entry-point-argument #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
+ #$profile
+ #$entry-point
+ entry-point-argument)
+ #: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 +1375,7 @@ (define %default-options
(debug . 0)
(verbosity . 1)
(symlinks . ())
+ (entry-point-argument . ())
(compressor . ,(first %compressors))))
(define %formats
@@ -1428,6 +1458,25 @@ (define (show-rpm-format-options/detailed)
(newline)
(exit 0))
+
+(define %docker-format-options
+ (list (option '(#\A "entry-point-argument") #t #f
+ entry-point-argument-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_ "
+ -A, --entry-point-argument=COMMAND/PARAMETER
+ Value(s) to use for the Docker EntryPoint arguments.
+ Multiple instances are accepted. This is only valid
+ in conjunction with the --entry-point option."))
+ (newline)
+ (exit 0))
+
(define %options
;; Specifications of the command-line options.
(cons* (option '(#\h "help") #f #f
@@ -1508,8 +1557,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 +1582,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 +1751,8 @@ (define-command (guix-pack . args)
(process-file-arg opts 'preun-file)
#:postun-file
(process-file-arg opts 'postun-file)))
+ ('docker
+ (list #:entry-point-argument (assoc-ref opts 'entry-point-argument)))
(_ '())))
(target (assoc-ref opts 'target))
(bootstrap? (assoc-ref opts 'bootstrap?))
base-commit: 2426e51688d479042ea115a634c6be2d8b9f3b99
--
2.39.2
