* [bug#33259] [PATCH 2/8] pack: Import (guix store database) only when '--localstatedir' is passed.
2018-11-04 22:10 ` [bug#33259] [PATCH 1/8] pack: Move store database creation to a separate derivation Ludovic Courtès
@ 2018-11-04 22:10 ` Ludovic Courtès
2018-11-06 11:06 ` Danny Milosavljevic
2018-11-04 22:10 ` [bug#33259] [PATCH 3/8] install: Add 'install-database-and-gc-roots' Ludovic Courtès
` (6 subsequent siblings)
7 siblings, 1 reply; 21+ messages in thread
From: Ludovic Courtès @ 2018-11-04 22:10 UTC (permalink / raw)
To: 33259
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 | 187 +++++++++++++++++++++---------------------
tests/guix-pack.sh | 26 ++----
tests/pack.scm | 64 +++++++--------
5 files changed, 147 insertions(+), 167 deletions(-)
diff --git a/gnu/build/install.scm b/gnu/build/install.scm
index 9f9a6aba0f..a31e1945d6 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 5579886264..746808515f 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)))
+
\f
;;;
;;; Partitions.
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index faeea68426..3e6430bcce 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))
+ (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 %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 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))
+ (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")))
+ ;; 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"))
+ ;; 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)
+ ;; 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 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"
+ ;; 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" "--mtime=@1")
- "--mtime=@1" ;for files in /var/guix
- "--owner=root:0"
- "--group=root:0"
+ ;; 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")
+ "--mtime=@1" ;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")
- '())
+ "--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))
+ (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)))))))))
(gexp->derivation (string-append name ".tar"
(compressor-extension compressor))
diff --git a/tests/guix-pack.sh b/tests/guix-pack.sh
index cd721a60e9..8c1f556426 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 4eb5be92ff..6bd18bdee2 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 @@
\f
(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)
--
2.19.1
^ permalink raw reply related [flat|nested] 21+ messages in thread* [bug#33259] [PATCH 3/8] install: Add 'install-database-and-gc-roots'.
2018-11-04 22:10 ` [bug#33259] [PATCH 1/8] pack: Move store database creation to a separate derivation Ludovic Courtès
2018-11-04 22:10 ` [bug#33259] [PATCH 2/8] pack: Import (guix store database) only when '--localstatedir' is passed Ludovic Courtès
@ 2018-11-04 22:10 ` Ludovic Courtès
2018-11-06 11:05 ` Danny Milosavljevic
2018-11-04 22:10 ` [bug#33259] [PATCH 4/8] pack: Docker backend now honors '--localstatedir' Ludovic Courtès
` (5 subsequent siblings)
7 siblings, 1 reply; 21+ messages in thread
From: Ludovic Courtès @ 2018-11-04 22:10 UTC (permalink / raw)
To: 33259
* gnu/build/install.scm (%root-profile): New variable.
(install-database-and-gc-roots): New procedure.
(populate-single-profile-directory): Replace inline code with a call to
'install-database-and-gc-roots'.
---
gnu/build/install.scm | 48 ++++++++++++++++++++++++++++---------------
1 file changed, 32 insertions(+), 16 deletions(-)
diff --git a/gnu/build/install.scm b/gnu/build/install.scm
index a31e1945d6..c9ebe124fe 100644
--- a/gnu/build/install.scm
+++ b/gnu/build/install.scm
@@ -26,6 +26,7 @@
evaluate-populate-directive
populate-root-file-system
register-closure
+ install-database-and-gc-roots
populate-single-profile-directory))
;;; Commentary:
@@ -140,6 +141,35 @@ includes /etc, /var, /run, /bin/sh, etc., and all the symlinks to SYSTEM."
(try))
(apply throw args)))))))
+(define %root-profile
+ "/var/guix/profiles/per-user/root")
+
+(define* (install-database-and-gc-roots root database profile
+ #:key (profile-name "guix-profile"))
+ "Install DATABASE, the store database, under directory ROOT. Create
+PROFILE-NAME and have it link to PROFILE, a store item."
+ (define (scope file)
+ (string-append root "/" file))
+
+ (define (mkdir-p* dir)
+ (mkdir-p (scope dir)))
+
+ (define (symlink* old new)
+ (symlink old (scope new)))
+
+ (install-file database (scope "/var/guix/db/"))
+ (chmod (scope "/var/guix/db/db.sqlite") #o644)
+ (mkdir-p* "/var/guix/profiles")
+ (mkdir-p* "/var/guix/gcroots")
+ (symlink* "/var/guix/profiles" "/var/guix/gcroots/profiles")
+
+ ;; Make root's profile, which makes it a GC root.
+ (mkdir-p* %root-profile)
+ (symlink* profile
+ (string-append %root-profile "/" profile-name "-1-link"))
+ (symlink* (string-append profile-name "-1-link")
+ (string-append %root-profile "/" profile-name)))
+
(define* (populate-single-profile-directory directory
#:key profile closure
(profile-name "guix-profile")
@@ -158,9 +188,6 @@ This is used to create the self-contained tarballs with 'guix pack'."
(define (scope file)
(string-append directory "/" file))
- (define %root-profile
- "/var/guix/profiles/per-user/root")
-
(define (mkdir-p* dir)
(mkdir-p (scope dir)))
@@ -171,19 +198,8 @@ This is used to create the self-contained tarballs with 'guix pack'."
(populate-store (list closure) directory)
(when database
- (install-file database (scope "/var/guix/db/"))
- (chmod (scope "/var/guix/db/db.sqlite") #o644)
- (mkdir-p* "/var/guix/profiles")
- (mkdir-p* "/var/guix/gcroots")
- (symlink* "/var/guix/profiles"
- "/var/guix/gcroots/profiles"))
-
- ;; Make root's profile, which makes it a GC root.
- (mkdir-p* %root-profile)
- (symlink* profile
- (string-append %root-profile "/" profile-name "-1-link"))
- (symlink* (string-append profile-name "-1-link")
- (string-append %root-profile "/" profile-name))
+ (install-database-and-gc-roots directory database profile
+ #:profile-name profile-name))
(match profile-name
("guix-profile"
--
2.19.1
^ permalink raw reply related [flat|nested] 21+ messages in thread* [bug#33259] [PATCH 4/8] pack: Docker backend now honors '--localstatedir'.
2018-11-04 22:10 ` [bug#33259] [PATCH 1/8] pack: Move store database creation to a separate derivation Ludovic Courtès
2018-11-04 22:10 ` [bug#33259] [PATCH 2/8] pack: Import (guix store database) only when '--localstatedir' is passed Ludovic Courtès
2018-11-04 22:10 ` [bug#33259] [PATCH 3/8] install: Add 'install-database-and-gc-roots' Ludovic Courtès
@ 2018-11-04 22:10 ` Ludovic Courtès
2018-11-06 10:57 ` Danny Milosavljevic
2018-11-04 22:10 ` [bug#33259] [PATCH 5/8] pack: Squashfs " Ludovic Courtès
` (4 subsequent siblings)
7 siblings, 1 reply; 21+ messages in thread
From: Ludovic Courtès @ 2018-11-04 22:10 UTC (permalink / raw)
To: 33259
* guix/docker.scm (build-docker-image): Add #:database parameter.
Create /var/guix/db, /var/guix/profiles, etc. when DATABASE is true.
* guix/scripts/pack.scm (docker-image): Export. Remove #:deduplicate?
parameter. Define 'database' and pass it to 'docker-image'.
* tests/pack.scm (test-assertm): Recompile the derivation of
%BOOTSTRAP-GUILE.
("docker-image + localstatedir"): New test.
---
guix/docker.scm | 16 ++++++++++++-
guix/scripts/pack.scm | 9 +++++++-
tests/pack.scm | 53 +++++++++++++++++++++++++++++++++++++++++--
3 files changed, 74 insertions(+), 4 deletions(-)
diff --git a/guix/docker.scm b/guix/docker.scm
index 0757d3356f..c19a24d45c 100644
--- a/guix/docker.scm
+++ b/guix/docker.scm
@@ -26,6 +26,7 @@
delete-file-recursively
with-directory-excursion
invoke))
+ #:use-module (gnu build install)
#:use-module (json) ;guile-json
#:use-module (srfi srfi-19)
#:use-module (srfi srfi-26)
@@ -108,11 +109,15 @@ return \"a\"."
(symlinks '())
(transformations '())
(system (utsname:machine (uname)))
+ database
compressor
(creation-time (current-time time-utc)))
"Write to IMAGE a Docker image archive containing the given PATHS. PREFIX
must be a store path that is a prefix of any store paths in PATHS.
+When DATABASE is true, copy it to /var/guix/db in the image and create
+/var/guix/gcroots and friends.
+
SYMLINKS must be a list of (SOURCE -> TARGET) tuples describing symlinks to be
created in the image, where each TARGET is relative to PREFIX.
TRANSFORMATIONS must be a list of (OLD -> NEW) tuples describing how to
@@ -188,10 +193,15 @@ SRFI-19 time-utc object, as the creation time in metadata."
source))))
symlinks)
+ (when database
+ ;; Initialize /var/guix, assuming PREFIX points to a profile.
+ (install-database-and-gc-roots "." database prefix))
+
(apply invoke "tar" "-cf" "layer.tar"
`(,@transformation-options
,@%tar-determinism-options
,@paths
+ ,@(if database '("var") '())
,@(map symlink-source symlinks)))
;; It is possible for "/" to show up in the archive, especially when
;; applying transformations. For example, the transformation
@@ -203,7 +213,11 @@ SRFI-19 time-utc object, as the creation time in metadata."
(system* "tar" "--delete" "/" "-f" "layer.tar")
(for-each delete-file-recursively
(map (compose topmost-component symlink-source)
- symlinks)))
+ symlinks))
+
+ ;; Delete /var/guix.
+ (when database
+ (delete-file-recursively "var")))
(with-output-to-file "config.json"
(lambda ()
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index 3e6430bcce..09fc88988a 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -52,6 +52,8 @@
#:export (compressor?
lookup-compressor
self-contained-tarball
+ docker-image
+
guix-pack))
;; Type of a compression tool.
@@ -360,7 +362,6 @@ added to the pack."
(define* (docker-image name profile
#:key target
- deduplicate?
(compressor (first %compressors))
localstatedir?
(symlinks '())
@@ -370,6 +371,11 @@ image is a tarball conforming to the Docker Image Specification, compressed
with COMPRESSOR. It can be passed to 'docker load'. If TARGET is true, it
must a be a GNU triplet and it is used to derive the architecture metadata in
the image."
+ (define database
+ (and localstatedir?
+ (file-append (store-database (list profile))
+ "/db/db.sqlite")))
+
(define defmod 'define-module) ;trick Geiser
(define build
@@ -388,6 +394,7 @@ the image."
(call-with-input-file "profile"
read-reference-graph))
#$profile
+ #:database #+database
#:system (or #$target (utsname:machine (uname)))
#:symlinks '#$symlinks
#:compressor '#$(compressor-command compressor)
diff --git a/tests/pack.scm b/tests/pack.scm
index 6bd18bdee2..e8d4f9f18d 100644
--- a/tests/pack.scm
+++ b/tests/pack.scm
@@ -22,6 +22,7 @@
#:use-module (guix store)
#:use-module (guix derivations)
#:use-module (guix profiles)
+ #:use-module (guix packages) ;XXX: debugging
#:use-module (guix monads)
#:use-module (guix grafts)
#:use-module (guix tests)
@@ -37,8 +38,9 @@
(define-syntax-rule (test-assertm name store exp)
(test-assert name
- (run-with-store store exp
- #:guile-for-build (%guile-for-build))))
+ (let ((guile (package-derivation store %bootstrap-guile)))
+ (run-with-store store exp
+ #:guile-for-build guile))))
(define %gzip-compressor
;; Compressor that uses the bootstrap 'gzip'.
@@ -79,6 +81,53 @@
(readlink "bin/Guile"))))))))
(built-derivations (list check))))
+;; 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 "docker-image + localstatedir" store
+ (mlet* %store-monad
+ ((guile (set-guile-for-build (default-guile)))
+ (profile (profile-derivation (packages->manifest
+ (list %bootstrap-guile))
+ #:hooks '()
+ #:locales? #f))
+ (tarball (docker-image "docker-pack" profile
+ #:symlinks '(("/bin/Guile" -> "bin/guile"))
+ #:localstatedir? #t))
+ (check (gexp->derivation
+ "check-tarball"
+ (with-imported-modules '((guix build utils))
+ #~(begin
+ (use-modules (guix build utils)
+ (ice-9 match))
+
+ (define bin
+ (string-append "." #$profile "/bin"))
+
+ (setenv "PATH" (string-append #$%tar-bootstrap "/bin"))
+ (mkdir "base")
+ (with-directory-excursion "base"
+ (invoke "tar" "xvf" #$tarball))
+
+ (match (find-files "base" "layer.tar")
+ ((layer)
+ (invoke "tar" "xvf" layer)))
+
+ (when
+ (and (file-exists? (string-append bin "/guile"))
+ (file-exists? "var/guix/db/db.sqlite")
+ (string=? (string-append #$%bootstrap-guile "/bin")
+ (pk 'binlink (readlink bin)))
+ (string=? (string-append #$profile "/bin/guile")
+ (pk 'guilelink (readlink "bin/Guile"))))
+ (mkdir #$output)))))))
+ (built-derivations (list check)))))
+
(test-end)
;; Local Variables:
--
2.19.1
^ permalink raw reply related [flat|nested] 21+ messages in thread* [bug#33259] [PATCH 4/8] pack: Docker backend now honors '--localstatedir'.
2018-11-04 22:10 ` [bug#33259] [PATCH 4/8] pack: Docker backend now honors '--localstatedir' Ludovic Courtès
@ 2018-11-06 10:57 ` Danny Milosavljevic
2018-11-06 14:45 ` Ludovic Courtès
0 siblings, 1 reply; 21+ messages in thread
From: Danny Milosavljevic @ 2018-11-06 10:57 UTC (permalink / raw)
To: Ludovic Courtès; +Cc: 33259
[-- Attachment #1: Type: text/plain, Size: 377 bytes --]
> diff --git a/tests/pack.scm b/tests/pack.scm
> index 6bd18bdee2..e8d4f9f18d 100644
> --- a/tests/pack.scm
> +++ b/tests/pack.scm
> @@ -22,6 +22,7 @@
> #:use-module (guix store)
> #:use-module (guix derivations)
> #:use-module (guix profiles)
> + #:use-module (guix packages) ;XXX: debugging
Is this still needed?
Otherwise LGTM!
[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 488 bytes --]
^ permalink raw reply [flat|nested] 21+ messages in thread
* [bug#33259] [PATCH 4/8] pack: Docker backend now honors '--localstatedir'.
2018-11-06 10:57 ` Danny Milosavljevic
@ 2018-11-06 14:45 ` Ludovic Courtès
2018-11-06 22:23 ` bug#33259: " Ludovic Courtès
0 siblings, 1 reply; 21+ messages in thread
From: Ludovic Courtès @ 2018-11-06 14:45 UTC (permalink / raw)
To: Danny Milosavljevic; +Cc: 33259
Danny Milosavljevic <dannym@scratchpost.org> skribis:
>> diff --git a/tests/pack.scm b/tests/pack.scm
>> index 6bd18bdee2..e8d4f9f18d 100644
>> --- a/tests/pack.scm
>> +++ b/tests/pack.scm
>> @@ -22,6 +22,7 @@
>> #:use-module (guix store)
>> #:use-module (guix derivations)
>> #:use-module (guix profiles)
>
>> + #:use-module (guix packages) ;XXX: debugging
>
> Is this still needed?
Oops, I don’t think so. I’ll fix it before pushing.
Thanks for taking a look!
Ludo’.
^ permalink raw reply [flat|nested] 21+ messages in thread
* bug#33259: [PATCH 4/8] pack: Docker backend now honors '--localstatedir'.
2018-11-06 14:45 ` Ludovic Courtès
@ 2018-11-06 22:23 ` Ludovic Courtès
0 siblings, 0 replies; 21+ messages in thread
From: Ludovic Courtès @ 2018-11-06 22:23 UTC (permalink / raw)
To: Danny Milosavljevic; +Cc: 33259-done
ludo@gnu.org (Ludovic Courtès) skribis:
> Danny Milosavljevic <dannym@scratchpost.org> skribis:
>
>>> diff --git a/tests/pack.scm b/tests/pack.scm
>>> index 6bd18bdee2..e8d4f9f18d 100644
>>> --- a/tests/pack.scm
>>> +++ b/tests/pack.scm
>>> @@ -22,6 +22,7 @@
>>> #:use-module (guix store)
>>> #:use-module (guix derivations)
>>> #:use-module (guix profiles)
>>
>>> + #:use-module (guix packages) ;XXX: debugging
>>
>> Is this still needed?
>
> Oops, I don’t think so. I’ll fix it before pushing.
Well it was actually needed so I just removed the comment.
Pushed, thanks for reviewing!
Ludo’.
^ permalink raw reply [flat|nested] 21+ messages in thread
* [bug#33259] [PATCH 5/8] pack: Squashfs backend now honors '--localstatedir'.
2018-11-04 22:10 ` [bug#33259] [PATCH 1/8] pack: Move store database creation to a separate derivation Ludovic Courtès
` (2 preceding siblings ...)
2018-11-04 22:10 ` [bug#33259] [PATCH 4/8] pack: Docker backend now honors '--localstatedir' Ludovic Courtès
@ 2018-11-04 22:10 ` Ludovic Courtès
2018-11-06 11:00 ` Danny Milosavljevic
2018-11-04 22:10 ` [bug#33259] [PATCH 6/8] pack: Add test for 'self-contained-tarball' with localstatedir Ludovic Courtès
` (3 subsequent siblings)
7 siblings, 1 reply; 21+ messages in thread
From: Ludovic Courtès @ 2018-11-04 22:10 UTC (permalink / raw)
To: 33259
* guix/scripts/pack.scm (squashfs-image)[database]: New variable.
[build]: Add (gnu build install) to the closure. Call
'install-database-and-gc-roots' when DATABASE is true, and invoke
mksquashfs once more.
* tests/pack.scm ("squashfs-image + localstatedir"): New test.
---
guix/scripts/pack.scm | 19 +++++++++++++++++--
tests/pack.scm | 36 ++++++++++++++++++++++++++++++++++++
2 files changed, 53 insertions(+), 2 deletions(-)
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index 09fc88988a..a86b95dd38 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -53,6 +53,7 @@
lookup-compressor
self-contained-tarball
docker-image
+ squashfs-image
guix-pack))
@@ -288,18 +289,27 @@ points for virtual file systems (like procfs), and optional symlinks.
SYMLINKS must be a list of (SOURCE -> TARGET) tuples denoting symlinks to be
added to the pack."
+ (define database
+ (and localstatedir?
+ (file-append (store-database (list profile))
+ "/db/db.sqlite")))
+
(define build
(with-imported-modules (source-module-closure
'((guix build utils)
- (guix build store-copy))
+ (guix build store-copy)
+ (gnu build install))
#:select? not-config?)
#~(begin
(use-modules (guix build utils)
(guix build store-copy)
+ (gnu build install)
(srfi srfi-1)
(srfi srfi-26)
(ice-9 match))
+ (define database #+database)
+
(setenv "PATH" (string-append #$archiver "/bin"))
;; We need an empty file in order to have a valid file argument when
@@ -352,7 +362,12 @@ added to the pack."
;; Create empty mount points.
"-p" "/proc d 555 0 0"
"-p" "/sys d 555 0 0"
- "-p" "/dev d 555 0 0")))))
+ "-p" "/dev d 555 0 0"))
+
+ (when database
+ ;; Initialize /var/guix.
+ (install-database-and-gc-roots "var-etc" database #$profile)
+ (invoke "mksquashfs" "var-etc" #$output)))))
(gexp->derivation (string-append name
(compressor-extension compressor)
diff --git a/tests/pack.scm b/tests/pack.scm
index e8d4f9f18d..63fef70c64 100644
--- a/tests/pack.scm
+++ b/tests/pack.scm
@@ -28,6 +28,7 @@
#:use-module (guix tests)
#:use-module (guix gexp)
#:use-module (gnu packages bootstrap)
+ #:use-module ((gnu packages compression) #:select (squashfs-tools-next))
#:use-module (srfi srfi-64))
(define %store
@@ -126,6 +127,41 @@
(string=? (string-append #$profile "/bin/guile")
(pk 'guilelink (readlink "bin/Guile"))))
(mkdir #$output)))))))
+ (built-derivations (list check))))
+
+ (unless store (test-skip 1))
+ (test-assertm "squashfs-image + localstatedir" store
+ (mlet* %store-monad
+ ((guile (set-guile-for-build (default-guile)))
+ (profile (profile-derivation (packages->manifest
+ (list %bootstrap-guile))
+ #:hooks '()
+ #:locales? #f))
+ (image (squashfs-image "squashfs-pack" profile
+ #:symlinks '(("/bin" -> "bin"))
+ #:localstatedir? #t))
+ (check (gexp->derivation
+ "check-tarball"
+ (with-imported-modules '((guix build utils))
+ #~(begin
+ (use-modules (guix build utils)
+ (ice-9 match))
+
+ (define bin
+ (string-append "." #$profile "/bin"))
+
+ (setenv "PATH"
+ (string-append #$squashfs-tools-next "/bin"))
+ (invoke "unsquashfs" #$image)
+ (with-directory-excursion "squashfs-root"
+ (when (and (file-exists? (string-append bin
+ "/guile"))
+ (file-exists? "var/guix/db/db.sqlite")
+ (string=? (string-append #$%bootstrap-guile "/bin")
+ (pk 'binlink (readlink bin)))
+ (string=? (string-append #$profile "/bin")
+ (pk 'guilelink (readlink "bin"))))
+ (mkdir #$output))))))))
(built-derivations (list check)))))
(test-end)
--
2.19.1
^ permalink raw reply related [flat|nested] 21+ messages in thread* [bug#33259] [PATCH 6/8] pack: Add test for 'self-contained-tarball' with localstatedir.
2018-11-04 22:10 ` [bug#33259] [PATCH 1/8] pack: Move store database creation to a separate derivation Ludovic Courtès
` (3 preceding siblings ...)
2018-11-04 22:10 ` [bug#33259] [PATCH 5/8] pack: Squashfs " Ludovic Courtès
@ 2018-11-04 22:10 ` Ludovic Courtès
2018-11-06 11:01 ` Danny Milosavljevic
2018-11-04 22:10 ` [bug#33259] [PATCH 7/8] store-copy: Canonicalize the mtime and permissions of the store copy Ludovic Courtès
` (2 subsequent siblings)
7 siblings, 1 reply; 21+ messages in thread
From: Ludovic Courtès @ 2018-11-04 22:10 UTC (permalink / raw)
To: 33259
* tests/pack.scm ("self-contained-tarball + localstatedir"): New test.
---
tests/pack.scm | 23 +++++++++++++++++++++++
1 file changed, 23 insertions(+)
diff --git a/tests/pack.scm b/tests/pack.scm
index 63fef70c64..22321a3e46 100644
--- a/tests/pack.scm
+++ b/tests/pack.scm
@@ -89,6 +89,29 @@
;; quite inexpensively; see <https://bugs.gnu.org/32184>.
(with-external-store store
+ (unless store (test-skip 1))
+ (test-assertm "self-contained-tarball + localstatedir" store
+ (mlet* %store-monad
+ ((guile (set-guile-for-build (default-guile)))
+ (profile (profile-derivation (packages->manifest
+ (list %bootstrap-guile))
+ #:hooks '()
+ #:locales? #f))
+ (tarball (self-contained-tarball "tar-pack" profile
+ #:localstatedir? #t))
+ (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? "var/guix/db/db.sqlite")
+ (string=? (string-append #$%bootstrap-guile "/bin")
+ (readlink bin))))))))
+ (built-derivations (list check))))
+
(unless store (test-skip 1))
(test-assertm "docker-image + localstatedir" store
(mlet* %store-monad
--
2.19.1
^ permalink raw reply related [flat|nested] 21+ messages in thread* [bug#33259] [PATCH 7/8] store-copy: Canonicalize the mtime and permissions of the store copy.
2018-11-04 22:10 ` [bug#33259] [PATCH 1/8] pack: Move store database creation to a separate derivation Ludovic Courtès
` (4 preceding siblings ...)
2018-11-04 22:10 ` [bug#33259] [PATCH 6/8] pack: Add test for 'self-contained-tarball' with localstatedir Ludovic Courtès
@ 2018-11-04 22:10 ` Ludovic Courtès
2018-11-06 11:02 ` Danny Milosavljevic
2018-11-04 22:10 ` [bug#33259] [PATCH 8/8] pack: Add test for '--relocatable' Ludovic Courtès
2018-11-06 10:48 ` [bug#33259] [PATCH 1/8] pack: Move store database creation to a separate derivation Danny Milosavljevic
7 siblings, 1 reply; 21+ messages in thread
From: Ludovic Courtès @ 2018-11-04 22:10 UTC (permalink / raw)
To: 33259
Fixes a bug whereby directories in the output of 'guix pack -f tarball'
would not be read-only.
* guix/build/store-copy.scm (reset-permissions): New procedure.
(populate-store): Pass #:keep-mtime? #t to 'copy-recursively'. Call
'reset-permissions'.
* tests/pack.scm ("self-contained-tarball"): In CHECK, define
'canonical?' and use it to check that every file has an mtime of 1 and
is read-only.
* tests/guix-pack.sh: Invoke "chmod -Rf +w" before "rm -rf" in trap.
---
guix/build/store-copy.scm | 28 +++++++++++++++++++++++
tests/guix-pack.sh | 2 +-
tests/pack.scm | 48 +++++++++++++++++++++++++++++----------
3 files changed, 65 insertions(+), 13 deletions(-)
diff --git a/guix/build/store-copy.scm b/guix/build/store-copy.scm
index 64ade7885c..549aa4f28b 100644
--- a/guix/build/store-copy.scm
+++ b/guix/build/store-copy.scm
@@ -168,6 +168,28 @@ REFERENCE-GRAPHS, a list of reference-graph files."
(reduce + 0 (map file-size items)))
+(define (reset-permissions file)
+ "Reset the permissions on FILE and its sub-directories so that they are all
+read-only."
+ ;; XXX: This procedure exists just to work around the inability of
+ ;; 'copy-recursively' to preserve permissions.
+ (file-system-fold (const #t) ;enter?
+ (lambda (file stat _) ;leaf
+ (unless (eq? 'symlink (stat:type stat))
+ (chmod file
+ (if (zero? (logand (stat:mode stat)
+ #o100))
+ #o444
+ #o555))))
+ (const #t) ;down
+ (lambda (directory stat _) ;up
+ (chmod directory #o555))
+ (const #f) ;skip
+ (const #f) ;error
+ #t
+ file
+ lstat))
+
(define* (populate-store reference-graphs target
#:key (log-port (current-error-port)))
"Populate the store under directory TARGET with the items specified in
@@ -197,7 +219,13 @@ REFERENCE-GRAPHS, a list of reference-graph files."
(for-each (lambda (thing)
(copy-recursively thing
(string-append target thing)
+ #:keep-mtime? #t
#:log (%make-void-port "w"))
+
+ ;; XXX: Since 'copy-recursively' doesn't allow us to
+ ;; preserve permissions, we have to traverse TARGET to
+ ;; make sure everything is read-only.
+ (reset-permissions (string-append target thing))
(report))
things)))))
diff --git a/tests/guix-pack.sh b/tests/guix-pack.sh
index 8c1f556426..a43f4d128f 100644
--- a/tests/guix-pack.sh
+++ b/tests/guix-pack.sh
@@ -49,7 +49,7 @@ the_pack="`guix pack --bootstrap -S /opt/gnu/bin=bin guile-bootstrap`"
# exists because /opt/gnu/bin may be an absolute symlink to a store item that
# has been GC'd.
test_directory="`mktemp -d`"
-trap 'rm -rf "$test_directory"' EXIT
+trap 'chmod -Rf +w "$test_directory"; rm -rf "$test_directory"' EXIT
cd "$test_directory"
tar -xf "$the_pack"
test -L opt/gnu/bin
diff --git a/tests/pack.scm b/tests/pack.scm
index 22321a3e46..70e3e812be 100644
--- a/tests/pack.scm
+++ b/tests/pack.scm
@@ -68,18 +68,42 @@
#: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"))))))))
+ (with-imported-modules '((guix build utils))
+ #~(begin
+ (use-modules (guix build utils)
+ (srfi srfi-1))
+
+ (define store
+ ;; The unpacked store.
+ (string-append "." (%store-directory) "/"))
+
+ (define (canonical? file)
+ ;; Return #t if FILE is read-only and its mtime is 1.
+ (let ((st (lstat file)))
+ (or (not (string-prefix? store file))
+ (eq? 'symlink (stat:type st))
+ (and (= 1 (stat:mtime st))
+ (zero? (logand #o222
+ (stat:mode st)))))))
+
+ (define 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"))
+ (file-exists? store)
+ (every canonical?
+ (find-files "." (const #t)
+ #:directories? #t))
+ (string=? (string-append #$%bootstrap-guile "/bin")
+ (readlink bin))
+ (string=? (string-append ".." #$profile
+ "/bin/guile")
+ (readlink "bin/Guile")))))))))
(built-derivations (list check))))
;; The following test needs guile-sqlite3, libgcrypt, etc. as a consequence of
--
2.19.1
^ permalink raw reply related [flat|nested] 21+ messages in thread* [bug#33259] [PATCH 8/8] pack: Add test for '--relocatable'.
2018-11-04 22:10 ` [bug#33259] [PATCH 1/8] pack: Move store database creation to a separate derivation Ludovic Courtès
` (5 preceding siblings ...)
2018-11-04 22:10 ` [bug#33259] [PATCH 7/8] store-copy: Canonicalize the mtime and permissions of the store copy Ludovic Courtès
@ 2018-11-04 22:10 ` Ludovic Courtès
2018-11-06 11:03 ` Danny Milosavljevic
2018-11-06 10:48 ` [bug#33259] [PATCH 1/8] pack: Move store database creation to a separate derivation Danny Milosavljevic
7 siblings, 1 reply; 21+ messages in thread
From: Ludovic Courtès @ 2018-11-04 22:10 UTC (permalink / raw)
To: 33259
* tests/guix-pack-relocatable.sh: New file.
* Makefile.am (SH_TESTS): Add it.
---
Makefile.am | 1 +
tests/guix-pack-relocatable.sh | 61 ++++++++++++++++++++++++++++++++++
2 files changed, 62 insertions(+)
create mode 100644 tests/guix-pack-relocatable.sh
diff --git a/Makefile.am b/Makefile.am
index 8c3df8f396..a660de845e 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -406,6 +406,7 @@ SH_TESTS = \
tests/guix-gc.sh \
tests/guix-hash.sh \
tests/guix-pack.sh \
+ tests/guix-pack-relocatable.sh \
tests/guix-package.sh \
tests/guix-package-net.sh \
tests/guix-system.sh \
diff --git a/tests/guix-pack-relocatable.sh b/tests/guix-pack-relocatable.sh
new file mode 100644
index 0000000000..554416627b
--- /dev/null
+++ b/tests/guix-pack-relocatable.sh
@@ -0,0 +1,61 @@
+# GNU Guix --- Functional package management for GNU
+# Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
+#
+# 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/>.
+
+#
+# Test the 'guix pack --relocatable' using the external store, if any.
+#
+
+guix pack --version
+
+# 'guix pack --relocatable' requires a C compiler and libc.a, which our
+# bootstrap binaries don't provide. To make the test relatively inexpensive,
+# run it on 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
+
+STORE_PARENT="`dirname $NIX_STORE_DIR`"
+export STORE_PARENT
+if test "$STORE_PARENT" = "/"; then exit 77; fi
+
+# This test requires user namespaces and associated command-line tools.
+if ! unshare -mrf sh -c 'mount -t tmpfs none "$STORE_PARENT"'
+then
+ exit 77
+fi
+
+test_directory="`mktemp -d`"
+export test_directory
+trap 'chmod -Rf +w "$test_directory"; rm -rf "$test_directory"' EXIT
+
+tarball="`guix pack -R -S /Bin=bin sed`"
+(cd "$test_directory"; tar xvf "$tarball")
+
+# Run that relocatable 'sed' in a user namespace where we "erase" the store by
+# mounting an empty file system on top of it. That way, we exercise the
+# wrapper code that creates the user namespace and bind-mounts the store.
+unshare -mrf sh -c 'mount -t tmpfs none "$STORE_PARENT"; echo "$STORE_PARENT"/*; "$test_directory/Bin/sed" --version > "$test_directory/output"'
+grep 'GNU sed' "$test_directory/output"
--
2.19.1
^ permalink raw reply related [flat|nested] 21+ messages in thread* [bug#33259] [PATCH 1/8] pack: Move store database creation to a separate derivation.
2018-11-04 22:10 ` [bug#33259] [PATCH 1/8] pack: Move store database creation to a separate derivation Ludovic Courtès
` (6 preceding siblings ...)
2018-11-04 22:10 ` [bug#33259] [PATCH 8/8] pack: Add test for '--relocatable' Ludovic Courtès
@ 2018-11-06 10:48 ` Danny Milosavljevic
2018-11-06 14:43 ` Ludovic Courtès
7 siblings, 1 reply; 21+ messages in thread
From: Danny Milosavljevic @ 2018-11-06 10:48 UTC (permalink / raw)
To: Ludovic Courtès; +Cc: 33259
[-- Attachment #1: Type: text/plain, Size: 622 bytes --]
Hi Ludo,
On Sun, 4 Nov 2018 23:10:29 +0100
Ludovic Courtès <ludo@gnu.org> wrote:
> + (when database
> + (install-file database (scope "/var/guix/db/"))
> + (chmod (scope "/var/guix/db/db.sqlite") #o644)
Hmm, is it guaranteed that the basename of DATABASE is "db.sqlite" ?
Sounds a little magical.
> + (define database
> (and localstatedir?
> - (local-file (search-path %load-path
> - "guix/store/schema.sql"))))
> + (file-append (store-database (list profile))
> + "/db/db.sqlite")))
Ah okay.
Otherwise LGTM!
[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 488 bytes --]
^ permalink raw reply [flat|nested] 21+ messages in thread* [bug#33259] [PATCH 1/8] pack: Move store database creation to a separate derivation.
2018-11-06 10:48 ` [bug#33259] [PATCH 1/8] pack: Move store database creation to a separate derivation Danny Milosavljevic
@ 2018-11-06 14:43 ` Ludovic Courtès
0 siblings, 0 replies; 21+ messages in thread
From: Ludovic Courtès @ 2018-11-06 14:43 UTC (permalink / raw)
To: Danny Milosavljevic; +Cc: 33259
Hi,
Danny Milosavljevic <dannym@scratchpost.org> skribis:
> On Sun, 4 Nov 2018 23:10:29 +0100
> Ludovic Courtès <ludo@gnu.org> wrote:
>
>> + (when database
>> + (install-file database (scope "/var/guix/db/"))
>> + (chmod (scope "/var/guix/db/db.sqlite") #o644)
>
> Hmm, is it guaranteed that the basename of DATABASE is "db.sqlite" ?
> Sounds a little magical.
Yeah I understand your reluctance, but it’s actually guaranteed; if it
ever changes, this code will error out so hopefully we’ll catch it
with the tests.
Ludo’.
^ permalink raw reply [flat|nested] 21+ messages in thread