GNU bug report logs - #57680
[PATCH 0/2] image: Add tarball support.

Previous Next

Package: guix-patches;

Reported by: Mathieu Othacehe <othacehe <at> gnu.org>

Date: Thu, 8 Sep 2022 15:26:01 UTC

Severity: normal

Tags: patch

Done: Mathieu Othacehe <mathieu <at> meije.mail-host-address-is-not-set>

Bug is archived. No further changes may be made.

To add a comment to this bug, you must first unarchive it, by sending
a message to control AT debbugs.gnu.org, with unarchive 57680 in the body.
You can then email your comments to 57680 AT debbugs.gnu.org in the normal way.

Toggle the display of automated, internal messages from the tracker.

View this report as an mbox folder, status mbox, maintainer mbox


Report forwarded to guix-patches <at> gnu.org:
bug#57680; Package guix-patches. (Thu, 08 Sep 2022 15:26:01 GMT) Full text and rfc822 format available.

Acknowledgement sent to Mathieu Othacehe <othacehe <at> gnu.org>:
New bug report received and forwarded. Copy sent to guix-patches <at> gnu.org. (Thu, 08 Sep 2022 15:26:01 GMT) Full text and rfc822 format available.

Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):

From: Mathieu Othacehe <othacehe <at> gnu.org>
To: guix-patches <at> gnu.org
Cc: Mathieu Othacehe <othacehe <at> gnu.org>
Subject: [PATCH 0/2] image: Add tarball support.
Date: Thu,  8 Sep 2022 17:25:12 +0200
Hello,

Here's some preliminary work to get https://issues.guix.gnu.org/53912
merged and provide WSL2 image support.

I added a (guix compression) module so that (guix system image)
can benefit from it.

Thanks,

Mathieu

Alex Griffin (1):
  system: image: Add tarball support.

Mathieu Othacehe (1):
  guix: Add compression module.

 Makefile.am           |  1 +
 gnu/image.scm         |  2 +-
 gnu/system/image.scm  | 82 ++++++++++++++++++++++++++++++++++++++++++-
 guix/compression.scm  | 69 ++++++++++++++++++++++++++++++++++++
 guix/scripts/pack.scm | 46 ++----------------------
 5 files changed, 154 insertions(+), 46 deletions(-)
 create mode 100644 guix/compression.scm

-- 
2.37.2





Information forwarded to guix-patches <at> gnu.org:
bug#57680; Package guix-patches. (Thu, 08 Sep 2022 15:32:02 GMT) Full text and rfc822 format available.

Message #8 received at 57680 <at> debbugs.gnu.org (full text, mbox):

From: Mathieu Othacehe <othacehe <at> gnu.org>
To: 57680 <at> debbugs.gnu.org
Cc: Mathieu Othacehe <othacehe <at> gnu.org>
Subject: [PATCH 1/2] guix: Add compression module.
Date: Thu,  8 Sep 2022 17:30:32 +0200
Move the compression record to a dedicated module so that it can be used
outside (guix scripts pack) module.

* guix/scripts/pack.scm (<compressor>, %compressors, lookup-compressor): Move
it to ...
* guix/compression.scm: ... this new file.
* Makefile.am (MODULES): Add it.
---
 Makefile.am           |  1 +
 guix/compression.scm  | 69 +++++++++++++++++++++++++++++++++++++++++++
 guix/scripts/pack.scm | 46 ++---------------------------
 3 files changed, 72 insertions(+), 44 deletions(-)
 create mode 100644 guix/compression.scm

diff --git a/Makefile.am b/Makefile.am
index 22dcc43f99..65b2ec4612 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -80,6 +80,7 @@ MODULES =					\
   guix/base32.scm				\
   guix/base64.scm				\
   guix/ci.scm					\
+  guix/compression.scm				\
   guix/cpio.scm					\
   guix/cpu.scm					\
   guix/deprecation.scm				\
