diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm index 17a166d9d7..8685ba1d0a 100644 --- a/guix/scripts/pack.scm +++ b/guix/scripts/pack.scm @@ -306,11 +306,13 @@ (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) @@ -359,12 +361,18 @@ (define database #+database) ,@(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)))))) + ;; 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) ;; Create empty mount points. @@ -881,7 +889,14 @@ (define properties (run-with-store store (mlet* %store-monad ((profile (profile-derivation manifest - #:relative-symlinks? relocatable? + + ;; Always produce relative + ;; symlinks for Singularity (see + ;; ). + #:relative-symlinks? + (or relocatable? + (eq? 'squashfs pack-format)) + #:hooks (if bootstrap? '() %default-profile-hooks)