aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMaxim Cournoyer <maxim.cournoyer@gmail.com>2021-06-21 00:33:28 -0400
committerMaxim Cournoyer <maxim.cournoyer@gmail.com>2021-06-29 14:53:21 -0400
commit7708c0b5e3363e7551da6127268a08b0232061f9 (patch)
tree79a609a60d52917db5697a4b46fc1ed92956acbb
parent91e837283885ed735782709668c5ea7557e27dfe (diff)
downloadguix-7708c0b5e3363e7551da6127268a08b0232061f9.tar.gz
guix-7708c0b5e3363e7551da6127268a08b0232061f9.zip
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.
-rw-r--r--Makefile.am1
-rw-r--r--guix/build/pack.scm52
-rw-r--r--guix/docker.scm20
-rw-r--r--guix/scripts/pack.scm81
4 files changed, 87 insertions, 67 deletions
diff --git a/Makefile.am b/Makefile.am
index dd34447020..46414b011a 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