diff options
Diffstat (limited to 'guix/scripts/pack.scm')
| -rw-r--r-- | guix/scripts/pack.scm | 96 |
1 files changed, 77 insertions, 19 deletions
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm index bdbea49910..3e45c34895 100644 --- a/guix/scripts/pack.scm +++ b/guix/scripts/pack.scm @@ -8,6 +8,8 @@ ;;; 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> +;;; Copyright © 2023 Oleg Pykhalov <go.wigust@gmail.com> ;;; ;;; This file is part of GNU Guix. ;;; @@ -47,6 +49,7 @@ #:use-module (guix scripts build) #:use-module (guix transformations) #:use-module ((guix self) #:select (make-config.scm)) + #:use-module ((guix docker) #:select (%docker-image-max-layers)) #:use-module (gnu compression) #:use-module (gnu packages) #:use-module (gnu packages bootstrap) @@ -137,7 +140,8 @@ dependencies are registered." ;; Make sure non-ASCII file names are properly handled. (setenv "GUIX_LOCPATH" - #+(file-append glibc-utf8-locales "/lib/locale")) + #+(file-append (libc-utf8-locales-for-target (%current-system)) + "/lib/locale")) (setlocale LC_ALL "en_US.utf8") (sql-schema #$schema) @@ -201,6 +205,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 option parser for the --entry-point-argument option. The spec +takes multiple occurrences. 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." @@ -209,7 +223,10 @@ GLIBC-UT8-LOCALES package." (profile-locales? profile)) #~(begin (setenv "GUIX_LOCPATH" - #+(file-append glibc-utf8-locales "/lib/locale")) + #+(file-append (let-system (system target) + (libc-utf8-locales-for-target + (or target system))) + "/lib/locale")) (setlocale LC_ALL "en_US.utf8")) #~(setenv "GUIX_LOCPATH" "unset for tests"))) @@ -502,12 +519,15 @@ added to the pack." localstatedir? (symlinks '()) (archiver tar) - (extra-options '())) - "Return a derivation to construct a Docker image of PROFILE. The -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. EXTRA-OPTIONS may contain the IMAGE-TAG keyword argument." + (extra-options '()) + max-layers) + "Return a derivation to construct a Docker image of PROFILE. The 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. EXTRA-OPTIONS may contain the IMAGE-TAG keyword argument. If +MAX-LAYERS is not false, the image will be splitted in up to MAX-LAYERS +layers." (define database (and localstatedir? (file-append (store-database (list profile)) @@ -558,10 +578,28 @@ the image. EXTRA-OPTIONS may contain the IMAGE-TAG keyword argument." `((directory "/tmp" ,(getuid) ,(getgid) #o1777) ,@(append-map symlink->directives '#$symlinks))) - (setenv "PATH" #+(file-append archiver "/bin")) + (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" + (string-join `(#+(file-append archiver "/bin") + #+@(if max-layers + (list (file-append gzip "/bin")) + '())) + ":")) (let-keywords '#$extra-options #f - ((image-tag #f)) + ((image-tag #f) + (entry-point-argument '()) + (max-layers #f)) + (build-docker-image #$output (map store-info-item (call-with-input-file "profile" @@ -574,16 +612,16 @@ 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) #:creation-time - (make-time time-utc 0 1))))))) + (make-time time-utc 0 1) + #:max-layers max-layers)))))) (gexp->derivation (string-append name ".tar" (compressor-extension compressor)) @@ -1260,6 +1298,8 @@ last resort for relocation." (debug . 0) (verbosity . 1) (symlinks . ()) + (entry-point-argument . ()) + (max-layers . ,%docker-image-max-layers) (compressor . ,(first %compressors)))) (define %formats @@ -1295,7 +1335,13 @@ 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) + (option '("max-layers") #t #f + (lambda (opt name arg result) + (alist-cons 'max-layers (string->number* arg) + result))))) (define (show-docker-format-options) (display (G_ " @@ -1304,7 +1350,15 @@ 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 + + --max-layers=N + Number of image layers")) (newline) (exit 0)) @@ -1615,7 +1669,11 @@ 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) + #:max-layers + (assoc-ref opts 'max-layers))) ('deb (list #:control-file (process-file-arg opts 'control-file) |