aboutsummaryrefslogtreecommitdiff
path: root/guix/scripts/pack.scm
diff options
context:
space:
mode:
Diffstat (limited to 'guix/scripts/pack.scm')
-rw-r--r--guix/scripts/pack.scm260
1 files changed, 133 insertions, 127 deletions
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index ba9a6dc1b2..8ecdcb823f 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -167,8 +167,6 @@ dependencies are registered."
(let ((items (append-map read-closure '#$labels)))
(with-database db-file db
(register-items db items
- #:deduplicate? #f
- #:reset-timestamps? #f
#:registration-time %epoch)))))))
(computed-file "store-database" build
@@ -204,12 +202,19 @@ added to the pack."
#+(file-append glibc-utf8-locales "/lib/locale"))
(setlocale LC_ALL "en_US.utf8"))))
+ (define (import-module? module)
+ ;; Since we don't use deduplication support in 'populate-store', don't
+ ;; import (guix store deduplication) and its dependencies, which includes
+ ;; Guile-Gcrypt. That way we can run tests with '--bootstrap'.
+ (and (not-config? module)
+ (not (equal? '(guix store deduplication) module))))
+
(define build
(with-imported-modules (source-module-closure
`((guix build utils)
(guix build union)
(gnu build install))
- #:select? not-config?)
+ #:select? import-module?)
#~(begin
(use-modules (guix build utils)
((guix build union) #:select (relative-file-name))
@@ -383,138 +388,139 @@ added to the pack."
`(("/bin" -> "bin") ,@symlinks)))
(define build
- (with-imported-modules (source-module-closure
- '((guix build utils)
- (guix build store-copy)
- (guix build union)
- (gnu build install))
- #:select? not-config?)
- #~(begin
- (use-modules (guix build utils)
- (guix build store-copy)
- ((guix build union) #:select (relative-file-name))
- (gnu build install)
- (srfi srfi-1)
- (srfi srfi-26)
- (ice-9 match))
+ (with-extensions (list guile-gcrypt)
+ (with-imported-modules (source-module-closure
+ '((guix build utils)
+ (guix build store-copy)
+ (guix build union)
+ (gnu build install))
+ #:select? not-config?)
+ #~(begin
+ (use-modules (guix build utils)
+ (guix build store-copy)
+ ((guix build union) #:select (relative-file-name))
+ (gnu build install)
+ (srfi srfi-1)
+ (srfi srfi-26)
+ (ice-9 match))
- (define database #+database)
- (define entry-point #$entry-point)
+ (define database #+database)
+ (define entry-point #$entry-point)
- (define (mksquashfs args)
- (apply invoke "mksquashfs"
- `(,@args
+ (define (mksquashfs args)
+ (apply invoke "mksquashfs"
+ `(,@args
- ;; Do not create a "recovery file" when appending to the
- ;; file system since it's useless in this case.
- "-no-recovery"
+ ;; Do not create a "recovery file" when appending to the
+ ;; file system since it's useless in this case.
+ "-no-recovery"
- ;; Do not attempt to store extended attributes.
- ;; See <https://bugs.gnu.org/40043>.
- "-no-xattrs"
+ ;; Do not attempt to store extended attributes.
+ ;; See <https://bugs.gnu.org/40043>.
+ "-no-xattrs"
- ;; Set file times and the file system creation time to
- ;; one second after the Epoch.
- "-all-time" "1" "-mkfs-time" "1"
+ ;; Set file times and the file system creation time to
+ ;; one second after the Epoch.
+ "-all-time" "1" "-mkfs-time" "1"
- ;; Reset all UIDs and GIDs.
- "-force-uid" "0" "-force-gid" "0")))
+ ;; Reset all UIDs and GIDs.
+ "-force-uid" "0" "-force-gid" "0")))
- (setenv "PATH" #+(file-append archiver "/bin"))
+ (setenv "PATH" #+(file-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.
- (mksquashfs `(,@(map store-info-item
- (call-with-input-file "profile"
- read-reference-graph))
- #$environment
- ,#$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)
- (mksquashfs `(".empty"
- ,#$output
- "-root-becomes" ,dir)))
- (reverse (string-tokenize (%store-directory)
- (char-set-complement (char-set #\/)))))
-
- ;; Add symlinks and mount points.
- (mksquashfs
- `(".empty"
- ,#$output
- ;; Create SYMLINKS via pseudo file definitions.
- ,@(append-map
- (match-lambda
- ((source '-> target)
- ;; Create relative symlinks to work around a bug in
- ;; Singularity 2.x:
- ;; https://bugs.gnu.org/34913
- ;; https://github.com/sylabs/singularity/issues/1487
- (let ((target (string-append #$profile "/" target)))
- (list "-p"
- (string-join
- ;; name s mode uid gid symlink
- (list source
- "s" "777" "0" "0"
- (relative-file-name (dirname source)
- target)))))))
- '#$symlinks*)
-
- "-p" "/.singularity.d d 555 0 0"
-
- ;; Create the environment file.
- "-p" "/.singularity.d/env d 555 0 0"
- "-p" ,(string-append
- "/.singularity.d/env/90-environment.sh s 777 0 0 "
- (relative-file-name "/.singularity.d/env"
- #$environment))
-
- ;; Create /.singularity.d/actions, and optionally the 'run'
- ;; script, used by 'singularity run'.
- "-p" "/.singularity.d/actions d 555 0 0"
-
- ,@(if entry-point
- `(;; This one if for Singularity 2.x.
- "-p"
- ,(string-append
- "/.singularity.d/actions/run s 777 0 0 "
- (relative-file-name "/.singularity.d/actions"
- (string-append #$profile "/"
- entry-point)))
-
- ;; This one is for Singularity 3.x.
- "-p"
- ,(string-append
- "/.singularity.d/runscript s 777 0 0 "
- (relative-file-name "/.singularity.d"
- (string-append #$profile "/"
- entry-point))))
- '())
-
- ;; Create empty mount points.
- "-p" "/proc d 555 0 0"
- "-p" "/sys d 555 0 0"
- "-p" "/dev d 555 0 0"
- "-p" "/home d 555 0 0"))
-
- (when database
- ;; Initialize /var/guix.
- (install-database-and-gc-roots "var-etc" database #$profile)
- (mksquashfs `("var-etc" ,#$output))))))
+ ;; 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.
+ (mksquashfs `(,@(map store-info-item
+ (call-with-input-file "profile"
+ read-reference-graph))
+ #$environment
+ ,#$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)
+ (mksquashfs `(".empty"
+ ,#$output
+ "-root-becomes" ,dir)))
+ (reverse (string-tokenize (%store-directory)
+ (char-set-complement (char-set #\/)))))
+
+ ;; Add symlinks and mount points.
+ (mksquashfs
+ `(".empty"
+ ,#$output
+ ;; Create SYMLINKS via pseudo file definitions.
+ ,@(append-map
+ (match-lambda
+ ((source '-> target)
+ ;; Create relative symlinks to work around a bug in
+ ;; Singularity 2.x:
+ ;; https://bugs.gnu.org/34913
+ ;; https://github.com/sylabs/singularity/issues/1487
+ (let ((target (string-append #$profile "/" target)))
+ (list "-p"
+ (string-join
+ ;; name s mode uid gid symlink
+ (list source
+ "s" "777" "0" "0"
+ (relative-file-name (dirname source)
+ target)))))))
+ '#$symlinks*)
+
+ "-p" "/.singularity.d d 555 0 0"
+
+ ;; Create the environment file.
+ "-p" "/.singularity.d/env d 555 0 0"
+ "-p" ,(string-append
+ "/.singularity.d/env/90-environment.sh s 777 0 0 "
+ (relative-file-name "/.singularity.d/env"
+ #$environment))
+
+ ;; Create /.singularity.d/actions, and optionally the 'run'
+ ;; script, used by 'singularity run'.
+ "-p" "/.singularity.d/actions d 555 0 0"
+
+ ,@(if entry-point
+ `( ;; This one if for Singularity 2.x.
+ "-p"
+ ,(string-append
+ "/.singularity.d/actions/run s 777 0 0 "
+ (relative-file-name "/.singularity.d/actions"
+ (string-append #$profile "/"
+ entry-point)))
+
+ ;; This one is for Singularity 3.x.
+ "-p"
+ ,(string-append
+ "/.singularity.d/runscript s 777 0 0 "
+ (relative-file-name "/.singularity.d"
+ (string-append #$profile "/"
+ entry-point))))
+ '())
+
+ ;; Create empty mount points.
+ "-p" "/proc d 555 0 0"
+ "-p" "/sys d 555 0 0"
+ "-p" "/dev d 555 0 0"
+ "-p" "/home d 555 0 0"))
+
+ (when database
+ ;; Initialize /var/guix.
+ (install-database-and-gc-roots "var-etc" database #$profile)
+ (mksquashfs `("var-etc" ,#$output)))))))
(gexp->derivation (string-append name
(compressor-extension compressor)
generated by cgit v1.2.3 (git 2.25.4) at 2024-05-29 14:55:09 +0000