summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--guix/scripts/pack.scm19
-rw-r--r--tests/pack.scm36
2 files changed, 53 insertions, 2 deletions
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index 09fc88988ac..a86b95dd38a 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -53,6 +53,7 @@
53 lookup-compressor 53 lookup-compressor
54 self-contained-tarball 54 self-contained-tarball
55 docker-image 55 docker-image
56 squashfs-image
56 57
57 guix-pack)) 58 guix-pack))
58 59
@@ -288,18 +289,27 @@ points for virtual file systems (like procfs), and optional symlinks.
288 289
289SYMLINKS must be a list of (SOURCE -> TARGET) tuples denoting symlinks to be 290SYMLINKS must be a list of (SOURCE -> TARGET) tuples denoting symlinks to be
290added to the pack." 291added to the pack."
292 (define database
293 (and localstatedir?
294 (file-append (store-database (list profile))
295 "/db/db.sqlite")))
296
291 (define build 297 (define build
292 (with-imported-modules (source-module-closure 298 (with-imported-modules (source-module-closure
293 '((guix build utils) 299 '((guix build utils)
294 (guix build store-copy)) 300 (guix build store-copy)
301 (gnu build install))
295 #:select? not-config?) 302 #:select? not-config?)
296 #~(begin 303 #~(begin
297 (use-modules (guix build utils) 304 (use-modules (guix build utils)
298 (guix build store-copy) 305 (guix build store-copy)
306 (gnu build install)
299 (srfi srfi-1) 307 (srfi srfi-1)
300 (srfi srfi-26) 308 (srfi srfi-26)
301 (ice-9 match)) 309 (ice-9 match))
302 310
311 (define database #+database)
312
303 (setenv "PATH" (string-append #$archiver "/bin")) 313 (setenv "PATH" (string-append #$archiver "/bin"))
304 314
305 ;; We need an empty file in order to have a valid file argument when 315 ;; We need an empty file in order to have a valid file argument when
@@ -352,7 +362,12 @@ added to the pack."
352 ;; Create empty mount points. 362 ;; Create empty mount points.
353 "-p" "/proc d 555 0 0" 363 "-p" "/proc d 555 0 0"
354 "-p" "/sys d 555 0 0" 364 "-p" "/sys d 555 0 0"
355 "-p" "/dev d 555 0 0"))))) 365 "-p" "/dev d 555 0 0"))
366
367 (when database
368 ;; Initialize /var/guix.
369 (install-database-and-gc-roots "var-etc" database #$profile)
370 (invoke "mksquashfs" "var-etc" #$output)))))
356 371
357 (gexp->derivation (string-append name 372 (gexp->derivation (string-append name
358 (compressor-extension compressor) 373 (compressor-extension compressor)
diff --git a/tests/pack.scm b/tests/pack.scm
index bfff802d8ac..0c9e4ffa7ff 100644
--- a/tests/pack.scm
+++ b/tests/pack.scm
@@ -28,6 +28,7 @@
28 #:use-module (guix tests) 28 #:use-module (guix tests)
29 #:use-module (guix gexp) 29 #:use-module (guix gexp)
30 #:use-module (gnu packages bootstrap) 30 #:use-module (gnu packages bootstrap)
31 #:use-module ((gnu packages compression) #:select (squashfs-tools-next))
31 #:use-module (srfi srfi-64)) 32 #:use-module (srfi srfi-64))
32 33
33(define %store 34(define %store
@@ -126,6 +127,41 @@
126 (string=? (string-append #$profile "/bin/guile") 127 (string=? (string-append #$profile "/bin/guile")
127 (pk 'guilelink (readlink "bin/Guile")))) 128 (pk 'guilelink (readlink "bin/Guile"))))
128 (mkdir #$output))))))) 129 (mkdir #$output)))))))
130 (built-derivations (list check))))
131
132 (unless store (test-skip 1))
133 (test-assertm "squashfs-image + localstatedir" store
134 (mlet* %store-monad
135 ((guile (set-guile-for-build (default-guile)))
136 (profile (profile-derivation (packages->manifest
137 (list %bootstrap-guile))
138 #:hooks '()
139 #:locales? #f))
140 (image (squashfs-image "squashfs-pack" profile
141 #:symlinks '(("/bin" -> "bin"))
142 #:localstatedir? #t))
143 (check (gexp->derivation
144 "check-tarball"
145 (with-imported-modules '((guix build utils))
146 #~(begin
147 (use-modules (guix build utils)
148 (ice-9 match))
149
150 (define bin
151 (string-append "." #$profile "/bin"))
152
153 (setenv "PATH"
154 (string-append #$squashfs-tools-next "/bin"))
155 (invoke "unsquashfs" #$image)
156 (with-directory-excursion "squashfs-root"
157 (when (and (file-exists? (string-append bin
158 "/guile"))
159 (file-exists? "var/guix/db/db.sqlite")
160 (string=? (string-append #$%bootstrap-guile "/bin")
161 (pk 'binlink (readlink bin)))
162 (string=? (string-append #$profile "/bin")
163 (pk 'guilelink (readlink "bin"))))
164 (mkdir #$output))))))))
129 (built-derivations (list check))))) 165 (built-derivations (list check)))))
130 166
131(test-end) 167(test-end)