[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
02/08: pack: Import (guix store database) only when '--localstatedir' is
|
From: |
Ludovic Courtès |
|
Subject: |
02/08: pack: Import (guix store database) only when '--localstatedir' is passed. |
|
Date: |
Tue, 6 Nov 2018 17:21:32 -0500 (EST) |
civodul pushed a commit to branch master
in repository guix.
commit b27ef1d46cfdc3c994b106241f99cd7142083d13
Author: Ludovic Courtès <address@hidden>
Date: Sun Oct 28 00:17:08 2018 +0200
pack: Import (guix store database) only when '--localstatedir' is passed.
This is another way to address <https://bugs.gnu.org/32184>, which was
previously addressed in commit 19c924af4f3726688ca155a905ebf1cb9acdfca2.
* gnu/build/install.scm (register-closure): Move to...
* gnu/build/vm.scm (register-closure): ... here. New procedure.
* guix/scripts/pack.scm (self-contained-tarball)[build]: Remove
now unneeded 'with-extensions' form and custom (guix config) module.
* tests/guix-pack.sh: Revert the strategy from
commit 19c924af4f3726688ca155a905ebf1cb9acdfca2.
* tests/pack.scm ("self-contained-tarball"): Likewise.
---
gnu/build/install.scm | 18 -----
gnu/build/vm.scm | 19 ++++-
guix/scripts/pack.scm | 211 +++++++++++++++++++++++++-------------------------
tests/guix-pack.sh | 26 ++-----
tests/pack.scm | 64 +++++++--------
5 files changed, 159 insertions(+), 179 deletions(-)
diff --git a/gnu/build/install.scm b/gnu/build/install.scm
index 9f9a6ab..a31e194 100644
--- a/gnu/build/install.scm
+++ b/gnu/build/install.scm
@@ -18,7 +18,6 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu build install)
- #:use-module (guix store database)
#:use-module (guix build utils)
#:use-module (guix build store-copy)
#:use-module (srfi srfi-26)
@@ -141,23 +140,6 @@ includes /etc, /var, /run, /bin/sh, etc., and all the
symlinks to SYSTEM."
(try))
(apply throw args)))))))
-(define* (register-closure prefix closure
- #:key
- (deduplicate? #t) (reset-timestamps? #t)
- (schema (sql-schema)))
- "Register CLOSURE in PREFIX, where PREFIX is the directory name of the
-target store and CLOSURE is the name of a file containing a reference graph as
-produced by #:references-graphs.. As a side effect, if RESET-TIMESTAMPS? is
-true, reset timestamps on store files and, if DEDUPLICATE? is true,
-deduplicates files common to CLOSURE and the rest of PREFIX."
- (let ((items (call-with-input-file closure read-reference-graph)))
- (register-items items
- #:prefix prefix
- #:deduplicate? deduplicate?
- #:reset-timestamps? reset-timestamps?
- #:registration-time %epoch
- #:schema schema)))
-
(define* (populate-single-profile-directory directory
#:key profile closure
(profile-name "guix-profile")
diff --git a/gnu/build/vm.scm b/gnu/build/vm.scm
index 5579886..7468085 100644
--- a/gnu/build/vm.scm
+++ b/gnu/build/vm.scm
@@ -25,7 +25,7 @@
#:use-module (guix build utils)
#:use-module (guix build store-copy)
#:use-module (guix build syscalls)
- #:use-module ((guix store database) #:select (reset-timestamps))
+ #:use-module (guix store database)
#:use-module (gnu build linux-boot)
#:use-module (gnu build install)
#:use-module (gnu system uuid)
@@ -191,6 +191,23 @@ the #:references-graphs parameter of 'derivation'."
(mkdir output)
(copy-recursively "xchg" output)))))
+(define* (register-closure prefix closure
+ #:key
+ (deduplicate? #t) (reset-timestamps? #t)
+ (schema (sql-schema)))
+ "Register CLOSURE in PREFIX, where PREFIX is the directory name of the
+target store and CLOSURE is the name of a file containing a reference graph as
+produced by #:references-graphs.. As a side effect, if RESET-TIMESTAMPS? is
+true, reset timestamps on store files and, if DEDUPLICATE? is true,
+deduplicates files common to CLOSURE and the rest of PREFIX."
+ (let ((items (call-with-input-file closure read-reference-graph)))
+ (register-items items
+ #:prefix prefix
+ #:deduplicate? deduplicate?
+ #:reset-timestamps? reset-timestamps?
+ #:registration-time %epoch
+ #:schema schema)))
+
;;;
;;; Partitions.
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index faeea68..3e6430b 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -164,113 +164,110 @@ added to the pack."
"/db/db.sqlite")))
(define build
- (with-imported-modules `(((guix config) => ,(make-config.scm))
- ,@(source-module-closure
- `((guix build utils)
- (guix build union)
- (guix build store-copy)
- (gnu build install))
- #:select? not-config?))
- (with-extensions gcrypt-sqlite3&co
- #~(begin
- (use-modules (guix build utils)
- ((guix build union) #:select (relative-file-name))
- (gnu build install)
- (srfi srfi-1)
- (srfi srfi-26)
- (ice-9 match))
-
- (define %root "root")
-
- (define symlink->directives
- ;; Return "populate directives" to make the given symlink and its
- ;; parent directories.
- (match-lambda
- ((source '-> target)
- (let ((target (string-append #$profile "/" target))
- (parent (dirname source)))
- ;; Never add a 'directory' directive for "/" so as to
- ;; preserve its ownnership when extracting the archive (see
- ;; below), and also because this would lead to adding the
- ;; same entries twice in the tarball.
- `(,@(if (string=? parent "/")
- '()
- `((directory ,parent)))
- (,source
- -> ,(relative-file-name parent target)))))))
-
- (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")))
-
- ;; Add 'tar' to the search path.
- (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.
- ;; 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
- #:closure "profile"
- #:database #+database)
-
- ;; Create SYMLINKS.
- (for-each (cut evaluate-populate-directive <> %root)
- directives)
-
- ;; Create the tarball. Use GNU format so there's no file name
- ;; length limitation.
- (with-directory-excursion %root
- (exit
- (zero? (apply system* "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"
"address@hidden")
- "address@hidden" ;for files in /var/guix
- "--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))))))))))
+ (with-imported-modules (source-module-closure
+ `((guix build utils)
+ (guix build union)
+ (gnu build install))
+ #:select? not-config?)
+ #~(begin
+ (use-modules (guix build utils)
+ ((guix build union) #:select (relative-file-name))
+ (gnu build install)
+ (srfi srfi-1)
+ (srfi srfi-26)
+ (ice-9 match))
+
+ (define %root "root")
+
+ (define symlink->directives
+ ;; Return "populate directives" to make the given symlink and its
+ ;; parent directories.
+ (match-lambda
+ ((source '-> target)
+ (let ((target (string-append #$profile "/" target))
+ (parent (dirname source)))
+ ;; Never add a 'directory' directive for "/" so as to
+ ;; preserve its ownnership when extracting the archive (see
+ ;; below), and also because this would lead to adding the
+ ;; same entries twice in the tarball.
+ `(,@(if (string=? parent "/")
+ '()
+ `((directory ,parent)))
+ (,source
+ -> ,(relative-file-name parent target)))))))
+
+ (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")))
+
+ ;; Add 'tar' to the search path.
+ (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.
+ ;; 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
+ #:closure "profile"
+ #:database #+database)
+
+ ;; Create SYMLINKS.
+ (for-each (cut evaluate-populate-directive <> %root)
+ directives)
+
+ ;; Create the tarball. Use GNU format so there's no file name
+ ;; length limitation.
+ (with-directory-excursion %root
+ (exit
+ (zero? (apply system* "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"
"address@hidden")
+ "address@hidden" ;for files in /var/guix
+ "--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)))))))))
(gexp->derivation (string-append name ".tar"
(compressor-extension compressor))
diff --git a/tests/guix-pack.sh b/tests/guix-pack.sh
index cd721a6..8c1f556 100644
--- a/tests/guix-pack.sh
+++ b/tests/guix-pack.sh
@@ -29,33 +29,21 @@ fi
guix pack --version
-# Starting from commit 66e9944e078cbb9e0d618377dd6df6e639640efa, 'guix pack'
-# produces derivations that refer to guile-sqlite3 and libgcrypt. To make
-# that relatively inexpensive, run the test in the user's global store if
-# possible, on the grounds that binaries may already be there or can be built
-# or downloaded inexpensively.
-
-NIX_STORE_DIR="`guile -c '(use-modules (guix config))(display %storedir)'`"
-localstatedir="`guile -c '(use-modules (guix config))(display
%localstatedir)'`"
-GUIX_DAEMON_SOCKET="$localstatedir/guix/daemon-socket/socket"
-export NIX_STORE_DIR GUIX_DAEMON_SOCKET
-
-if ! guile -c '(use-modules (guix)) (exit (false-if-exception
(open-connection)))'
-then
- exit 77
-fi
+# Use --no-substitutes because we need to verify we can do this ourselves.
+GUIX_BUILD_OPTIONS="--no-substitutes"
+export GUIX_BUILD_OPTIONS
# Build a tarball with no compression.
-guix pack --compression=none guile-bootstrap
+guix pack --compression=none --bootstrap guile-bootstrap
# Build a tarball (with compression). Check that '-e' works as well.
-out1="`guix pack guile-bootstrap`"
-out2="`guix pack -e '(@ (gnu packages bootstrap) %bootstrap-guile)'`"
+out1="`guix pack --bootstrap guile-bootstrap`"
+out2="`guix pack --bootstrap -e '(@ (gnu packages bootstrap)
%bootstrap-guile)'`"
test -n "$out1"
test "$out1" = "$out2"
# Build a tarball with a symlink.
-the_pack="`guix pack -S /opt/gnu/bin=bin guile-bootstrap`"
+the_pack="`guix pack --bootstrap -S /opt/gnu/bin=bin guile-bootstrap`"
# Try to extract it. Note: we cannot test whether /opt/gnu/bin/guile itself
# exists because /opt/gnu/bin may be an absolute symlink to a store item that
diff --git a/tests/pack.scm b/tests/pack.scm
index 4eb5be9..6bd18bd 100644
--- a/tests/pack.scm
+++ b/tests/pack.scm
@@ -29,6 +29,9 @@
#:use-module (gnu packages bootstrap)
#:use-module (srfi srfi-64))
+(define %store
+ (open-connection-for-tests))
+
;; Globally disable grafts because they can trigger early builds.
(%graft? #f)
@@ -48,40 +51,33 @@
(test-begin "pack")
-;; The following test needs guile-sqlite3, libgcrypt, etc. as a consequence of
-;; commit c45477d2a1a651485feede20fe0f3d15aec48b39 and related changes. Thus,
-;; run it on the user's store, if it's available, on the grounds that these
-;; dependencies may be already there, or we can get substitutes or build them
-;; quite inexpensively; see <https://bugs.gnu.org/32184>.
-
-(with-external-store store
- (unless store (test-skip 1))
- (test-assertm "self-contained-tarball" store
- (mlet* %store-monad
- ((profile (profile-derivation (packages->manifest
- (list %bootstrap-guile))
- #:hooks '()
- #:locales? #f))
- (tarball (self-contained-tarball "pack" profile
- #:symlinks '(("/bin/Guile"
- -> "bin/guile"))
- #:compressor %gzip-compressor
- #:archiver %tar-bootstrap))
- (check (gexp->derivation
- "check-tarball"
- #~(let ((bin (string-append "." #$profile "/bin")))
- (setenv "PATH"
- (string-append #$%tar-bootstrap "/bin"))
- (system* "tar" "xvf" #$tarball)
- (mkdir #$output)
- (exit
- (and (file-exists? (string-append bin "/guile"))
- (string=? (string-append #$%bootstrap-guile
"/bin")
- (readlink bin))
- (string=? (string-append ".." #$profile
- "/bin/guile")
- (readlink "bin/Guile"))))))))
- (built-derivations (list check)))))
+(unless (network-reachable?) (test-skip 1))
+(test-assertm "self-contained-tarball" %store
+ (mlet* %store-monad
+ ((profile (profile-derivation (packages->manifest
+ (list %bootstrap-guile))
+ #:hooks '()
+ #:locales? #f))
+ (tarball (self-contained-tarball "pack" profile
+ #:symlinks '(("/bin/Guile"
+ -> "bin/guile"))
+ #:compressor %gzip-compressor
+ #:archiver %tar-bootstrap))
+ (check (gexp->derivation
+ "check-tarball"
+ #~(let ((bin (string-append "." #$profile "/bin")))
+ (setenv "PATH"
+ (string-append #$%tar-bootstrap "/bin"))
+ (system* "tar" "xvf" #$tarball)
+ (mkdir #$output)
+ (exit
+ (and (file-exists? (string-append bin "/guile"))
+ (string=? (string-append #$%bootstrap-guile "/bin")
+ (readlink bin))
+ (string=? (string-append ".." #$profile
+ "/bin/guile")
+ (readlink "bin/Guile"))))))))
+ (built-derivations (list check))))
(test-end)
- branch master updated (c6b05ba -> b07014f), Ludovic Courtès, 2018/11/06
- 03/08: install: Add 'install-database-and-gc-roots'., Ludovic Courtès, 2018/11/06
- 06/08: pack: Add test for 'self-contained-tarball' with localstatedir., Ludovic Courtès, 2018/11/06
- 04/08: pack: Docker backend now honors '--localstatedir'., Ludovic Courtès, 2018/11/06
- 05/08: pack: Squashfs backend now honors '--localstatedir'., Ludovic Courtès, 2018/11/06
- 01/08: pack: Move store database creation to a separate derivation., Ludovic Courtès, 2018/11/06
- 08/08: pack: Add test for '--relocatable'., Ludovic Courtès, 2018/11/06
- 07/08: store-copy: Canonicalize the mtime and permissions of the store copy., Ludovic Courtès, 2018/11/06
- 02/08: pack: Import (guix store database) only when '--localstatedir' is passed.,
Ludovic Courtès <=