Package: guix-patches;
Reported by: Ludovic Courtès <ludo <at> gnu.org>
Date: Sun, 4 Nov 2018 22:03:02 UTC
Severity: normal
Tags: patch
Done: ludo <at> gnu.org (Ludovic Courtès)
Bug is archived. No further changes may be made.
To add a comment to this bug, you must first unarchive it, by sending
a message to control AT debbugs.gnu.org, with unarchive 33259 in the body.
You can then email your comments to 33259 AT debbugs.gnu.org in the normal way.
Toggle the display of automated, internal messages from the tracker.
View this report as an mbox folder, status mbox, maintainer mbox
guix-patches <at> gnu.org:bug#33259; Package guix-patches.
(Sun, 04 Nov 2018 22:03:02 GMT) Full text and rfc822 format available.Ludovic Courtès <ludo <at> gnu.org>:guix-patches <at> gnu.org.
(Sun, 04 Nov 2018 22:03:02 GMT) Full text and rfc822 format available.Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: guix-patches <at> gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: [PATCH 0/8] 'guix pack': Better '--localstatedir' handling and more tests Date: Sun, 4 Nov 2018 23:01:30 +0100
Hello Guix!
These patches ensure ‘--localstatedir’ is properly handled by the
Docker and Squashfs backends of ‘guix pack’ (until now they ignored
this option.)
They also add ‘guix pack’ tests, which were severely lacking until now,
including a ‘guix pack -R’ test using the user’s store. While doing
that, I also fixed a bug whereby ‘guix pack’ tarballs would contain
writable directories (whereas normally every file in the store is
read-only.)
Feedback welcome!
Ludo’.
Ludovic Courtès (8):
pack: Move store database creation to a separate derivation.
pack: Import (guix store database) only when '--localstatedir' is
passed.
install: Add 'install-database-and-gc-roots'.
pack: Docker backend now honors '--localstatedir'.
pack: Squashfs backend now honors '--localstatedir'.
pack: Add test for 'self-contained-tarball' with localstatedir.
store-copy: Canonicalize the mtime and permissions of the store copy.
pack: Add test for '--relocatable'.
Makefile.am | 1 +
gnu/build/install.scm | 77 ++++---
gnu/build/vm.scm | 19 +-
guix/build/store-copy.scm | 28 +++
guix/docker.scm | 16 +-
guix/scripts/pack.scm | 379 +++++++++++++++++++--------------
tests/guix-pack-relocatable.sh | 61 ++++++
tests/guix-pack.sh | 28 +--
tests/pack.scm | 156 ++++++++++++--
9 files changed, 525 insertions(+), 240 deletions(-)
create mode 100644 tests/guix-pack-relocatable.sh
--
2.19.1
guix-patches <at> gnu.org:bug#33259; Package guix-patches.
(Sun, 04 Nov 2018 22:12:01 GMT) Full text and rfc822 format available.Message #8 received at 33259 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: 33259 <at> debbugs.gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: [PATCH 3/8] install: Add 'install-database-and-gc-roots'. Date: Sun, 4 Nov 2018 23:10:31 +0100
* 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
guix-patches <at> gnu.org:bug#33259; Package guix-patches.
(Sun, 04 Nov 2018 22:12:02 GMT) Full text and rfc822 format available.Message #11 received at 33259 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: 33259 <at> debbugs.gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: [PATCH 1/8] pack: Move store database creation to a separate derivation. Date: Sun, 4 Nov 2018 23:10:29 +0100
* guix/scripts/pack.scm (store-database): New procedure.
(self-contained-tarball): Use it when LOCALSTATEDIR? is true.
Remove 'schema' and add 'database'.
[build]: Pass DATABASE to 'populate-single-profile-directory'.
(squashfs-image): Remove #:deduplicate? parameter.
[build]: Remove (gnu build install) and (guix config) from the imported
modules. Remove 'with-extensions'.
* gnu/build/install.scm (populate-single-profile-directory): Remove
#:deduplicate?, #:register?, and #:schema; add #:database. Remove call
to 'register-closure' and simply copy DATABASE instead.
---
gnu/build/install.scm | 17 ++---
guix/scripts/pack.scm | 170 +++++++++++++++++++++++++-----------------
2 files changed, 109 insertions(+), 78 deletions(-)
diff --git a/gnu/build/install.scm b/gnu/build/install.scm
index 98c547f2e4..9f9a6aba0f 100644
--- a/gnu/build/install.scm
+++ b/gnu/build/install.scm
@@ -161,14 +161,13 @@ deduplicates files common to CLOSURE and the rest of PREFIX."
(define* (populate-single-profile-directory directory
#:key profile closure
(profile-name "guix-profile")
- deduplicate?
- register? schema)
+ database)
"Populate DIRECTORY with a store containing PROFILE, whose closure is given
in the file called CLOSURE (as generated by #:references-graphs.) DIRECTORY
is initialized to contain a single profile under /root pointing to PROFILE.
-When REGISTER? is true, initialize DIRECTORY/var/guix/db to reflect the
-contents of the store; DEDUPLICATE? determines whether to deduplicate files in
-the store.
+
+When DATABASE is true, copy it to DIRECTORY/var/guix/db and create
+DIRECTORY/var/guix/gcroots and friends.
PROFILE-NAME is the name of the profile being created under
/var/guix/profiles, typically either \"guix-profile\" or \"current-guix\".
@@ -189,11 +188,9 @@ This is used to create the self-contained tarballs with 'guix pack'."
;; Populate the store.
(populate-store (list closure) directory)
- (when register?
- (register-closure (canonicalize-path directory) closure
- #:deduplicate? deduplicate?
- #:schema schema)
-
+ (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"
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index 83bfa4ce00..faeea68426 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -103,6 +103,47 @@ found."
(package-transitive-propagated-inputs package)))
(list guile-gcrypt guile-sqlite3)))
+(define (store-database items)
+ "Return a directory containing a store database where all of ITEMS and their
+dependencies are registered."
+ (define schema
+ (local-file (search-path %load-path
+ "guix/store/schema.sql")))
+
+
+ (define labels
+ (map (lambda (n)
+ (string-append "closure" (number->string n)))
+ (iota (length items))))
+
+ (define build
+ (with-extensions gcrypt-sqlite3&co
+ ;; XXX: Adding (gnu build install) just to work around
+ ;; <https://bugs.gnu.org/15602>: that way, (guix build store-copy) is
+ ;; copied last and the 'store-info-XXX' macros are correctly expanded.
+ (with-imported-modules (source-module-closure
+ '((guix build store-copy)
+ (guix store database)
+ (gnu build install)))
+ #~(begin
+ (use-modules (guix store database)
+ (guix build store-copy)
+ (srfi srfi-1))
+
+ (define (read-closure closure)
+ (call-with-input-file closure read-reference-graph))
+
+ (let ((items (append-map read-closure '#$labels)))
+ (register-items items
+ #:state-directory #$output
+ #:deduplicate? #f
+ #:reset-timestamps? #f
+ #:registration-time %epoch
+ #:schema #$schema))))))
+
+ (computed-file "store-database" build
+ #:options `(#:references-graphs ,(zip labels items))))
+
(define* (self-contained-tarball name profile
#:key target
deduplicate?
@@ -117,10 +158,10 @@ with a properly initialized store database.
SYMLINKS must be a list of (SOURCE -> TARGET) tuples denoting symlinks to be
added to the pack."
- (define schema
+ (define database
(and localstatedir?
- (local-file (search-path %load-path
- "guix/store/schema.sql"))))
+ (file-append (store-database (list profile))
+ "/db/db.sqlite")))
(define build
(with-imported-modules `(((guix config) => ,(make-config.scm))
@@ -181,9 +222,7 @@ added to the pack."
(populate-single-profile-directory %root
#:profile #$profile
#:closure "profile"
- #:deduplicate? #f
- #:register? #$localstatedir?
- #:schema #$schema)
+ #:database #+database)
;; Create SYMLINKS.
(for-each (cut evaluate-populate-directive <> %root)
@@ -240,7 +279,6 @@ added to the pack."
(define* (squashfs-image name profile
#:key target
- deduplicate?
(compressor (first %compressors))
localstatedir?
(symlinks '())
@@ -252,74 +290,70 @@ 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 build
- (with-imported-modules `(((guix config) => ,(make-config.scm))
- ,@(source-module-closure
- '((guix build utils)
- (guix build store-copy)
- (gnu build install))
- #:select? not-config?))
- (with-extensions gcrypt-sqlite3&co
- #~(begin
- (use-modules (guix build utils)
- (gnu build install)
- (guix build store-copy)
- (srfi srfi-1)
- (srfi srfi-26)
- (ice-9 match))
+ (with-imported-modules (source-module-closure
+ '((guix build utils)
+ (guix build store-copy))
+ #:select? not-config?)
+ #~(begin
+ (use-modules (guix build utils)
+ (guix build store-copy)
+ (srfi srfi-1)
+ (srfi srfi-26)
+ (ice-9 match))
- (setenv "PATH" (string-append #$archiver "/bin"))
+ (setenv "PATH" (string-append #$archiver "/bin"))
- ;; We need an empty file in order to have a valid file argument when
- ;; we reparent the root file system. Read on for why that's
- ;; necessary.
- (with-output-to-file ".empty" (lambda () (display "")))
+ ;; We need an empty file in order to have a valid file argument when
+ ;; we reparent the root file system. Read on for why that's
+ ;; necessary.
+ (with-output-to-file ".empty" (lambda () (display "")))
- ;; Create the squashfs image in several steps.
- ;; Add all store items. Unfortunately mksquashfs throws away all
- ;; ancestor directories and only keeps the basename. We fix this
- ;; in the following invocations of mksquashfs.
- (apply invoke "mksquashfs"
- `(,@(map store-info-item
- (call-with-input-file "profile"
- read-reference-graph))
- ,#$output
+ ;; Create the squashfs image in several steps.
+ ;; Add all store items. Unfortunately mksquashfs throws away all
+ ;; ancestor directories and only keeps the basename. We fix this
+ ;; in the following invocations of mksquashfs.
+ (apply invoke "mksquashfs"
+ `(,@(map store-info-item
+ (call-with-input-file "profile"
+ read-reference-graph))
+ ,#$output
- ;; Do not perform duplicate checking because we
- ;; don't have any dupes.
- "-no-duplicates"
- "-comp"
- ,#+(compressor-name compressor)))
+ ;; Do not perform duplicate checking because we
+ ;; don't have any dupes.
+ "-no-duplicates"
+ "-comp"
+ ,#+(compressor-name compressor)))
- ;; Here we reparent the store items. For each sub-directory of
- ;; the store prefix we need one invocation of "mksquashfs".
- (for-each (lambda (dir)
- (apply invoke "mksquashfs"
- `(".empty"
- ,#$output
- "-root-becomes" ,dir)))
- (reverse (string-tokenize (%store-directory)
- (char-set-complement (char-set #\/)))))
+ ;; Here we reparent the store items. For each sub-directory of
+ ;; the store prefix we need one invocation of "mksquashfs".
+ (for-each (lambda (dir)
+ (apply invoke "mksquashfs"
+ `(".empty"
+ ,#$output
+ "-root-becomes" ,dir)))
+ (reverse (string-tokenize (%store-directory)
+ (char-set-complement (char-set #\/)))))
- ;; Add symlinks and mount points.
- (apply invoke "mksquashfs"
- `(".empty"
- ,#$output
- ;; Create SYMLINKS via pseudo file definitions.
- ,@(append-map
- (match-lambda
- ((source '-> target)
- (list "-p"
- (string-join
- ;; name s mode uid gid symlink
- (list source
- "s" "777" "0" "0"
- (string-append #$profile "/" target))))))
- '#$symlinks)
+ ;; Add symlinks and mount points.
+ (apply invoke "mksquashfs"
+ `(".empty"
+ ,#$output
+ ;; Create SYMLINKS via pseudo file definitions.
+ ,@(append-map
+ (match-lambda
+ ((source '-> target)
+ (list "-p"
+ (string-join
+ ;; name s mode uid gid symlink
+ (list source
+ "s" "777" "0" "0"
+ (string-append #$profile "/" target))))))
+ '#$symlinks)
- ;; Create empty mount points.
- "-p" "/proc d 555 0 0"
- "-p" "/sys d 555 0 0"
- "-p" "/dev d 555 0 0"))))))
+ ;; Create empty mount points.
+ "-p" "/proc d 555 0 0"
+ "-p" "/sys d 555 0 0"
+ "-p" "/dev d 555 0 0")))))
(gexp->derivation (string-append name
(compressor-extension compressor)
--
2.19.1
guix-patches <at> gnu.org:bug#33259; Package guix-patches.
(Sun, 04 Nov 2018 22:12:03 GMT) Full text and rfc822 format available.Message #14 received at 33259 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: 33259 <at> debbugs.gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: [PATCH 6/8] pack: Add test for 'self-contained-tarball' with localstatedir. Date: Sun, 4 Nov 2018 23:10:34 +0100
* 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
guix-patches <at> gnu.org:bug#33259; Package guix-patches.
(Sun, 04 Nov 2018 22:12:03 GMT) Full text and rfc822 format available.Message #17 received at 33259 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: 33259 <at> debbugs.gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: [PATCH 5/8] pack: Squashfs backend now honors '--localstatedir'. Date: Sun, 4 Nov 2018 23:10:33 +0100
* 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
guix-patches <at> gnu.org:bug#33259; Package guix-patches.
(Sun, 04 Nov 2018 22:12:04 GMT) Full text and rfc822 format available.Message #20 received at 33259 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: 33259 <at> debbugs.gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: [PATCH 4/8] pack: Docker backend now honors '--localstatedir'. Date: Sun, 4 Nov 2018 23:10:32 +0100
* 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
guix-patches <at> gnu.org:bug#33259; Package guix-patches.
(Sun, 04 Nov 2018 22:12:04 GMT) Full text and rfc822 format available.Message #23 received at 33259 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: 33259 <at> debbugs.gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: [PATCH 7/8] store-copy: Canonicalize the mtime and permissions of the store copy. Date: Sun, 4 Nov 2018 23:10:35 +0100
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
guix-patches <at> gnu.org:bug#33259; Package guix-patches.
(Sun, 04 Nov 2018 22:12:05 GMT) Full text and rfc822 format available.Message #26 received at 33259 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: 33259 <at> debbugs.gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: [PATCH 2/8] pack: Import (guix store database) only when '--localstatedir' is passed. Date: Sun, 4 Nov 2018 23:10:30 +0100
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)))
+
;;;
;;; 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 @@
(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
guix-patches <at> gnu.org:bug#33259; Package guix-patches.
(Sun, 04 Nov 2018 22:12:05 GMT) Full text and rfc822 format available.Message #29 received at 33259 <at> debbugs.gnu.org (full text, mbox):
From: Ludovic Courtès <ludo <at> gnu.org> To: 33259 <at> debbugs.gnu.org Cc: Ludovic Courtès <ludo <at> gnu.org> Subject: [PATCH 8/8] pack: Add test for '--relocatable'. Date: Sun, 4 Nov 2018 23:10:36 +0100
* 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 <at> 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
guix-patches <at> gnu.org:bug#33259; Package guix-patches.
(Tue, 06 Nov 2018 10:49:03 GMT) Full text and rfc822 format available.Message #32 received at 33259 <at> debbugs.gnu.org (full text, mbox):
From: Danny Milosavljevic <dannym <at> scratchpost.org> To: Ludovic Courtès <ludo <at> gnu.org> Cc: 33259 <at> debbugs.gnu.org Subject: Re: [bug#33259] [PATCH 1/8] pack: Move store database creation to a separate derivation. Date: Tue, 6 Nov 2018 11:48:08 +0100
[Message part 1 (text/plain, inline)]
Hi Ludo, On Sun, 4 Nov 2018 23:10:29 +0100 Ludovic Courtès <ludo <at> 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!
[Message part 2 (application/pgp-signature, inline)]
guix-patches <at> gnu.org:bug#33259; Package guix-patches.
(Tue, 06 Nov 2018 10:58:01 GMT) Full text and rfc822 format available.Message #35 received at 33259 <at> debbugs.gnu.org (full text, mbox):
From: Danny Milosavljevic <dannym <at> scratchpost.org> To: Ludovic Courtès <ludo <at> gnu.org> Cc: 33259 <at> debbugs.gnu.org Subject: Re: [bug#33259] [PATCH 4/8] pack: Docker backend now honors '--localstatedir'. Date: Tue, 6 Nov 2018 11:57:44 +0100
[Message part 1 (text/plain, inline)]
> 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!
[Message part 2 (application/pgp-signature, inline)]
guix-patches <at> gnu.org:bug#33259; Package guix-patches.
(Tue, 06 Nov 2018 11:01:01 GMT) Full text and rfc822 format available.Message #38 received at 33259 <at> debbugs.gnu.org (full text, mbox):
From: Danny Milosavljevic <dannym <at> scratchpost.org> To: Ludovic Courtès <ludo <at> gnu.org> Cc: 33259 <at> debbugs.gnu.org Subject: Re: [bug#33259] [PATCH 5/8] pack: Squashfs backend now honors '--localstatedir'. Date: Tue, 6 Nov 2018 12:00:36 +0100
[Message part 1 (text/plain, inline)]
> + (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)))))))) "pk" here on purpose? Can't hurt in a test, I suppose... LGTM!
[Message part 2 (application/pgp-signature, inline)]
guix-patches <at> gnu.org:bug#33259; Package guix-patches.
(Tue, 06 Nov 2018 11:02:02 GMT) Full text and rfc822 format available.Message #41 received at 33259 <at> debbugs.gnu.org (full text, mbox):
From: Danny Milosavljevic <dannym <at> scratchpost.org> To: Ludovic Courtès <ludo <at> gnu.org> Cc: 33259 <at> debbugs.gnu.org Subject: Re: [bug#33259] [PATCH 6/8] pack: Add test for 'self-contained-tarball' with localstatedir. Date: Tue, 6 Nov 2018 12:01:17 +0100
[Message part 1 (text/plain, inline)]
LGTM!
[Message part 2 (application/pgp-signature, inline)]
guix-patches <at> gnu.org:bug#33259; Package guix-patches.
(Tue, 06 Nov 2018 11:03:02 GMT) Full text and rfc822 format available.Message #44 received at 33259 <at> debbugs.gnu.org (full text, mbox):
From: Danny Milosavljevic <dannym <at> scratchpost.org> To: Ludovic Courtès <ludo <at> gnu.org> Cc: 33259 <at> debbugs.gnu.org Subject: Re: [bug#33259] [PATCH 7/8] store-copy: Canonicalize the mtime and permissions of the store copy. Date: Tue, 6 Nov 2018 12:02:48 +0100
[Message part 1 (text/plain, inline)]
LGTM!
[Message part 2 (application/pgp-signature, inline)]
guix-patches <at> gnu.org:bug#33259; Package guix-patches.
(Tue, 06 Nov 2018 11:04:01 GMT) Full text and rfc822 format available.Message #47 received at 33259 <at> debbugs.gnu.org (full text, mbox):
From: Danny Milosavljevic <dannym <at> scratchpost.org> To: Ludovic Courtès <ludo <at> gnu.org> Cc: 33259 <at> debbugs.gnu.org Subject: Re: [bug#33259] [PATCH 8/8] pack: Add test for '--relocatable'. Date: Tue, 6 Nov 2018 12:03:49 +0100
[Message part 1 (text/plain, inline)]
LGTM!
[Message part 2 (application/pgp-signature, inline)]
guix-patches <at> gnu.org:bug#33259; Package guix-patches.
(Tue, 06 Nov 2018 11:06:02 GMT) Full text and rfc822 format available.Message #50 received at 33259 <at> debbugs.gnu.org (full text, mbox):
From: Danny Milosavljevic <dannym <at> scratchpost.org> To: Ludovic Courtès <ludo <at> gnu.org> Cc: 33259 <at> debbugs.gnu.org Subject: Re: [bug#33259] [PATCH 3/8] install: Add 'install-database-and-gc-roots'. Date: Tue, 6 Nov 2018 12:05:08 +0100
[Message part 1 (text/plain, inline)]
LGTM!
[Message part 2 (application/pgp-signature, inline)]
guix-patches <at> gnu.org:bug#33259; Package guix-patches.
(Tue, 06 Nov 2018 11:07:02 GMT) Full text and rfc822 format available.Message #53 received at 33259 <at> debbugs.gnu.org (full text, mbox):
From: Danny Milosavljevic <dannym <at> scratchpost.org> To: Ludovic Courtès <ludo <at> gnu.org> Cc: 33259 <at> debbugs.gnu.org Subject: Re: [bug#33259] [PATCH 2/8] pack: Import (guix store database) only when '--localstatedir' is passed. Date: Tue, 6 Nov 2018 12:06:53 +0100
[Message part 1 (text/plain, inline)]
LGTM!
[Message part 2 (application/pgp-signature, inline)]
guix-patches <at> gnu.org:bug#33259; Package guix-patches.
(Tue, 06 Nov 2018 14:45:02 GMT) Full text and rfc822 format available.Message #56 received at 33259 <at> debbugs.gnu.org (full text, mbox):
From: ludo <at> gnu.org (Ludovic Courtès) To: Danny Milosavljevic <dannym <at> scratchpost.org> Cc: 33259 <at> debbugs.gnu.org Subject: Re: [bug#33259] [PATCH 1/8] pack: Move store database creation to a separate derivation. Date: Tue, 06 Nov 2018 15:43:54 +0100
Hi, Danny Milosavljevic <dannym <at> scratchpost.org> skribis: > On Sun, 4 Nov 2018 23:10:29 +0100 > Ludovic Courtès <ludo <at> 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’.
guix-patches <at> gnu.org:bug#33259; Package guix-patches.
(Tue, 06 Nov 2018 14:45:03 GMT) Full text and rfc822 format available.Message #59 received at 33259 <at> debbugs.gnu.org (full text, mbox):
From: ludo <at> gnu.org (Ludovic Courtès) To: Danny Milosavljevic <dannym <at> scratchpost.org> Cc: 33259 <at> debbugs.gnu.org Subject: Re: [bug#33259] [PATCH 5/8] pack: Squashfs backend now honors '--localstatedir'. Date: Tue, 06 Nov 2018 15:44:34 +0100
Danny Milosavljevic <dannym <at> scratchpost.org> skribis: >> + (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)))))))) > > "pk" here on purpose? Can't hurt in a test, I suppose... Yeah. :-)
guix-patches <at> gnu.org:bug#33259; Package guix-patches.
(Tue, 06 Nov 2018 14:46:01 GMT) Full text and rfc822 format available.Message #62 received at 33259 <at> debbugs.gnu.org (full text, mbox):
From: ludo <at> gnu.org (Ludovic Courtès) To: Danny Milosavljevic <dannym <at> scratchpost.org> Cc: 33259 <at> debbugs.gnu.org Subject: Re: [bug#33259] [PATCH 4/8] pack: Docker backend now honors '--localstatedir'. Date: Tue, 06 Nov 2018 15:45:29 +0100
Danny Milosavljevic <dannym <at> 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’.
ludo <at> gnu.org (Ludovic Courtès):Ludovic Courtès <ludo <at> gnu.org>:Message #67 received at 33259-done <at> debbugs.gnu.org (full text, mbox):
From: ludo <at> gnu.org (Ludovic Courtès) To: Danny Milosavljevic <dannym <at> scratchpost.org> Cc: 33259-done <at> debbugs.gnu.org Subject: Re: [bug#33259] [PATCH 4/8] pack: Docker backend now honors '--localstatedir'. Date: Tue, 06 Nov 2018 23:23:51 +0100
ludo <at> gnu.org (Ludovic Courtès) skribis: > Danny Milosavljevic <dannym <at> 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’.
Debbugs Internal Request <help-debbugs <at> gnu.org>
to internal_control <at> debbugs.gnu.org.
(Wed, 05 Dec 2018 12:24:04 GMT) Full text and rfc822 format available.
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.