From dea62932bc929243dae5e8b08f4fbe0b6f70be95 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludovic.courtes@inria.fr>
Date: Tue, 2 Jul 2019 10:30:23 +0200
Subject: [PATCH] pack: 'squashfs' backend records the profile's search paths.

* guix/scripts/pack.scm (singularity-environment-file): New procedure.
(squashfs-image): Use it, and create /.singularity/env/90-environment.sh.
* gnu/tests/singularity.scm (run-singularity-test)["singularity run,
with environment"]: New test, currently skipped.
* gnu/tests/singularity.scm (build-tarball&run-singularity-test): Add
GUILE-JSON to the profile.
---
 gnu/tests/singularity.scm | 18 ++++++++++++++++-
 guix/scripts/pack.scm     | 41 ++++++++++++++++++++++++++++++++++++++-
 2 files changed, 57 insertions(+), 2 deletions(-)

diff --git a/gnu/tests/singularity.scm b/gnu/tests/singularity.scm
index 668043a0bc..2f3a6f289d 100644
--- a/gnu/tests/singularity.scm
+++ b/gnu/tests/singularity.scm
@@ -111,6 +111,21 @@
                         "run" #$image "-c" "(exit 42)"))
              marionette))
 
+          ;; FIXME: Singularity 2.x doesn't directly honor
+          ;; /.singularity.d/env/*.sh.  Instead, you have to load those files
+          ;; manually, which we don't do.  Remove 'test-skip' call once we've
+          ;; switch to Singularity 3.x.
+          (test-skip 1)
+          (test-equal "singularity run, with environment"
+            0
+            (marionette-eval
+             ;; Check whether GUILE_LOAD_PATH is properly set, allowing us to
+             ;; find the (json) module.
+             `(status:exit-val
+               (system* #$(file-append singularity "/bin/singularity")
+                        "--debug" "run" #$image "-c" "(use-modules (json))"))
+             marionette))
+
           (test-end)
           (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
 
@@ -122,7 +137,8 @@
        (guile    (set-guile-for-build (default-guile)))
        ;; 'singularity exec' insists on having /bin/sh in the image.
        (profile  (profile-derivation (packages->manifest
-                                      (list bash-minimal guile-2.2))
+                                      (list bash-minimal
+                                            guile-2.2 guile-json))
                                      #:hooks '()
                                      #:locales? #f))
        (tarball  (squashfs-image "singularity-pack" profile
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index bb6a8cda1a..4ac5dfc896 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -286,6 +286,32 @@ added to the pack."
                     build
                     #:references-graphs `(("profile" ,profile))))
 
+(define (singularity-environment-file profile)
+  "Return a shell script that defines the environment variables corresponding
+to the search paths of PROFILE."
+  (define build
+    (with-extensions (list guile-gcrypt)
+      (with-imported-modules `(((guix config) => ,(make-config.scm))
+                               ,@(source-module-closure
+                                  `((guix profiles)
+                                    (guix search-paths))
+                                  #:select? not-config?))
+        #~(begin
+            (use-modules (guix profiles) (guix search-paths)
+                         (ice-9 match))
+
+            (call-with-output-file #$output
+              (lambda (port)
+                (for-each (match-lambda
+                            ((spec . value)
+                             (format port "~a=~a~%export ~a~%"
+                                     (search-path-specification-variable spec)
+                                     value
+                                     (search-path-specification-variable spec))))
+                          (profile-search-paths #$profile))))))))
+
+  (computed-file "singularity-environment.sh" build))
+
 (define* (squashfs-image name profile
                          #:key target
                          (profile-name "guix-profile")
@@ -305,6 +331,9 @@ added to the pack."
          (file-append (store-database (list profile))
                       "/db/db.sqlite")))
 
+  (define environment
+    (singularity-environment-file profile))
+
   (define build
     (with-imported-modules (source-module-closure
                             '((guix build utils)
@@ -339,6 +368,7 @@ added to the pack."
                  `(,@(map store-info-item
                           (call-with-input-file "profile"
                             read-reference-graph))
+                   #$environment
                    ,#$output
 
                    ;; Do not perform duplicate checking because we
@@ -379,10 +409,19 @@ added to the pack."
                                                             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 d 555 0 0"
                    "-p" "/.singularity.d/actions d 555 0 0"
+
                    ,@(if entry-point
                          `(;; This one if for Singularity 2.x.
                            "-p"