pack: Squashfs build expression refers to (guix store database) & co.

Fixes a regression introduced in
c45477d2a1.
Reported by Christopher Baines <mail@cbaines.net>.

* guix/scripts/pack.scm (not-config?, guile-sqlite3&co): New variables.
(self-contained-tarball)[not-config?]: Remove.
[build]: Use GUILE-SQLITE3&CO for 'with-extensions'.
(squashfs-image)[libgcrypt]: New variable.
[build]: Use 'source-module-closure', 'make-config.scm', and
'with-extensions'.
(docker-image)[not-config?]: Remove.
This commit is contained in:
Ludovic Courtès 2018-06-25 21:49:12 +02:00
parent 887fe1fbde
commit 66e9944e07
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 83 additions and 75 deletions

View File

@ -88,6 +88,19 @@ found."
%compressors) %compressors)
(leave (G_ "~a: compressor not found~%") name))) (leave (G_ "~a: compressor not found~%") name)))
(define not-config?
;; Select (guix …) and (gnu …) modules, except (guix config).
(match-lambda
(('guix 'config) #f)
(('guix _ ...) #t)
(('gnu _ ...) #t)
(_ #f)))
(define guile-sqlite3&co
;; Guile-SQLite3 and its propagated inputs.
(cons guile-sqlite3
(package-transitive-propagated-inputs guile-sqlite3)))
(define* (self-contained-tarball name profile (define* (self-contained-tarball name profile
#:key target #:key target
deduplicate? deduplicate?
@ -102,13 +115,6 @@ with a properly initialized store database.
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 not-config?
(match-lambda
(('guix 'config) #f)
(('guix _ ...) #t)
(('gnu _ ...) #t)
(_ #f)))
(define libgcrypt (define libgcrypt
(module-ref (resolve-interface '(gnu packages gnupg)) (module-ref (resolve-interface '(gnu packages gnupg))
'libgcrypt)) 'libgcrypt))
@ -128,9 +134,7 @@ added to the pack."
(guix build store-copy) (guix build store-copy)
(gnu build install)) (gnu build install))
#:select? not-config?)) #:select? not-config?))
(with-extensions (cons guile-sqlite3 (with-extensions guile-sqlite3&co
(package-transitive-propagated-inputs
guile-sqlite3))
#~(begin #~(begin
(use-modules (guix build utils) (use-modules (guix build utils)
((guix build union) #:select (relative-file-name)) ((guix build union) #:select (relative-file-name))
@ -248,10 +252,22 @@ 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 libgcrypt
;; XXX: Not strictly needed, but pulled by (guix store database).
(module-ref (resolve-interface '(gnu packages gnupg))
'libgcrypt))
(define build (define build
(with-imported-modules '((guix build utils) (with-imported-modules `(((guix config)
=> ,(make-config.scm
#:libgcrypt libgcrypt))
,@(source-module-closure
'((guix build utils)
(guix build store-copy) (guix build store-copy)
(gnu build install)) (gnu build install))
#:select? not-config?))
(with-extensions guile-sqlite3&co
#~(begin #~(begin
(use-modules (guix build utils) (use-modules (guix build utils)
(gnu build install) (gnu build install)
@ -312,7 +328,7 @@ 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"))))))
(gexp->derivation (string-append name (gexp->derivation (string-append name
(compressor-extension compressor) (compressor-extension compressor)
@ -332,14 +348,6 @@ 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 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 must a be a GNU triplet and it is used to derive the architecture metadata in
the image." the image."
;; FIXME: Honor LOCALSTATEDIR?.
(define not-config?
(match-lambda
(('guix 'config) #f)
(('guix rest ...) #t)
(('gnu rest ...) #t)
(rest #f)))
(define defmod 'define-module) ;trick Geiser (define defmod 'define-module) ;trick Geiser
(define config (define config