scripts: system: Build layered images.
* guix/scripts/system.scm (show-help, %docker-format-options, %options, %default-options, show-docker-format-options, show-docker-format-options/detailed, process-action): Handle '--max-layers' option. * gnu/system/image.scm (system-docker-image): Same. * gnu/image.scm (<image>)[max-layers]: New record field. Change-Id: I2726655aefd6688b976057fd5a38e9972ebfc292master
Oleg Pykhalov
parent
0cf75c9b2f
commit
519e1e3eb8
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -58,6 +58,7 @@
|
|||
#:use-module (guix scripts system reconfigure)
|
||||
#:use-module (guix build utils)
|
||||
#:use-module (guix progress)
|
||||
#:use-module ((guix docker) #:select (%docker-image-max-layers))
|
||||
#:use-module (gnu build image)
|
||||
#:use-module (gnu build install)
|
||||
#:autoload (gnu build file-systems)
|
||||
|
|
@ -1053,6 +1054,8 @@ Some ACTIONS support additional ARGS.\n"))
|
|||
(newline)
|
||||
(show-native-build-options-help)
|
||||
(newline)
|
||||
(show-docker-format-options)
|
||||
(newline)
|
||||
(display (G_ "
|
||||
-h, --help display this help and exit"))
|
||||
(display (G_ "
|
||||
|
|
@ -1060,12 +1063,21 @@ Some ACTIONS support additional ARGS.\n"))
|
|||
(newline)
|
||||
(show-bug-report-information))
|
||||
|
||||
(define %docker-format-options
|
||||
(list (option '("max-layers") #t #f
|
||||
(lambda (opt name arg result)
|
||||
(alist-cons 'max-layers (string->number* arg)
|
||||
result)))))
|
||||
|
||||
(define %options
|
||||
;; Specifications of the command-line options.
|
||||
(cons* (option '(#\h "help") #f #f
|
||||
(lambda args
|
||||
(leave-on-EPIPE (show-help))
|
||||
(exit 0)))
|
||||
(option '("help-docker-format") #f #f
|
||||
(lambda args
|
||||
(show-docker-format-options/detailed)))
|
||||
(option '(#\V "version") #f #f
|
||||
(lambda args
|
||||
(show-version-and-exit "guix system")))
|
||||
|
|
@ -1154,7 +1166,8 @@ Some ACTIONS support additional ARGS.\n"))
|
|||
(alist-cons 'list-installed (or arg "") result)))
|
||||
(append %standard-build-options
|
||||
%standard-cross-build-options
|
||||
%standard-native-build-options)))
|
||||
%standard-native-build-options
|
||||
%docker-format-options)))
|
||||
|
||||
(define %default-options
|
||||
;; Alist of default option values.
|
||||
|
|
@ -1175,7 +1188,8 @@ Some ACTIONS support additional ARGS.\n"))
|
|||
(label . #f)
|
||||
(volatile-image-root? . #f)
|
||||
(volatile-vm-root? . #t)
|
||||
(graph-backend . "graphviz")))
|
||||
(graph-backend . "graphviz")
|
||||
(max-layers . ,%docker-image-max-layers)))
|
||||
|
||||
(define (verbosity-level opts)
|
||||
"Return the verbosity level based on OPTS, the alist of parsed options."
|
||||
|
|
@ -1183,6 +1197,17 @@ Some ACTIONS support additional ARGS.\n"))
|
|||
(if (eq? (assoc-ref opts 'action) 'build)
|
||||
3 1)))
|
||||
|
||||
(define (show-docker-format-options)
|
||||
(display (G_ "
|
||||
--help-docker-format list options specific to the docker image type.")))
|
||||
|
||||
(define (show-docker-format-options/detailed)
|
||||
(display (G_ "
|
||||
--max-layers=N
|
||||
Number of image layers"))
|
||||
(newline)
|
||||
(exit 0))
|
||||
|
||||
|
||||
;;;
|
||||
;;; Entry point.
|
||||
|
|
@ -1245,6 +1270,7 @@ resulting from command-line parsing."
|
|||
((docker-image) docker-image-type)
|
||||
(else image-type)))
|
||||
(image-size (assoc-ref opts 'image-size))
|
||||
(image-max-layers (assoc-ref opts 'max-layers))
|
||||
(volatile?
|
||||
(assoc-ref opts 'volatile-image-root?))
|
||||
(shared-network?
|
||||
|
|
@ -1258,6 +1284,7 @@ resulting from command-line parsing."
|
|||
(image-with-label base-image label)
|
||||
base-image))
|
||||
(size image-size)
|
||||
(max-layers image-max-layers)
|
||||
(volatile-root? volatile?)
|
||||
(shared-network? shared-network?))))
|
||||
(os (or (image-operating-system image)
|
||||
|
|
|
|||
Reference in New Issue