unofficial mirror of guix-patches@gnu.org 
 help / color / mirror / code / Atom feed
* [bug#57680] [PATCH 0/2] image: Add tarball support.
@ 2022-09-08 15:25 Mathieu Othacehe
  2022-09-08 15:30 ` [bug#57680] [PATCH 1/2] guix: Add compression module Mathieu Othacehe
  0 siblings, 1 reply; 6+ messages in thread
From: Mathieu Othacehe @ 2022-09-08 15:25 UTC (permalink / raw)
  To: 57680; +Cc: Mathieu Othacehe

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





^ permalink raw reply	[flat|nested] 6+ messages in thread

* [bug#57680] [PATCH 1/2] guix: Add compression module.
  2022-09-08 15:25 [bug#57680] [PATCH 0/2] image: Add tarball support Mathieu Othacehe
@ 2022-09-08 15:30 ` Mathieu Othacehe
  2022-09-08 15:30   ` [bug#57680] [PATCH 2/2] system: image: Add tarball support Mathieu Othacehe
  2022-09-24 13:50   ` Ludovic Courtès
  0 siblings, 2 replies; 6+ messages in thread
From: Mathieu Othacehe @ 2022-09-08 15:30 UTC (permalink / raw)
  To: 57680; +Cc: Mathieu Othacehe

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@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





^ permalink raw reply related	[flat|nested] 6+ messages in thread

* [bug#57680] [PATCH 2/2] system: image: Add tarball support.
  2022-09-08 15:30 ` [bug#57680] [PATCH 1/2] guix: Add compression module Mathieu Othacehe
@ 2022-09-08 15:30   ` Mathieu Othacehe
  2022-09-24 13:52     ` [bug#57680] [PATCH 0/2] " Ludovic Courtès
  2022-09-24 13:50   ` Ludovic Courtès
  1 sibling, 1 reply; 6+ messages in thread
From: Mathieu Othacehe @ 2022-09-08 15:30 UTC (permalink / raw)
  To: 57680; +Cc: Mathieu Othacehe, Alex Griffin

From: Alex Griffin <a@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@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@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.
 ;;;
@@ -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?))))
 
+\f
+;;
+;; 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?))))
+
 \f
 ;;
 ;; 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





^ permalink raw reply related	[flat|nested] 6+ messages in thread

* [bug#57680] [PATCH 0/2] image: Add tarball support.
  2022-09-08 15:30 ` [bug#57680] [PATCH 1/2] guix: Add compression module Mathieu Othacehe
  2022-09-08 15:30   ` [bug#57680] [PATCH 2/2] system: image: Add tarball support Mathieu Othacehe
@ 2022-09-24 13:50   ` Ludovic Courtès
  2022-09-25  7:50     ` Mathieu Othacehe
  1 sibling, 1 reply; 6+ messages in thread
From: Ludovic Courtès @ 2022-09-24 13:50 UTC (permalink / raw)
  To: Mathieu Othacehe; +Cc: 57680

Mathieu Othacehe <othacehe@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’.




^ permalink raw reply	[flat|nested] 6+ messages in thread

* [bug#57680] [PATCH 0/2] image: Add tarball support.
  2022-09-08 15:30   ` [bug#57680] [PATCH 2/2] system: image: Add tarball support Mathieu Othacehe
@ 2022-09-24 13:52     ` Ludovic Courtès
  0 siblings, 0 replies; 6+ messages in thread
From: Ludovic Courtès @ 2022-09-24 13:52 UTC (permalink / raw)
  To: Mathieu Othacehe; +Cc: 57680, Alex Griffin

Hi,

Mathieu Othacehe <othacehe@gnu.org> skribis:

> From: Alex Griffin <a@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@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’.




^ permalink raw reply	[flat|nested] 6+ messages in thread

* [bug#57680] [PATCH 0/2] image: Add tarball support.
  2022-09-24 13:50   ` Ludovic Courtès
@ 2022-09-25  7:50     ` Mathieu Othacehe
  0 siblings, 0 replies; 6+ messages in thread
From: Mathieu Othacehe @ 2022-09-25  7:50 UTC (permalink / raw)
  To: Ludovic Courtès; +Cc: 57680


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




^ permalink raw reply	[flat|nested] 6+ messages in thread

end of thread, other threads:[~2022-09-25  7:52 UTC | newest]

Thread overview: 6+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2022-09-08 15:25 [bug#57680] [PATCH 0/2] image: Add tarball support Mathieu Othacehe
2022-09-08 15:30 ` [bug#57680] [PATCH 1/2] guix: Add compression module Mathieu Othacehe
2022-09-08 15:30   ` [bug#57680] [PATCH 2/2] system: image: Add tarball support Mathieu Othacehe
2022-09-24 13:52     ` [bug#57680] [PATCH 0/2] " Ludovic Courtès
2022-09-24 13:50   ` Ludovic Courtès
2022-09-25  7:50     ` Mathieu Othacehe

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