pack: Factorize base tar options.

* 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

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

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

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
+           `(,@(tar-base-options #:compressor compressor)
-             ,@(if compressor
-                   (list "-I" (string-join compressor))
-                   '())
              "."))
     (delete-file-recursively directory)))

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.
+        (define tar #+(file-append archiver "/bin/tar"))
-        (setenv "PATH" #+(file-append archiver "/bin"))
 
         ;; 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
+        ;; Create the tarball.
-        ;; length limitation.
         (with-directory-excursion %root
-          (apply invoke "tar"
+          (apply invoke tar
-                 #+@(if (compressor-command compressor)
+                 `(,@(tar-base-options
-                        #~("-I"
+                      #:tar tar
-                           (string-join
+                      #:compressor '#+(and=> compressor compressor-command))
-                            '#+(compressor-command compressor)))
+                   "-cvf" ,#$output
-                        #~())
-                 "--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?
+                   ,#$@(if localstatedir?
                            '("./var/guix")
                            '())
 
-                 (string-append "." (%store-directory))
+                   ,(string-append "." (%store-directory))
 
-                 (delete-duplicates
+                   ,@(delete-duplicates
                       (filter-map (match-lambda
                                     (('directory directory)
                                      (string-append "." directory))
                                     ((source '-> _)
                                      (string-append "." source))
                                     (_ #f))
-                              directives)))))))
+                                  directives))))))))
 
 (define* (self-contained-tarball name profile
                                  #:key target