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>
This commit is contained in:
Alex Griffin 2022-02-06 16:29:47 -06:00 committed by Mathieu Othacehe
parent ebe9d660a5
commit 8757c3f293
No known key found for this signature in database
GPG key ID: 8354763531769CA6
3 changed files with 84 additions and 2 deletions

View file

@ -41474,6 +41474,8 @@ one or multiple partitions.
@item @code{iso9660}, an ISO-9660 image.
@item @code{tarball}, a tar.gz image archive.
@end itemize
@item @code{platform} (default: @code{#false})

View file

@ -152,7 +152,7 @@ (define-with-syntax-properties (name (value properties))
;; The supported image formats.
(define-set-sanitizer validate-image-format format
(disk-image compressed-qcow2 docker iso9660))
(disk-image compressed-qcow2 docker iso9660 tarball))
;; The supported partition table types.
(define-set-sanitizer validate-partition-table-type partition-table-type

View file

@ -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 @@ (define-module (gnu system image)
#: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 @@ (define-module (gnu system image)
efi-disk-image
iso9660-image
docker-image
tarball-image
raw-with-offset-disk-image
image-with-os
@ -83,6 +86,7 @@ (define-module (gnu system image)
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 @@ (define docker-image
(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 @@ (define docker-image-type
(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)
@ -688,6 +701,71 @@ (define builder
#:options `(#:references-graphs ((,graph ,os))
#:substitutable? ,substitutable?))))
;;
;; 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 @@ (define (image->root-file-system image)
"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 @@ (define target (cond
("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*