guix: pack: Build layered images.

* guix/scripts/pack.scm (docker-image, guix-pack, %default-options,
%docker-format-options, show-docker-format-options/detailed): Handle
'--max-layers' option.
* doc/guix.texi (Invoking guix pack): Document this.

Change-Id: I90660b2421fcdde891f003469fe2e2edaac7da41
This commit is contained in:
Oleg Pykhalov 2023-12-26 03:54:12 +03:00
parent d3d3eedf7f
commit 0cf75c9b2f
No known key found for this signature in database
GPG Key ID: 167F8EA5001AFA9C
3 changed files with 116 additions and 20 deletions

View File

@ -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.

View File

@ -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)

View File

@ -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)
@ -250,6 +252,54 @@
(mkdir #$output)))))))
(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