diff options
| author | Ludovic Courtès <ludovic.courtes@inria.fr> | 2019-03-19 11:03:35 +0100 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2019-03-19 11:30:34 +0100 |
| commit | 427c87d0bdc06cc3ee7fc220fd3ad36084412533 (patch) | |
| tree | 35d297a2ec54ac5048da89641e487716a4317e1a | |
| parent | 1d6589db81c7c390e04795805e684b01f5a0c45f (diff) | |
| download | guix-427c87d0bdc06cc3ee7fc220fd3ad36084412533.tar.gz | |
pack: Produce relative symlinks when using '-f squashfs'.
Fixes <https://bugs.gnu.org/34913>. * guix/scripts/pack.scm (squashfs-image)[build]: Use 'relative-file-name' when creating SYMLINKS. * guix/scripts/pack.scm (guix-pack): Pass #:relative-symlinks? #t when PACK-FORMAT is 'squashfs.
| -rw-r--r-- | guix/scripts/pack.scm | 29 |
1 files changed, 22 insertions, 7 deletions
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 @@ added to the pack." (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 @@ added to the pack." ,@(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 @@ Create a bundle of PACKAGE.\n")) (run-with-store store (mlet* %store-monad ((profile (profile-derivation manifest - #:relative-symlinks? relocatable? + + ;; Always produce relative + ;; symlinks for Singularity (see + ;; <https://bugs.gnu.org/34913>). + #:relative-symlinks? + (or relocatable? + (eq? 'squashfs pack-format)) + #:hooks (if bootstrap? '() %default-profile-hooks) |