diff --git a/guix/compression.scm b/guix/compression.scm
new file mode 100644
index 0000000000..10ec4a7cda
--- /dev/null
+++ b/guix/compression.scm
@@ -0,0 +1,69 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2022 Mathieu Othacehe <othacehe <at> gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix compression)
+  #:use-module (guix gexp)
+  #:use-module (guix ui)
+  #:use-module ((gnu packages compression) #:hide (zip))
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9)
+  #:use-module (ice-9 match)
+  #:export (compressor
+            compressor?
+            compressor-name
+            compressor-extension
+            compressor-command
+            %compressors
+            lookup-compressor))
+
+;; Type of a compression tool.
+(define-record-type <compressor>
+  (compressor name extension command)
+  compressor?
+  (name       compressor-name)      ;string (e.g., "gzip")
+  (extension  compressor-extension) ;string (e.g., ".lz")
+  (command    compressor-command))  ;gexp (e.g., #~(list "/gnu/store/…/gzip"
+                                    ;                    "-9n" ))
+
+(define %compressors
+  ;; Available compression tools.
+  (list (compressor "gzip"  ".gz"
+                    #~(list #+(file-append gzip "/bin/gzip") "-9n"))
+        (compressor "lzip"  ".lz"
+                    #~(list #+(file-append lzip "/bin/lzip") "-9"))
+        (compressor "xz"    ".xz"
+                    #~(append (list #+(file-append xz "/bin/xz")
+                                    "-e")
+                              (%xz-parallel-args)))
+        (compressor "bzip2" ".bz2"
+                    #~(list #+(file-append bzip2 "/bin/bzip2") "-9"))
+        (compressor "zstd" ".zst"
+                    ;; The default level 3 compresses better than gzip in a
+                    ;; fraction of the time, while the highest level 19
+                    ;; (de)compresses more slowly and worse than xz.
+                    #~(list #+(file-append zstd "/bin/zstd") "-3"))
+        (compressor "none" "" #f)))
+
+(define (lookup-compressor name)
+  "Return the compressor object called NAME.  Error out if it could not be
+found."
+  (or (find (match-lambda
+              (($ <compressor> name*)
+               (string=? name* name)))
+            %compressors)
+      (leave (G_ "~a: compressor not found~%") name)))
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index d3ee69840c..0331ec7b04 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -27,6 +27,7 @@
 (define-module (guix scripts pack)
   #:use-module (guix scripts)
   #:use-module (guix ui)
+  #:use-module (guix compression)
   #:use-module (guix gexp)
   #:use-module ((guix build utils) #:select (%xz-parallel-args))
   #:use-module (guix utils)
@@ -61,13 +62,7 @@ (define-module (guix scripts pack)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-37)
   #:use-module (ice-9 match)
-  #:export (compressor?
-            compressor-name
-            compressor-extension
-            compressor-command
-            %compressors
-            lookup-compressor
-            self-contained-tarball
+  #:export (self-contained-tarball
             debian-archive
             docker-image
             squashfs-image
@@ -75,34 +70,6 @@ (define-module (guix scripts pack)
             %formats
             guix-pack))
 
-;; Type of a compression tool.
-(define-record-type <compressor>
-  (compressor name extension command)
-  compressor?
-  (name       compressor-name)      ;string (e.g., "gzip")
-  (extension  compressor-extension) ;string (e.g., ".lz")
-  (command    compressor-command))  ;gexp (e.g., #~(list "/gnu/store/…/gzip"
-                                    ;                    "-9n" ))
-
-(define %compressors
-  ;; Available compression tools.
-  (list (compressor "gzip"  ".gz"
-                    #~(list #+(file-append gzip "/bin/gzip") "-9n"))
-        (compressor "lzip"  ".lz"
-                    #~(list #+(file-append lzip "/bin/lzip") "-9"))
-        (compressor "xz"    ".xz"
-                    #~(append (list #+(file-append xz "/bin/xz")
-                                    "-e")
-                              (%xz-parallel-args)))
-        (compressor "bzip2" ".bz2"
-                    #~(list #+(file-append bzip2 "/bin/bzip2") "-9"))
-        (compressor "zstd" ".zst"
-                    ;; The default level 3 compresses better than gzip in a
-                    ;; fraction of the time, while the highest level 19
-                    ;; (de)compresses more slowly and worse than xz.
-                    #~(list #+(file-append zstd "/bin/zstd") "-3"))
-        (compressor "none" "" #f)))
-
 ;; This one is only for use in this module, so don't put it in %compressors.
 (define bootstrap-xz
   (compressor "bootstrap-xz" ".xz"
@@ -110,15 +77,6 @@ (define bootstrap-xz
                               "-e")
                         (%xz-parallel-args))))
 
-(define (lookup-compressor name)
-  "Return the compressor object called NAME.  Error out if it could not be
-found."
-  (or (find (match-lambda
-              (($ <compressor> name*)
-               (string=? name* name)))
-            %compressors)
-      (leave (G_ "~a: compressor not found~%") name)))
-
 (define not-config?
   ;; Select (guix …) and (gnu …) modules, except (guix config).
   (match-lambda
-- 
2.37.2





Information forwarded to guix-patches <at> gnu.org:
bug#57680; Package guix-patches. (Thu, 08 Sep 2022 15:32:02 GMT) Full text and rfc822 format available.

Message #11 received at 57680 <at> debbugs.gnu.org (full text, mbox):

From: Mathieu Othacehe <othacehe <at> gnu.org>
To: 57680 <at> debbugs.gnu.org
Cc: Mathieu Othacehe <othacehe <at> gnu.org>, Alex Griffin <a <at> ajgrf.com>
Subject: [PATCH 2/2] system: image: Add tarball support.
Date: Thu,  8 Sep 2022 17:30:33 +0200
From: Alex Griffin <a <at> ajgrf.com>

* 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.

Signed-off-by: Mathieu Othacehe <othacehe <at> gnu.org>
---
 gnu/image.scm        |  2 +-
 gnu/system/image.scm | 82 +++++++++++++++++++++++++++++++++++++++++++-
 2 files changed, 82 insertions(+), 2 deletions(-)

diff --git a/gnu/image.scm b/gnu/image.scm
index 4a0068934e..18e24d3cac 100644
--- a/gnu/image.scm
+++ b/gnu/image.scm
@@ -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
diff --git a/gnu/system/image.scm b/gnu/system/image.scm
index a04363a130..5e50210523 100644
--- a/gnu/system/image.scm
+++ b/gnu/system/image.scm
@@ -3,6 +3,7 @@
 ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke <at> gnu.org>
 ;;; Copyright © 2022 Pavel Shlyak <p.shlyak <at> pantherx.org>
 ;;; Copyright © 2022 Denis 'GNUtoo' Carikli <GNUtoo <at> cyberdimension.org>
+;;; Copyright © 2022 Alex Griffin <a <at> ajgrf.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -20,6 +21,7 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (gnu system image)
+  #:use-module (guix compression)
   #:use-module (guix diagnostics)
   #:use-module (guix discovery)
   #:use-module (guix gexp)
@@ -73,6 +75,7 @@ (define-module (gnu system image)
             efi-disk-image
             iso9660-image
             docker-image
+            tarball-image
             raw-with-offset-disk-image
 
             image-with-os
@@ -82,6 +85,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
@@ -149,6 +153,10 @@ (define docker-image
   (image
    (format 'docker)))
 
+(define tarball-image
+  (image
+   (format 'tarball)))
+
 (define* (raw-with-offset-disk-image #:optional (offset root-offset))
   (image
    (format 'disk-image)
@@ -211,6 +219,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)
@@ -681,6 +694,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.
@@ -690,7 +768,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)))))
 
@@ -827,6 +905,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*
-- 
2.37.2





Information forwarded to guix-patches <at> gnu.org:
bug#57680; Package guix-patches. (Sat, 24 Sep 2022 13:51:01 GMT) Full text and rfc822 format available.

Message #14 received at 57680 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: Mathieu Othacehe <othacehe <at> gnu.org>
Cc: 57680 <at> debbugs.gnu.org
Subject: Re: bug#57680: [PATCH 0/2] image: Add tarball support.
Date: Sat, 24 Sep 2022 15:50:22 +0200
Mathieu Othacehe <othacehe <at> gnu.org> skribis:

> Move the compression record to a dedicated module so that it can be used
> outside (guix scripts pack) module.
>
> * guix/scripts/pack.scm (<compressor>, %compressors, lookup-compressor): Move
> it to ...
> * guix/compression.scm: ... this new file.
> * Makefile.am (MODULES): Add it.

I’m pretty sure I commented on this patch as part of another series
recently but I can’t find it anymore.

The guts of it is:

  1. (guix compression) sounds like it could just as well be about
     offering an abstraction over guile-{zlib,zstd,lzlib} like that
     currently in (guix utils).  So the name is misleading.

  2. We cannot refer to (gnu …) from (guix …) or, if we really need to
     do so, then that should happen lazily at run time (do not miss
     Josselin’s excellent guided tour at the Ten Years, which included a
     discussion of this! :-)).

Hope that makes sense!

Ludo’.




Information forwarded to guix-patches <at> gnu.org:
bug#57680; Package guix-patches. (Sat, 24 Sep 2022 13:53:01 GMT) Full text and rfc822 format available.

Message #17 received at 57680 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: Mathieu Othacehe <othacehe <at> gnu.org>
Cc: 57680 <at> debbugs.gnu.org, Alex Griffin <a <at> ajgrf.com>
Subject: Re: bug#57680: [PATCH 0/2] image: Add tarball support.
Date: Sat, 24 Sep 2022 15:52:05 +0200
Hi,

Mathieu Othacehe <othacehe <at> gnu.org> skribis:

> From: Alex Griffin <a <at> ajgrf.com>
>
> * 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.
>
> Signed-off-by: Mathieu Othacehe <othacehe <at> gnu.org>

Nice!

Perhaps we need to mention it in the manual?

> +;;
> +;; Tarball image.
> +;;

Three semicolons maybe?  :-)

> +(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?))))

There’s probably something to be factorized with (guix scripts pack),
but that can be left for later with a TODO.

Otherwise LGTM, thank you & Alex!

Ludo’.




Information forwarded to guix-patches <at> gnu.org:
bug#57680; Package guix-patches. (Sun, 25 Sep 2022 07:51:02 GMT) Full text and rfc822 format available.

Message #20 received at 57680 <at> debbugs.gnu.org (full text, mbox):

From: Mathieu Othacehe <othacehe <at> gnu.org>
To: Ludovic Courtès <ludo <at> gnu.org>
Cc: 57680 <at> debbugs.gnu.org
Subject: Re: bug#57680: [PATCH 0/2] image: Add tarball support.
Date: Sun, 25 Sep 2022 09:50:45 +0200
Hey,

> I’m pretty sure I commented on this patch as part of another series
> recently but I can’t find it anymore.

Here it was: https://lists.gnu.org/archive/html/guix-devel/2022-09/msg00094.html

>   1. (guix compression) sounds like it could just as well be about
>      offering an abstraction over guile-{zlib,zstd,lzlib} like that
>      currently in (guix utils).  So the name is misleading.

While I agree, I cannot think of another name. Maybe (gnu compressor) as
this is the name of the defined record?

>   2. We cannot refer to (gnu …) from (guix …) or, if we really need to
>      do so, then that should happen lazily at run time (do not miss
>      Josselin’s excellent guided tour at the Ten Years, which included a
>      discussion of this! :-)).

I moved it to (gnu compression) for now. Yeah, I'm polling the 10years
page to be able to watch this presentation among others ;).

Thanks,

Mathieu




bug closed, send any further explanations to 57680 <at> debbugs.gnu.org and Mathieu Othacehe <othacehe <at> gnu.org> Request was from Mathieu Othacehe <mathieu <at> meije.mail-host-address-is-not-set> to control <at> debbugs.gnu.org. (Sun, 25 Sep 2022 11:56:01 GMT) Full text and rfc822 format available.

bug archived. Request was from Debbugs Internal Request <help-debbugs <at> gnu.org> to internal_control <at> debbugs.gnu.org. (Mon, 24 Oct 2022 11:24:13 GMT) Full text and rfc822 format available.

This bug report was last modified 1 year and 183 days ago.

Previous Next


GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.