pack: Squashfs backend now honors '--localstatedir'.
* 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.
This commit is contained in:
parent
f5a2fb1bfb
commit
598a6b87cc
|
@ -53,6 +53,7 @@
|
||||||
lookup-compressor
|
lookup-compressor
|
||||||
self-contained-tarball
|
self-contained-tarball
|
||||||
docker-image
|
docker-image
|
||||||
|
squashfs-image
|
||||||
|
|
||||||
guix-pack))
|
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
|
SYMLINKS must be a list of (SOURCE -> TARGET) tuples denoting symlinks to be
|
||||||
added to the pack."
|
added to the pack."
|
||||||
|
(define database
|
||||||
|
(and localstatedir?
|
||||||
|
(file-append (store-database (list profile))
|
||||||
|
"/db/db.sqlite")))
|
||||||
|
|
||||||
(define build
|
(define build
|
||||||
(with-imported-modules (source-module-closure
|
(with-imported-modules (source-module-closure
|
||||||
'((guix build utils)
|
'((guix build utils)
|
||||||
(guix build store-copy))
|
(guix build store-copy)
|
||||||
|
(gnu build install))
|
||||||
#:select? not-config?)
|
#:select? not-config?)
|
||||||
#~(begin
|
#~(begin
|
||||||
(use-modules (guix build utils)
|
(use-modules (guix build utils)
|
||||||
(guix build store-copy)
|
(guix build store-copy)
|
||||||
|
(gnu build install)
|
||||||
(srfi srfi-1)
|
(srfi srfi-1)
|
||||||
(srfi srfi-26)
|
(srfi srfi-26)
|
||||||
(ice-9 match))
|
(ice-9 match))
|
||||||
|
|
||||||
|
(define database #+database)
|
||||||
|
|
||||||
(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 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.
|
;; Create empty mount points.
|
||||||
"-p" "/proc d 555 0 0"
|
"-p" "/proc d 555 0 0"
|
||||||
"-p" "/sys 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
|
(gexp->derivation (string-append name
|
||||||
(compressor-extension compressor)
|
(compressor-extension compressor)
|
||||||
|
|
|
@ -28,6 +28,7 @@
|
||||||
#:use-module (guix tests)
|
#:use-module (guix tests)
|
||||||
#:use-module (guix gexp)
|
#:use-module (guix gexp)
|
||||||
#:use-module (gnu packages bootstrap)
|
#:use-module (gnu packages bootstrap)
|
||||||
|
#:use-module ((gnu packages compression) #:select (squashfs-tools-next))
|
||||||
#:use-module (srfi srfi-64))
|
#:use-module (srfi srfi-64))
|
||||||
|
|
||||||
(define %store
|
(define %store
|
||||||
|
@ -126,6 +127,41 @@
|
||||||
(string=? (string-append #$profile "/bin/guile")
|
(string=? (string-append #$profile "/bin/guile")
|
||||||
(pk 'guilelink (readlink "bin/Guile"))))
|
(pk 'guilelink (readlink "bin/Guile"))))
|
||||||
(mkdir #$output)))))))
|
(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)))))
|
(built-derivations (list check)))))
|
||||||
|
|
||||||
(test-end)
|
(test-end)
|
||||||
|
|
Loading…
Reference in New Issue