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

pack: Streamline how files are included in tarballs.

Browse source 
Thanks to Guillem Jover <guillem@debian.org> on the OFTC's #debian-dpkg
channel for helping with troubleshooting.

Letting GNU Tar recursively walk the complete files hierarchy side-steps the
risks associated with providing a list of file names:

1. Duplicated files in the archive (recorded as hard links by GNU Tar)
2. Missing parent directories.

The above would cause dpkg to malfunction, for example by aborting early and
skipping triggers when there were missing parent directories.

* guix/scripts/pack.scm (self-contained-tarball/builder): Do not call
POPULATE-SINGLE-PROFILE-DIRECTORY, which creates extraneous files such as
/root.  Instead, call POPULATE-STORE and INSTALL-DATABASE-AND-GC-ROOTS
individually to more precisely generate the file system.  Replace the list of
files by the current directory, "." and streamline the way options are passed.
* gnu/system/file-systems.scm (reduce-directories): Remove procedure.
* tests/file-systems.scm ("reduce-directories"): Remove test.
This commit is contained in:
Maxim Cournoyer 2021-07-06 12:27:36 -04:00
parent b019496fc3
commit 11f0698243
No known key found for this signature in database
GPG key ID: 1260E46482E63562
3 changed files with 17 additions and 61 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

22
gnu/system/file-systems.scm
View file

@ -55,7 +55,6 @@ (define-module (gnu system file-systems)
file-system-dependencies
file-system-location
reduce-directories
file-system-type-predicate
btrfs-subvolume?
btrfs-store-subvolume-file-name
@ -266,27 +265,6 @@ (define (absolute? file)
(define (file-name-depth file-name)
(length (string-tokenize file-name %not-slash)))
(define (reduce-directories file-names)
"Eliminate entries in FILE-NAMES that are children of other entries in
FILE-NAMES. This is for example useful when passing a list of files to GNU
tar, which would otherwise descend into each directory passed and archive the
duplicate files as hard links, which can be undesirable."
(let* ((file-names/sorted
;; Ascending sort by file hierarchy depth, then by file name length.
(stable-sort (delete-duplicates file-names)
(lambda (f1 f2)
(let ((depth1 (file-name-depth f1))
(depth2 (file-name-depth f2)))
(if (= depth1 depth2)
(string< f1 f2)
(< depth1 depth2)))))))
(reverse (fold (lambda (file-name results)
(if (find (cut file-prefix? <> file-name) results)
results ;parent found -- skipping
(cons file-name results)))
'()
file-names/sorted))))
(define* (file-system-device->string device #:key uuid-type)
"Return the string representations of the DEVICE field of a <file-system>
record. When the device is a UUID, its representation is chosen depending on

49
guix/scripts/pack.scm
View file

@ -231,17 +231,17 @@ (define (import-module? module)
(with-imported-modules (source-module-closure
`((guix build pack)
(guix build store-copy)
(guix build utils)
(guix build union)
(gnu build install)
(gnu system file-systems))
(gnu build install))
#:select? import-module?)
#~(begin
(use-modules (guix build pack)
(guix build store-copy)
(guix build utils)
((guix build union) #:select (relative-file-name))
(gnu build install)
((gnu system file-systems) #:select (reduce-directories))
(srfi srfi-1)
(srfi srfi-26)
(ice-9 match))
@ -279,11 +279,11 @@ (define tar #+(file-append archiver "/bin/tar"))
;; Furthermore GNU tar < 1.30 sometimes fails to extract tarballs
;; with hard links:
;; <http://lists.gnu.org/archive/html/bug-tar/2017-11/msg00009.html>.
(populate-single-profile-directory %root
#:profile #$profile
#:profile-name #$profile-name
#:closure "profile"
#:database #+database)
(populate-store (list "profile") %root #:deduplicate? #f)
(when #+localstatedir?
(install-database-and-gc-roots %root #+database #$profile
#:profile-name #$profile-name))
;; Create SYMLINKS.
(for-each (cut evaluate-populate-directive <> %root)
@ -291,31 +291,14 @@ (define tar #+(file-append archiver "/bin/tar"))
;; Create the tarball.
(with-directory-excursion %root
(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))
,@(reduce-directories
(filter-map (match-lambda
(('directory directory)
(string-append "." directory))
((source '-> _)
(string-append "." source))
(_ #f))
directives))))))))
;; GNU Tar recurses directories by default. Simply add the whole
;; current directory, which contains all the generated files so far.
;; This avoids creating duplicate files in the archives that would
;; be stored as hard links by GNU Tar.
(apply invoke tar "-cvf" #$output "."
(tar-base-options
#:tar tar
#:compressor '#+(and=> compressor compressor-command)))))))
(define* (self-contained-tarball name profile
#:key target

7
tests/file-systems.scm
View file

@ -1,6 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2020, 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;; Copyright © 2020 Maxim Cournoyer <maxim.cournoyer@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@ -50,11 +50,6 @@ (define-module (test-file-systems)
(device "/foo")
(flags '(bind-mount read-only)))))))))
(test-equal "reduce-directories"
'("./opt/gnu/" "./opt/gnuism" "a/b/c")
(reduce-directories '("./opt/gnu/etc" "./opt/gnu/" "./opt/gnu/bin"
"./opt/gnu/lib/debug" "./opt/gnuism" "a/b/c" "a/b/c")))
(test-assert "does not pull (guix config)"
;; This module is meant both for the host side and "build side", so make
;; sure it doesn't pull in (guix config), which depends on the user's