From: "Ludovic Courtès" <ludo@gnu.org>
To: 33259@debbugs.gnu.org
Subject: [bug#33259] [PATCH 4/8] pack: Docker backend now honors '--localstatedir'.
Date: Sun, 4 Nov 2018 23:10:32 +0100 [thread overview]
Message-ID: <20181104221036.4776-4-ludo@gnu.org> (raw)
In-Reply-To: <20181104221036.4776-1-ludo@gnu.org>
* 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
next prev parent reply other threads:[~2018-11-04 22:20 UTC|newest]
Thread overview: 21+ messages / expand[flat|nested] mbox.gz Atom feed top
2018-11-04 22:01 [bug#33259] [PATCH 0/8] 'guix pack': Better '--localstatedir' handling and more tests Ludovic Courtès
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-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
2018-11-06 11:05 ` Danny Milosavljevic
2018-11-04 22:10 ` Ludovic Courtès [this message]
2018-11-06 10:57 ` [bug#33259] [PATCH 4/8] pack: Docker backend now honors '--localstatedir' Danny Milosavljevic
2018-11-06 14:45 ` Ludovic Courtès
2018-11-06 22:23 ` bug#33259: " Ludovic Courtès
2018-11-04 22:10 ` [bug#33259] [PATCH 5/8] pack: Squashfs " Ludovic Courtès
2018-11-06 11:00 ` Danny Milosavljevic
2018-11-06 14:44 ` Ludovic Courtès
2018-11-04 22:10 ` [bug#33259] [PATCH 6/8] pack: Add test for 'self-contained-tarball' with localstatedir 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
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 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
2018-11-06 14:43 ` Ludovic Courtès
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://guix.gnu.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20181104221036.4776-4-ludo@gnu.org \
--to=ludo@gnu.org \
--cc=33259@debbugs.gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/guix.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).