From: Oleg Pykhalov <go.wigust@gmail.com>
To: 62153@debbugs.gnu.org
Cc: "Oleg Pykhalov" <go.wigust@gmail.com>,
"Christopher Baines" <guix@cbaines.net>,
"Josselin Poiret" <dev@jpoiret.xyz>,
"Ludovic Courtès" <ludo@gnu.org>,
"Mathieu Othacehe" <othacehe@gnu.org>,
"Ricardo Wurmus" <rekado@elephly.net>,
"Simon Tournier" <zimon.toutoune@gmail.com>,
"Tobias Geerinckx-Rice" <me@tobias.gr>
Subject: [bug#62153] [PATCH 5/5] scripts: system: Build layered images.
Date: Tue, 26 Dec 2023 05:18:57 +0300 [thread overview]
Message-ID: <99155dabc366c37acb71f6624aa6e6025b3e571b.1703556298.git.go.wigust@gmail.com> (raw)
In-Reply-To: <cover.1703556298.git.go.wigust@gmail.com>
* 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: I2726655aefd6688b976057fd5a38e9972ebfc292
---
gnu/image.scm | 4 ++++
gnu/system/image.scm | 41 ++++++++++++++++++++++++++++-------------
guix/scripts/system.scm | 28 ++++++++++++++++++++++++++--
3 files changed, 58 insertions(+), 15 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 @@ (define-module (gnu image)
image-format
image-platform
image-size
+ image-max-layers
image-operating-system
image-partition-table-type
image-partitions
@@ -170,6 +172,8 @@ (define-record-type* <image>
(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 @@ (define (image-with-label base-image 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 @@ (define* (system-docker-image image
(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 @@ (define* (system-docker-image image
#: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
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index f85b663d64..a21ecd4d1e 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -58,6 +58,7 @@ (define-module (guix scripts system)
#: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 @@ (define (show-help)
(newline)
(show-native-build-options-help)
(newline)
+ (show-docker-format-options)
+ (newline)
(display (G_ "
-h, --help display this help and exit"))
(display (G_ "
@@ -1060,6 +1063,12 @@ (define (show-help)
(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
@@ -1154,7 +1163,8 @@ (define %options
(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 +1185,8 @@ (define %default-options
(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 +1194,17 @@ (define (verbosity-level opts)
(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))
+
\f
;;;
;;; Entry point.
@@ -1245,6 +1267,7 @@ (define (process-action action args opts)
((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 +1281,7 @@ (define (process-action action args opts)
(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)
--
2.41.0
next prev parent reply other threads:[~2023-12-26 2:21 UTC|newest]
Thread overview: 42+ messages / expand[flat|nested] mbox.gz Atom feed top
2023-03-13 0:30 [bug#62153] [PATCH 0/2] Add Docker layered image for pack and system Oleg Pykhalov
2023-03-13 0:33 ` [bug#62153] [PATCH 1/2] guix: docker: Build layered image Oleg Pykhalov
2023-03-13 0:33 ` [bug#62153] [PATCH 2/2] news: Add entry for the new 'docker-layered' distribution format Oleg Pykhalov
2023-03-13 21:09 ` pelzflorian (Florian Pelz)
2023-03-14 0:24 ` [bug#62153] [PATCH 0/2] Add Docker layered image for pack and system (v2) Oleg Pykhalov
2023-03-14 0:24 ` [bug#62153] [PATCH 1/2] guix: docker: Build layered image Oleg Pykhalov
2023-03-14 0:24 ` [bug#62153] [PATCH 2/2] news: Add entry for the new 'docker-layered' distribution format Oleg Pykhalov
2023-03-13 15:01 ` [bug#62153] [PATCH 1/2] guix: docker: Build layered image Simon Tournier
2023-03-13 21:10 ` Oleg Pykhalov
2023-03-14 8:19 ` Simon Tournier
2023-03-14 9:15 ` Ricardo Wurmus
2023-03-16 10:37 ` Ludovic Courtès
2023-03-20 6:38 ` Oleg Pykhalov
2023-03-20 16:51 ` [bug#62153] [PATCH 0/2] Disarchive vs Gash-Utils for docker-layered Oleg Pykhalov
2023-03-14 9:11 ` [bug#62153] [PATCH 1/2] guix: docker: Build layered image Christopher Baines
2023-03-13 0:43 ` [bug#62153] Cover lever typo in guix pack format example Oleg Pykhalov
2023-03-14 0:40 ` [bug#62153] Missing diff in cover lever for v2 patch Oleg Pykhalov
2023-05-31 8:45 ` [bug#62153] [PATCH] Add Docker layered image for pack and system (v3) Oleg Pykhalov
2023-05-31 8:47 ` [bug#62153] [PATCH] guix: docker: Build layered image Oleg Pykhalov
2023-05-31 8:47 ` [bug#62153] [PATCH] news: Add entry for the new 'docker-layered' distribution format Oleg Pykhalov
2023-05-31 12:53 ` [bug#62153] [PATCH] Add Docker layered image for pack and system (v3) Greg Hogan
2023-05-31 13:14 ` Oleg Pykhalov
2023-06-02 17:02 ` Greg Hogan
2023-06-03 19:10 ` [bug#62153] [PATCH 0/2] Add Docker layered image for pack and system Oleg Pykhalov
2023-06-03 19:14 ` [bug#62153] [PATCH v4 1/2] guix: docker: Build layered image Oleg Pykhalov
2023-12-22 22:10 ` Ludovic Courtès
2023-06-03 19:16 ` [bug#62153] [PATCH v4] news: Add entry for the new 'docker-layered' distribution format Oleg Pykhalov
2023-12-26 2:15 ` [bug#62153] [PATCH v5 0/5] Add Docker layered image for pack and system Oleg Pykhalov
2023-12-26 2:18 ` [bug#62153] [PATCH 1/5] guix: pack: Add '--entry-point-argument' option Oleg Pykhalov
2023-12-27 18:14 ` Mathieu Othacehe
2023-12-27 18:16 ` Mathieu Othacehe
2023-12-26 2:18 ` [bug#62153] [PATCH 2/5] tests: docker-system: Increase image size Oleg Pykhalov
2023-12-26 2:18 ` [bug#62153] [PATCH 3/5] guix: docker: Build layered images Oleg Pykhalov
2023-12-27 20:15 ` Mathieu Othacehe
2024-01-18 14:55 ` Ludovic Courtès
2023-12-26 2:18 ` [bug#62153] [PATCH 4/5] guix: pack: " Oleg Pykhalov
2023-12-27 20:25 ` Mathieu Othacehe
2023-12-26 2:18 ` Oleg Pykhalov [this message]
2023-12-27 20:29 ` [bug#62153] [PATCH 5/5] scripts: system: " Mathieu Othacehe
2024-01-08 16:49 ` Ludovic Courtès
2024-01-09 12:58 ` bug#62153: " Oleg Pykhalov
[not found] ` <878r9xb2e6.fsf@gmail.com>
[not found] ` <875y0p99c4.fsf@gnu.org>
2023-12-26 2:40 ` [bug#62153] Merging guix pack changes for Docker containers packaging Oleg Pykhalov
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://guix.gnu.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=99155dabc366c37acb71f6624aa6e6025b3e571b.1703556298.git.go.wigust@gmail.com \
--to=go.wigust@gmail.com \
--cc=62153@debbugs.gnu.org \
--cc=dev@jpoiret.xyz \
--cc=guix@cbaines.net \
--cc=ludo@gnu.org \
--cc=me@tobias.gr \
--cc=othacehe@gnu.org \
--cc=rekado@elephly.net \
--cc=zimon.toutoune@gmail.com \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/guix.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).