ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-07 07:26:13 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

pack: Factorize base tar options.

Browse source 
* 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.
This commit is contained in:
Maxim Cournoyer 2021-06-21 00:33:28 -04:00
parent 91e8372838
commit 7708c0b5e3
No known key found for this signature in database
GPG key ID: 1260E46482E63562
4 changed files with 85 additions and 65 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
Makefile.am
View file

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

52
guix/build/pack.scm Normal file
View file

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

20
guix/docker.scm
View file

@ -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 @@ (define* (config layer time arch #:key entry-point (environment '()))
(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 @@ (define transformation-options
(apply invoke "tar" "-cf" "../layer.tar"
`(,@transformation-options
,@%tar-determinism-options
,@(tar-base-options)
,@paths
,@(scandir "."
(lambda (file)
@ -273,9 +262,6 @@ (define transformation-options
(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)))

77
guix/scripts/pack.scm
View file

@ -205,12 +205,14 @@ (define (import-module? module)
(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 @@ (define directives
;; 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 @@ (define tar-supports-sort?
(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")
'())
(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))
,(string-append "." (%store-directory))
(delete-duplicates
(filter-map (match-lambda
(('directory directory)
(string-append "." directory))
((source '-> _)
(string-append "." source))
(_ #f))
directives)))))))
,@(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