diff options
| -rw-r--r-- | doc/guix.texi | 26 | ||||
| -rw-r--r-- | guix/scripts/pack.scm | 60 | ||||
| -rw-r--r-- | tests/pack.scm | 50 |
3 files changed, 116 insertions, 20 deletions
diff --git a/doc/guix.texi b/doc/guix.texi index 27ebed137d..96035bd97c 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -56,7 +56,7 @@ Copyright @copyright{} 2017 Andy Wingo@* Copyright @copyright{} 2017, 2018, 2019, 2020, 2023 Arun Isaac@* Copyright @copyright{} 2017 nee@* Copyright @copyright{} 2018 Rutger Helling@* -Copyright @copyright{} 2018, 2021 Oleg Pykhalov@* +Copyright @copyright{} 2018, 2021, 2023 Oleg Pykhalov@* Copyright @copyright{} 2018 Mike Gerwitz@* Copyright @copyright{} 2018 Pierre-Antoine Rouby@* Copyright @copyright{} 2018, 2019 Gábor Boskovits@* @@ -7441,6 +7441,30 @@ appear multiple times on the command line. guix pack -f docker --entry-point=bin/guile --entry-point-argument="--help" guile @end example +@cindex maximum layers argument, for docker images +@item --max-layers=@code{n} +Specifies the maximum number of Docker image layers allowed when +building an image. + +@example +guix pack -f docker --max-layers=100 guile +@end example + +This option allows you to limit the number of layers in a Docker image. +Docker images are comprised of multiple layers, and each layer adds to +the overall size and complexity of the image. By setting a maximum +number of layers, you can control the following effects: + +@itemize +@item Disk Usage: +Increasing the number of layers can help optimize the disk space +required to store multiple images built with a similar package graph. + +@item Pulling: +When transferring images between different nodes or systems, having more +layers can reduce the time required to pull the image. +@end itemize + @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 4c0a602eb1..d0acc6cfd8 100644 --- a/guix/scripts/pack.scm +++ b/guix/scripts/pack.scm @@ -9,6 +9,7 @@ ;;; 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. ;;; @@ -48,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) @@ -204,10 +206,10 @@ target the profile's @file{bin/env} file: 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." + "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)) @@ -517,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)) @@ -576,18 +581,24 @@ the image. EXTRA-OPTIONS may contain the IMAGE-TAG keyword argument." (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 + ;; 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)))) + entry-point-argument)))) - (setenv "PATH" #+(file-append archiver "/bin")) + (setenv "PATH" + (string-join `(#+(file-append archiver "/bin") + #+@(if max-layers + (list (file-append gzip "/bin")) + '())) + ":")) (let-keywords '#$extra-options #f ((image-tag #f) - (entry-point-argument #f)) + (entry-point-argument #f) + (max-layers #f)) (build-docker-image #$output (map store-info-item @@ -609,7 +620,8 @@ the image. EXTRA-OPTIONS may contain the IMAGE-TAG keyword argument." #: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)) @@ -1287,6 +1299,7 @@ last resort for relocation." (verbosity . 1) (symlinks . ()) (entry-point-argument . ()) + (max-layers . ,%docker-image-max-layers) (compressor . ,(first %compressors)))) (define %formats @@ -1324,7 +1337,11 @@ last resort for relocation." (define %docker-format-options (list (required-option 'image-tag) (option '(#\A "entry-point-argument") #t #f - entry-point-argument-spec-option-parser))) + 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_ " @@ -1336,9 +1353,12 @@ last resort for relocation." Use the given NAME for the Docker image repository -A, --entry-point-argument=COMMAND/PARAMETER - Value(s) to use for the Docker EntryPoint arguments. + Value(s) to use for the Docker ENTRYPOINT arguments. Multiple instances are accepted. This is only valid - in conjunction with the --entry-point option")) + in conjunction with the --entry-point option + + --max-layers=N + Number of image layers")) (newline) (exit 0)) @@ -1651,7 +1671,9 @@ Create a bundle of PACKAGE.\n")) (list #:image-tag (assoc-ref opts 'image-tag) #:entry-point-argument - (assoc-ref opts '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) diff --git a/tests/pack.scm b/tests/pack.scm index ac78817a70..55445ea1e9 100644 --- a/tests/pack.scm +++ b/tests/pack.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2017-2021, 2023 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net> ;;; Copyright © 2021, 2023 Maxim Cournoyer <maxim.cournoyer@gmail.com> +;;; Copyright © 2023 Oleg Pykhalov <go.wigust@gmail.com> ;;; ;;; This file is part of GNU Guix. ;;; @@ -29,6 +30,7 @@ #:use-module (guix gexp) #:use-module (guix modules) #:use-module (guix utils) + #:use-module ((guix build utils) #:select (%store-directory)) #:use-module (gnu packages) #:use-module ((gnu packages base) #:select (libc-utf8-locales-for-target)) #:use-module (gnu packages bootstrap) @@ -251,6 +253,54 @@ (built-derivations (list check)))) (unless store (test-skip 1)) + (test-assertm "docker-layered-image + localstatedir" + (mlet* %store-monad + ((guile (set-guile-for-build (default-guile))) + (profile -> (profile + (content (packages->manifest (list %bootstrap-guile))) + (hooks '()) + (locales? #f))) + (tarball (docker-image "docker-pack" profile + #:symlinks '(("/bin/Guile" -> "bin/guile")) + #:localstatedir? #t + #:max-layers 100)) + (check (gexp->derivation + "check-tarball" + (with-imported-modules '((guix build utils)) + #~(begin + (use-modules (guix build utils) + (ice-9 match)) + + (define bin + (string-append "." #$profile "/bin")) + + (define store + (string-append "." #$(%store-directory))) + + (setenv "PATH" (string-append #$%tar-bootstrap "/bin")) + (mkdir "base") + (with-directory-excursion "base" + (invoke "tar" "xvf" #$tarball)) + + (match (find-files "base" "layer.tar") + ((layers ...) + (for-each (lambda (layer) + (invoke "tar" "xvf" layer) + (invoke "chmod" "--recursive" "u+w" store)) + layers))) + + (when + (and (file-exists? (string-append bin "/guile")) + (file-exists? "var/guix/db/db.sqlite") + (file-is-directory? "tmp") + (string=? (string-append #$%bootstrap-guile "/bin") + (readlink bin)) + (string=? (string-append #$profile "/bin/guile") + (readlink "bin/Guile"))) + (mkdir #$output))))))) + (built-derivations (list check)))) + + (unless store (test-skip 1)) (test-assertm "squashfs-image + localstatedir" (mlet* %store-monad ((guile (set-guile-for-build (default-guile))) |