diff options
Diffstat (limited to 'gnu')
| -rw-r--r-- | gnu/image.scm | 4 | ||||
| -rw-r--r-- | gnu/system/image.scm | 41 |
2 files changed, 32 insertions, 13 deletions
diff --git a/gnu/image.scm b/gnu/image.scm index 523653dd77..7fb06dec10 100644 --- a/gnu/image.scm +++ b/gnu/image.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2020, 2022 Mathieu Othacehe <othacehe@gnu.org> +;;; Copyright © 2023 Oleg Pykhalov <go.wigust@gmail.com> ;;; ;;; This file is part of GNU Guix. ;;; @@ -42,6 +43,7 @@ image-format image-platform image-size + image-max-layers image-operating-system image-partition-table-type image-partitions @@ -170,6 +172,8 @@ that is not in SET, mentioning FIELD in the error message." (size image-size ;size in bytes as integer (default 'guess) (sanitize validate-size)) + (max-layers image-max-layers ;number of layers as integer + (default #false)) (operating-system image-operating-system) ;<operating-system> (partition-table-type image-partition-table-type ; 'mbr or 'gpt (default 'mbr) diff --git a/gnu/system/image.scm b/gnu/system/image.scm index b825892232..2cc1012893 100644 --- a/gnu/system/image.scm +++ b/gnu/system/image.scm @@ -5,6 +5,7 @@ ;;; Copyright © 2022 Denis 'GNUtoo' Carikli <GNUtoo@cyberdimension.org> ;;; Copyright © 2022 Alex Griffin <a@ajgrf.com> ;;; Copyright © 2023 Efraim Flashner <efraim@flashner.co.il> +;;; Copyright © 2023 Oleg Pykhalov <go.wigust@gmail.com> ;;; ;;; This file is part of GNU Guix. ;;; @@ -686,7 +687,8 @@ returns an image record where the first partition's label is set to <label>." (define* (system-docker-image image #:key - (name "docker-image")) + (name "docker-image") + (archiver tar)) "Build a docker image for IMAGE. NAME is the base name to use for the output file." (define boot-program @@ -731,6 +733,7 @@ output file." (use-modules (guix docker) (guix build utils) (gnu build image) + (srfi srfi-1) (srfi srfi-19) (guix build store-copy) (guix store database)) @@ -754,18 +757,30 @@ output file." #:register-closures? #$register-closures? #:deduplicate? #f #:system-directory #$os) - (build-docker-image - #$output - (cons* image-root - (map store-info-item - (call-with-input-file #$graph - read-reference-graph))) - #$os - #:entry-point '(#$boot-program #$os) - #:compressor '(#+(file-append gzip "/bin/gzip") "-9n") - #:creation-time (make-time time-utc 0 1) - #:system #$image-target - #:transformations `((,image-root -> "")))))))) + (when #$(image-max-layers image) + (setenv "PATH" + (string-join (list #+(file-append archiver "/bin") + #+(file-append gzip "/bin")) + ":"))) + (apply build-docker-image + (append (list #$output + (append (if #$(image-max-layers image) + '() + (list image-root)) + (map store-info-item + (call-with-input-file #$graph + read-reference-graph))) + #$os + #:entry-point '(#$boot-program #$os) + #:compressor + '(#+(file-append gzip "/bin/gzip") "-9n") + #:creation-time (make-time time-utc 0 1) + #:system #$image-target + #:transformations `((,image-root -> ""))) + (if #$(image-max-layers image) + (list #:root-system image-root + #:max-layers #$(image-max-layers image)) + '())))))))) (computed-file name builder ;; Allow offloading so that this I/O-intensive process |