Package: guix-patches;
Reported by: Graham James Addis <grahamjamesaddis <at> gmail.com>
Date: Mon, 19 Jun 2023 15:39:02 UTC
Severity: normal
Tags: patch
Merged with 64171
View this message in rfc822 format
From: Graham James Addis <grahamjamesaddis <at> gmail.com> To: 64173 <at> debbugs.gnu.org Cc: Graham James Addis <graham <at> addis.org.uk>, Christopher Baines <mail <at> cbaines.net>, Josselin Poiret <dev <at> jpoiret.xyz>, Ludovic Courtès <ludo <at> gnu.org>, Mathieu Othacehe <othacehe <at> gnu.org>, Ricardo Wurmus <rekado <at> elephly.net>, Simon Tournier <zimon.toutoune <at> gmail.com>, Tobias Geerinckx-Rice <me <at> tobias.gr> Subject: [bug#64173] [PATCH 1/1] guix: pack: docker add docker-entry-point options Date: Mon, 19 Jun 2023 16:38:01 +0100
* guix/scripts/pack.scm: add support for parameters in entry-point
(docker-entry-point-spec-option-parser): add function to parse --docker-entry-point
(docker-image): Add function (form_entry_point) to handle --entry-point
vs --docker-entry-point precedence
(docker-image): change call to (build-docker-image) to use (form-entry-point)
(%default-options): add dafault for --docker-entry-point option
(%docker-format-options): parser for --docker-entry-point
(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 extra options for docker
(guix.texi): add documentation
---
doc/guix.texi | 16 +++++-
guix/scripts/pack.scm | 113 ++++++++++++++++++++++++++++++++----------
2 files changed, 103 insertions(+), 26 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index c961f706ec..8d8044f73c 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
@@ -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.
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index 0dc9979194..79739cb465 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -8,6 +8,7 @@
;;; Copyright © 2020, 2021, 2022, 2023 Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
;;; Copyright © 2020 Eric Bavier <bavier <at> posteo.net>
;;; Copyright © 2022 Alex Griffin <a <at> ajgrf.com>
+;;; Copyright © 2023 Graham James Addis <graham <at> 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?))
--
2.39.2
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.