From 7d5168a2af3ed922c6a46985124fb73402cc8844 Mon Sep 17 00:00:00 2001 From: Graham James Addis Date: Wed, 12 Jul 2023 09:17:13 +0100 Subject: guix: pack: Add '--entry-point-argument' option. * guix/scripts/pack.scm: (entry-point-argument-spec-option-parser): New procedure. (docker-image, %default-options, %docker-format-options, show-docker-format-options/detailed, %options, show-docker-format-options, guix-pack): Handle '--entry-point-argument' option. * doc/guix.texi: (Invoking guix pack): Document this Signed-off-by: Oleg Pykhalov Change-Id: I1124feff6af39dcc63c85fd6cc7ad50f398489dc --- guix/scripts/pack.scm | 50 +++++++++++++++++++++++++++++++++++++++++--------- 1 file changed, 41 insertions(+), 9 deletions(-) (limited to 'guix/scripts') diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm index 8071840de1..4c0a602eb1 100644 --- a/guix/scripts/pack.scm +++ b/guix/scripts/pack.scm @@ -8,6 +8,7 @@ ;;; Copyright © 2020, 2021, 2022, 2023 Maxim Cournoyer ;;; Copyright © 2020 Eric Bavier ;;; Copyright © 2022 Alex Griffin +;;; Copyright © 2023 Graham James Addis ;;; ;;; This file is part of GNU Guix. ;;; @@ -202,6 +203,16 @@ target the profile's @file{bin/env} file: (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." @@ -562,10 +573,22 @@ the image. EXTRA-OPTIONS may contain the IMAGE-TAG keyword argument." `((directory "/tmp" ,(getuid) ,(getgid) #o1777) ,@(append-map symlink->directives '#$symlinks))) + (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. + (and=> entry-point + (lambda (entry-point) + (cons* (string-append prefix "/" entry-point) + entry-point-argument)))) + (setenv "PATH" #+(file-append archiver "/bin")) (let-keywords '#$extra-options #f - ((image-tag #f)) + ((image-tag #f) + (entry-point-argument #f)) + (build-docker-image #$output (map store-info-item (call-with-input-file "profile" @@ -578,11 +601,10 @@ the image. EXTRA-OPTIONS may contain the IMAGE-TAG keyword argument." #:database #+database #:system (or #$target %host-type) #:environment environment - #:entry-point - #$(and entry-point - #~(list - (string-append #$profile "/" - #$entry-point))) + #:entry-point (form-entry-point + #$profile + #$entry-point + entry-point-argument) #:extra-files directives #:compressor #+(compressor-command compressor) @@ -1264,6 +1286,7 @@ last resort for relocation." (debug . 0) (verbosity . 1) (symlinks . ()) + (entry-point-argument . ()) (compressor . ,(first %compressors)))) (define %formats @@ -1299,7 +1322,9 @@ last resort for relocation." rest)))) (define %docker-format-options - (list (required-option 'image-tag))) + (list (required-option 'image-tag) + (option '(#\A "entry-point-argument") #t #f + entry-point-argument-spec-option-parser))) (define (show-docker-format-options) (display (G_ " @@ -1308,7 +1333,12 @@ last resort for relocation." (define (show-docker-format-options/detailed) (display (G_ " --image-tag=NAME - Use the given NAME for the Docker image repository")) + Use the given NAME for the Docker image repository + + -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)) @@ -1619,7 +1649,9 @@ Create a bundle of PACKAGE.\n")) (extra-options (match pack-format ('docker (list #:image-tag - (assoc-ref opts 'image-tag))) + (assoc-ref opts 'image-tag) + #:entry-point-argument + (assoc-ref opts 'entry-point-argument))) ('deb (list #:control-file (process-file-arg opts 'control-file) -- cgit v1.2.3