diff options
author | Alex Griffin <a@ajgrf.com> | 2022-02-06 16:29:47 -0600 |
---|---|---|
committer | Mathieu Othacehe <othacehe@gnu.org> | 2022-09-24 14:49:09 +0200 |
commit | 8757c3f2934352fe8ad9a86f6e6f1d4b7245644d (patch) | |
tree | 4b958569f1a374f072d8d5b006d407bb2e1a140e /gnu/system | |
parent | ebe9d660a55629f2506db124b0e016885fc61e5c (diff) | |
download | guix-patches-8757c3f2934352fe8ad9a86f6e6f1d4b7245644d.tar guix-patches-8757c3f2934352fe8ad9a86f6e6f1d4b7245644d.tar.gz |
system: image: Add tarball support.
* gnu/image.scm (<image>)[fields]: Add tarball to the supported formats.
* gnu/system/image.scm (tarball-image, tarball-image-type): New variables.
(system-tarball-image): New procedure.
(image->root-file-system): Add tarball image support.
(system-image): Ditto.
* doc/guix.texi ("System Images"): Document it.
Signed-off-by: Mathieu Othacehe <othacehe@gnu.org>
Diffstat (limited to 'gnu/system')
-rw-r--r-- | gnu/system/image.scm | 82 |
1 files changed, 81 insertions, 1 deletions
diff --git a/gnu/system/image.scm b/gnu/system/image.scm index c59b7eafd7..d60649b6e3 100644 --- a/gnu/system/image.scm +++ b/gnu/system/image.scm @@ -3,6 +3,7 @@ ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org> ;;; Copyright © 2022 Pavel Shlyak <p.shlyak@pantherx.org> ;;; Copyright © 2022 Denis 'GNUtoo' Carikli <GNUtoo@cyberdimension.org> +;;; Copyright © 2022 Alex Griffin <a@ajgrf.com> ;;; ;;; This file is part of GNU Guix. ;;; @@ -32,6 +33,7 @@ #:use-module ((guix self) #:select (make-config.scm)) #:use-module (gnu bootloader) #:use-module (gnu bootloader grub) + #:use-module (gnu compression) #:use-module (gnu image) #:use-module (guix platform) #:use-module (gnu services) @@ -74,6 +76,7 @@ efi-disk-image iso9660-image docker-image + tarball-image raw-with-offset-disk-image image-with-os @@ -83,6 +86,7 @@ iso-image-type uncompressed-iso-image-type docker-image-type + tarball-image-type raw-with-offset-image-type image-with-label @@ -156,6 +160,10 @@ parent image record." (image-without-os (format 'docker))) +(define tarball-image + (image-without-os + (format 'tarball))) + (define* (raw-with-offset-disk-image #:optional (offset root-offset)) (image-without-os (format 'disk-image) @@ -218,6 +226,11 @@ set to the given OS." (name 'docker) (constructor (cut image-with-os docker-image <>)))) +(define tarball-image-type + (image-type + (name 'tarball) + (constructor (cut image-with-os tarball-image <>)))) + (define raw-with-offset-image-type (image-type (name 'raw-with-offset) @@ -690,6 +703,71 @@ output file." ;; +;; Tarball image. +;; + +(define* (system-tarball-image image + #:key + (name "image") + (compressor (srfi-1:first %compressors))) + "Build a tarball of IMAGE. NAME is the base name to use for the +output file." + (let* ((os (image-operating-system image)) + (substitutable? (image-substitutable? image)) + (schema (local-file (search-path %load-path + "guix/store/schema.sql"))) + (name (string-append name ".tar" (compressor-extension compressor))) + (graph "system-graph")) + (define builder + (with-extensions gcrypt-sqlite3&co ;for (guix store database) + (with-imported-modules `(,@(source-module-closure + '((guix build pack) + (guix build store-copy) + (guix build utils) + (guix store database) + (gnu build image)) + #:select? not-config?) + ((guix config) => ,(make-config.scm))) + #~(begin + (use-modules (guix build pack) + (guix build store-copy) + (guix build utils) + (guix store database) + (gnu build image)) + + ;; Set the SQL schema location. + (sql-schema #$schema) + + ;; Allow non-ASCII file names--e.g., 'nss-certs'--to be decoded. + (setenv "GUIX_LOCPATH" + #+(file-append glibc-utf8-locales "/lib/locale")) + (setlocale LC_ALL "en_US.utf8") + + (let ((image-root (string-append (getcwd) "/tmp-root")) + (tar #+(file-append tar "/bin/tar"))) + + (mkdir-p image-root) + (initialize-root-partition image-root + #:references-graphs '(#$graph) + #:deduplicate? #f + #:system-directory #$os) + + (with-directory-excursion image-root + (apply invoke tar "-cvf" #$output "." + (tar-base-options + #:tar tar + #:compressor + #+(and=> compressor compressor-command))))))))) + + (computed-file name builder + ;; Allow offloading so that this I/O-intensive process + ;; doesn't run on the build farm's head node. + #:local-build? #f + #:options `(#:references-graphs ((,graph ,os)) + #:substitutable? ,substitutable?)))) + + +;; ;; Image creation. ;; @@ -697,7 +775,7 @@ output file." "Return the IMAGE root partition file-system type." (case (image-format image) ((iso9660) "iso9660") - ((docker) "dummy") + ((docker tarball) "dummy") (else (partition-file-system (find-root-partition image))))) @@ -834,6 +912,8 @@ image, depending on IMAGE format." ("bootcfg" ,bootcfg)))) ((memq image-format '(docker)) (system-docker-image image*)) + ((memq image-format '(tarball)) + (system-tarball-image image*)) ((memq image-format '(iso9660)) (system-iso9660-image image* |