unofficial mirror of guix-patches@gnu.org 
 help / color / mirror / code / Atom feed
From: Maxim Cournoyer <maxim.cournoyer@gmail.com>
To: 49149@debbugs.gnu.org
Cc: Maxim Cournoyer <maxim.cournoyer@gmail.com>
Subject: [bug#49149] [PATCH 2/7] pack: Factorize base tar options.
Date: Mon, 21 Jun 2021 02:12:00 -0400	[thread overview]
Message-ID: <20210621061205.31878-3-maxim.cournoyer@gmail.com> (raw)
In-Reply-To: <20210621061205.31878-1-maxim.cournoyer@gmail.com>

* guix/docker.scm (%tar-determinism-options): Move to a new module and rename
to `tar-base-options'.  Adjust references accordingly.
* guix/build/pack.scm: New file.
* Makefile.am (MODULES): Register it.
* guix/scripts/pack.scm (self-contained-tarball/builder): Use it.
---
 Makefile.am           |  1 +
 guix/build/pack.scm   | 52 +++++++++++++++++++++++++++
 guix/docker.scm       | 20 ++---------
 guix/scripts/pack.scm | 81 +++++++++++++++++--------------------------
 4 files changed, 87 insertions(+), 67 deletions(-)
 create mode 100644 guix/build/pack.scm

diff --git a/Makefile.am b/Makefile.am
index aa21b5383b..9c4b33c77a 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -220,6 +220,7 @@ MODULES =					\
   guix/build/linux-module-build-system.scm	\
   guix/build/store-copy.scm			\
   guix/build/json.scm				\
+  guix/build/pack.scm				\
   guix/build/utils.scm				\
   guix/build/union.scm				\
   guix/build/profiles.scm			\
diff --git a/guix/build/pack.scm b/guix/build/pack.scm
new file mode 100644
index 0000000000..05c7a3c594
--- /dev/null
+++ b/guix/build/pack.scm
@@ -0,0 +1,52 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;;
+;;; 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 build pack)
+  #:use-module (guix build utils)
+  #:export (tar-base-options))
+
+(define* (tar-base-options #:key tar compressor)
+  "Return the base GNU tar options required to produce deterministic archives
+deterministically.  When TAR, a GNU tar command file name, is provided, the
+`--sort' option is used only if supported.  When COMPRESSOR, a command such as
+'(\"gzip\" \"-9n\"), is provided, the compressor is explicitly specified via
+the `-I' option."
+  (define (tar-supports-sort? tar)
+    (zero? (system* tar "cf" "/dev/null" "--files-from=/dev/null"
+                    "--sort=name")))
+
+  `(,@(if compressor
+          (list "-I" (string-join compressor))
+          '())
+    ;; The --sort option was added to GNU tar in version 1.28, released
+    ;; 2014-07-28.  For testing, we use the bootstrap tar, which is older
+    ;; and doesn't support it.
+    ,@(if (and=> tar tar-supports-sort?)
+          '("--sort=name")
+          '())
+    ;; Use GNU format so there's no file name length limitation.
+    "--format=gnu"
+    "--mtime=@1"
+    "--owner=root:0"
+    "--group=root:0"
+    ;; The 'nlink' of the store item files leads tar to store hard links
+    ;; instead of actual copies.  However, the 'nlink' count depends on
+    ;; deduplication in the store; it's an "implicit input" to the build
+    ;; process.  Use '--hard-dereference' to eliminate it.
+    "--hard-dereference"
+    "--check-links"))
diff --git a/guix/docker.scm b/guix/docker.scm
index 889aaeacb5..bd952e45ec 100644
--- a/guix/docker.scm
+++ b/guix/docker.scm
@@ -21,6 +21,7 @@
 (define-module (guix docker)
   #:use-module (gcrypt hash)
   #:use-module (guix base16)
+  #:use-module (guix build pack)
   #:use-module ((guix build utils)
                 #:select (mkdir-p
                           delete-file-recursively
@@ -110,18 +111,6 @@ Return a version of TAG that follows these rules."
     (rootfs . ((type . "layers")
                (diff_ids . #(,(layer-diff-id layer)))))))
 
-(define %tar-determinism-options
-  ;; GNU tar options to produce archives deterministically.
-  '("--sort=name" "--mtime=@1"
-    "--owner=root:0" "--group=root:0"
-
-    ;; When 'build-docker-image' is passed store items, the 'nlink' of the
-    ;; files therein leads tar to store hard links instead of actual copies.
-    ;; However, the 'nlink' count depends on deduplication in the store; it's
-    ;; an "implicit input" to the build process.  '--hard-dereference'
-    ;; eliminates it.
-    "--hard-dereference"))
-
 (define directive-file
   ;; Return the file or directory created by a 'evaluate-populate-directive'
   ;; directive.
@@ -238,7 +227,7 @@ SRFI-19 time-utc object, as the creation time in metadata."
 
           (apply invoke "tar" "-cf" "../layer.tar"
                  `(,@transformation-options
-                   ,@%tar-determinism-options
+                   ,@(tar-base-options)
                    ,@paths
                    ,@(scandir "."
                               (lambda (file)
@@ -273,9 +262,6 @@ SRFI-19 time-utc object, as the creation time in metadata."
           (scm->json (repositories prefix id repository)))))
 
     (apply invoke "tar" "-cf" image "-C" directory
-           `(,@%tar-determinism-options
-             ,@(if compressor
-                   (list "-I" (string-join compressor))
-                   '())
+           `(,@(tar-base-options #:compressor compressor)
              "."))
     (delete-file-recursively directory)))
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index ac477850e6..d11f498925 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -205,12 +205,14 @@ dependencies are registered."
          (not (equal? '(guix store deduplication) module))))
 
   (with-imported-modules (source-module-closure
-                          `((guix build utils)
+                          `((guix build pack)
+                            (guix build utils)
                             (guix build union)
                             (gnu build install))
                           #:select? import-module?)
     #~(begin
-        (use-modules (guix build utils)
+        (use-modules (guix build pack)
+                     (guix build utils)
                      ((guix build union) #:select (relative-file-name))
                      (gnu build install)
                      (srfi srfi-1)
@@ -240,19 +242,10 @@ dependencies are registered."
           ;; Fully-qualified symlinks.
           (append-map symlink->directives '#$symlinks))
 
-        ;; The --sort option was added to GNU tar in version 1.28, released
-        ;; 2014-07-28.  For testing, we use the bootstrap tar, which is
-        ;; older and doesn't support it.
-        (define tar-supports-sort?
-          (zero? (system* (string-append #+archiver "/bin/tar")
-                          "cf" "/dev/null" "--files-from=/dev/null"
-                          "--sort=name")))
-
         ;; Make sure non-ASCII file names are properly handled.
         #+set-utf8-locale
 
-        ;; Add 'tar' to the search path.
-        (setenv "PATH" #+(file-append archiver "/bin"))
+        (define tar #+(file-append archiver "/bin/tar"))
 
         ;; Note: there is not much to gain here with deduplication and there
         ;; is the overhead of the '.links' directory, so turn it off.
@@ -269,45 +262,33 @@ dependencies are registered."
         (for-each (cut evaluate-populate-directive <> %root)
                   directives)
 
-        ;; Create the tarball.  Use GNU format so there's no file name
-        ;; length limitation.
+        ;; Create the tarball.
         (with-directory-excursion %root
-          (apply invoke "tar"
-                 #+@(if (compressor-command compressor)
-                        #~("-I"
-                           (string-join
-                            '#+(compressor-command compressor)))
-                        #~())
-                 "--format=gnu"
-                 ;; Avoid non-determinism in the archive.
-                 ;; Use mtime = 1, not zero, because that is what the daemon
-                 ;; does for files in the store (see the 'mtimeStore' constant
-                 ;; in local-store.cc.)
-                 (if tar-supports-sort? "--sort=name" "--mtime=@1")
-                 "--owner=root:0"
-                 "--group=root:0"
-                 "--check-links"
-                 "-cvf" #$output
-                 ;; Avoid adding / and /var to the tarball, so
-                 ;; that the ownership and permissions of those
-                 ;; directories will not be overwritten when
-                 ;; extracting the archive.  Do not include /root
-                 ;; because the root account might have a
-                 ;; different home directory.
-                 #$@(if localstatedir?
-                        '("./var/guix")
-                        '())
-
-                 (string-append "." (%store-directory))
-
-                 (delete-duplicates
-                  (filter-map (match-lambda
-                                (('directory directory)
-                                 (string-append "." directory))
-                                ((source '-> _)
-                                 (string-append "." source))
-                                (_ #f))
-                              directives)))))))
+          (apply invoke tar
+                 `(,@(tar-base-options
+                      #:tar tar
+                      #:compressor '#+(and=> compressor compressor-command))
+                   "-cvf" ,#$output
+                   ;; Avoid adding / and /var to the tarball, so
+                   ;; that the ownership and permissions of those
+                   ;; directories will not be overwritten when
+                   ;; extracting the archive.  Do not include /root
+                   ;; because the root account might have a
+                   ;; different home directory.
+                   ,#$@(if localstatedir?
+                           '("./var/guix")
+                           '())
+
+                   ,(string-append "." (%store-directory))
+
+                   ,@(delete-duplicates
+                      (filter-map (match-lambda
+                                    (('directory directory)
+                                     (string-append "." directory))
+                                    ((source '-> _)
+                                     (string-append "." source))
+                                    (_ #f))
+                                  directives))))))))
 
 (define* (self-contained-tarball name profile
                                  #:key target
-- 
2.32.0





  parent reply	other threads:[~2021-06-21  6:13 UTC|newest]

Thread overview: 52+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2021-06-21  6:10 [bug#49149] [PATCH 0/7] Add deb format for guix pack Maxim Cournoyer
2021-06-21  6:11 ` [bug#49149] [PATCH 1/7] pack: Extract builder code from self-contained-tarball Maxim Cournoyer
2021-06-21  6:11   ` [bug#49149] [PATCH] tentatively reuse rlib for cargo-build-system Maxim Cournoyer
2021-06-21 20:28     ` Maxim Cournoyer
2021-06-21  6:12   ` Maxim Cournoyer [this message]
2021-06-21  6:12   ` [bug#49149] [PATCH 3/7] pack: Fix typo Maxim Cournoyer
2021-06-21  6:12   ` [bug#49149] [PATCH 4/7] pack: Improve naming of the packs store file names Maxim Cournoyer
2021-06-21 18:11     ` Maxime Devos
2021-06-22 14:03       ` Maxim Cournoyer
2021-06-23 10:22         ` Maxime Devos
2021-06-24  4:40           ` [bug#49149] [PATCH v2 1/7] pack: Extract builder code from self-contained-tarball Maxim Cournoyer
2021-06-24  4:40             ` [bug#49149] [PATCH v2 2/7] pack: Factorize base tar options Maxim Cournoyer
2021-06-24  4:40             ` [bug#49149] [PATCH v2 3/7] pack: Fix typo Maxim Cournoyer
2021-06-24  4:40             ` [bug#49149] [PATCH v2 4/7] pack: Improve naming of the packs store file names Maxim Cournoyer
2021-06-26  5:03               ` [bug#49149] [PATCH 0/7] Add deb format for guix pack Maxim Cournoyer
2021-06-30 10:13               ` Ludovic Courtès
2021-06-30 18:36                 ` Maxim Cournoyer
2021-07-01 13:26                   ` Ludovic Courtès
2021-07-04  3:21                     ` Maxim Cournoyer
2021-07-05 16:14                       ` Ludovic Courtès
2021-07-05 20:42                         ` Maxim Cournoyer
2021-06-24  4:40             ` [bug#49149] [PATCH v2 5/7] pack: Prevent duplicate files in tar archives Maxim Cournoyer
2021-06-24  4:40             ` [bug#49149] [PATCH v2 6/7] tests: pack: Fix compressor extension Maxim Cournoyer
2021-06-24  4:40             ` [bug#49149] [PATCH v2 7/7] pack: Add support for the deb format Maxim Cournoyer
2021-06-26 16:58               ` Maxime Devos
2021-06-29 19:20                 ` bug#49149: [PATCH 0/7] Add deb format for guix pack Maxim Cournoyer
2021-06-30 10:10               ` [bug#49149] " Ludovic Courtès
2021-06-24  4:44           ` [bug#49149] [PATCH 4/7] pack: Improve naming of the packs store file names Maxim Cournoyer
2021-06-23 21:16       ` [bug#49149] [PATCH 0/7] Add deb format for guix pack Ludovic Courtès
2021-06-21  6:12   ` [bug#49149] [PATCH 5/7] pack: Prevent duplicate files in tar archives Maxim Cournoyer
2021-06-30 10:06     ` [bug#49149] [PATCH 0/7] Add deb format for guix pack Ludovic Courtès
2021-06-30 18:16       ` Maxim Cournoyer
2021-07-01 13:24         ` Ludovic Courtès
2021-06-21  6:12   ` [bug#49149] [PATCH 6/7] tests: pack: Fix compressor extension Maxim Cournoyer
2021-06-21  6:12   ` [bug#49149] [PATCH 7/7] pack: Add support for the deb format Maxim Cournoyer
2021-06-21 16:44 ` [bug#49149] Add deb format for guix pack jgart via Guix-patches via
2021-06-23 21:28 ` [bug#49149] [PATCH 0/7] " Ludovic Courtès
2021-06-29 17:49   ` Maxim Cournoyer
2021-06-30  9:15     ` Ludovic Courtès
2021-06-30 13:49       ` zimoun
2021-06-30 15:06         ` zimoun
2021-06-30 16:55           ` Maxim Cournoyer
2021-06-30 16:54         ` Maxim Cournoyer
2021-06-30 17:28         ` Maxim Cournoyer
2021-06-30 17:36           ` Maxim Cournoyer
2021-06-30 17:47           ` zimoun
2021-06-30 19:20             ` Maxim Cournoyer
2021-07-01 13:08               ` zimoun
2021-06-30 16:42       ` Maxim Cournoyer
2021-07-01 13:20         ` Ludovic Courtès
2021-07-01 13:52           ` zimoun
2021-07-05 16:17             ` Ludovic Courtès

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=20210621061205.31878-3-maxim.cournoyer@gmail.com \
    --to=maxim.cournoyer@gmail.com \
    --cc=49149@debbugs.gnu.org \
    /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).