[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
01/08: pack: Squashfs build expression refers to (guix store database) &
From: |
Ludovic Courtès |
Subject: |
01/08: pack: Squashfs build expression refers to (guix store database) & co. |
Date: |
Mon, 25 Jun 2018 17:36:04 -0400 (EDT) |
civodul pushed a commit to branch master
in repository guix.
commit 66e9944e078cbb9e0d618377dd6df6e639640efa
Author: Ludovic Courtès <address@hidden>
Date: Mon Jun 25 21:49:12 2018 +0200
pack: Squashfs build expression refers to (guix store database) & co.
Fixes a regression introduced in
c45477d2a1a651485feede20fe0f3d15aec48b39.
Reported by Christopher Baines <address@hidden>.
* 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.
---
guix/scripts/pack.scm | 170 ++++++++++++++++++++++++++------------------------
1 file changed, 89 insertions(+), 81 deletions(-)
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index 443d199..7f087a3 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -88,6 +88,19 @@ found."
%compressors)
(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
#:key target
deduplicate?
@@ -102,13 +115,6 @@ with a properly initialized store database.
SYMLINKS must be a list of (SOURCE -> TARGET) tuples denoting symlinks to be
added to the pack."
- (define not-config?
- (match-lambda
- (('guix 'config) #f)
- (('guix _ ...) #t)
- (('gnu _ ...) #t)
- (_ #f)))
-
(define libgcrypt
(module-ref (resolve-interface '(gnu packages gnupg))
'libgcrypt))
@@ -128,9 +134,7 @@ added to the pack."
(guix build store-copy)
(gnu build install))
#:select? not-config?))
- (with-extensions (cons guile-sqlite3
- (package-transitive-propagated-inputs
- guile-sqlite3))
+ (with-extensions guile-sqlite3&co
#~(begin
(use-modules (guix build utils)
((guix build union) #:select (relative-file-name))
@@ -248,71 +252,83 @@ 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 libgcrypt
+ ;; XXX: Not strictly needed, but pulled by (guix store database).
+ (module-ref (resolve-interface '(gnu packages gnupg))
+ 'libgcrypt))
+
+
(define build
- (with-imported-modules '((guix build utils)
- (guix build store-copy)
- (gnu build install))
- #~(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 `(((guix config)
+ => ,(make-config.scm
+ #:libgcrypt libgcrypt))
+ ,@(source-module-closure
+ '((guix build utils)
+ (guix build store-copy)
+ (gnu build install))
+ #:select? not-config?))
+ (with-extensions guile-sqlite3&co
+ #~(begin
+ (use-modules (guix build utils)
+ (gnu build install)
+ (guix build store-copy)
+ (srfi srfi-1)
+ (srfi srfi-26)
+ (ice-9 match))
- (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 "")))
-
- ;; 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)))
-
- ;; 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)
-
- ;; Create empty mount points.
- "-p" "/proc d 555 0 0"
- "-p" "/sys d 555 0 0"
- "-p" "/dev d 555 0 0")))))
+ (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 "")))
+
+ ;; 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)))
+
+ ;; 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)
+
+ ;; 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)
@@ -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
must a be a GNU triplet and it is used to derive the architecture metadata in
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 config
- branch master updated (887fe1f -> 87d1b7b), Ludovic Courtès, 2018/06/25
- 02/08: gnu: emacs-emms-player-simple-mpv: Deprecate in favor of Emms 5.0+., Ludovic Courtès, 2018/06/25
- 03/08: gnu: emacs-emms-player-mpv: Deprecate in favor of Emms 5.0+., Ludovic Courtès, 2018/06/25
- 06/08: gnu: Add stalin., Ludovic Courtès, 2018/06/25
- 08/08: gnu: Add clyrics., Ludovic Courtès, 2018/06/25
- 05/08: gnu: Add opencl-clhpp., Ludovic Courtès, 2018/06/25
- 07/08: gnu: guile-simple-zmq: Update to commit '1f3b7c0'., Ludovic Courtès, 2018/06/25
- 04/08: gnu: Add opencl-headers., Ludovic Courtès, 2018/06/25
- 01/08: pack: Squashfs build expression refers to (guix store database) & co.,
Ludovic Courtès <=