aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludovic.courtes@inria.fr>2019-03-19 11:03:35 +0100
committerLudovic Courtès <ludo@gnu.org>2019-03-19 11:30:34 +0100
commit427c87d0bdc06cc3ee7fc220fd3ad36084412533 (patch)
tree35d297a2ec54ac5048da89641e487716a4317e1a
parent1d6589db81c7c390e04795805e684b01f5a0c45f (diff)
downloadpatches-427c87d0bdc06cc3ee7fc220fd3ad36084412533.tar
patches-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.scm29
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)