[bug#36469] [PATCH 0/2] 'guix pack' records environment variables

[bug#36469] [PATCH 0/2] 'guix pack' records environment variables

[Ludovic Courtès]

Hello Guix!

With these patches, images created by ‘guix pack -f docker’ or
‘guix pack -f singularity’ define the right environment variables
for the profile.

For instance, if you do:

  guix pack -f docker guile guile-json --entry-point=bin/guile

Then:

  docker run THE-IMAGE

will spawn Guile in an environment with $GUILE_LOAD_PATH pointing
to the profile, such that the (json) module is automatically found.

The change for Singularity is similar.  I’ve tested it with an
instance of Singularity 3.2.0.  Unfortunately, we still have 2.x
in Guix and that doesn’t quite support the environment file, so I’ve
chosen to punt on this one.

Thoughts?

Ludo’.

Ludovic Courtès (2):
  pack: 'docker' backend records the profile's search paths.
  pack: 'squashfs' backend records the profile's search paths.

 gnu/tests/docker.scm      | 16 ++++++----
 gnu/tests/singularity.scm | 18 ++++++++++-
 guix/docker.scm           | 17 ++++++++---
 guix/scripts/pack.scm     | 64 ++++++++++++++++++++++++++++++++++++---
 4 files changed, 99 insertions(+), 16 deletions(-)

-- 
2.22.0

[bug#36469] [PATCH 1/2] pack: 'docker' backend records the profile's search paths.

[Ludovic Courtès]

From: Ludovic Courtès <ludovic.courtes@inria.fr>

* guix/docker.scm (config): Add #:environment parameter and honor it.
(build-docker-image): Likewise, and pass it to 'config'.
* guix/scripts/pack.scm (docker-image): Import (guix profiles) and (guix
search-paths).  Call 'profile-search-paths' and pass #:environment to
'build-docker-image'.
* gnu/tests/docker.scm (run-docker-test)["Load docker image and run it"]:
Add example that expects (json) to be available.
* gnu/tests/docker.scm (build-tarball&run-docker-test): Replace
%BOOTSTRAP-GUILE by GUILE-2.2 and GUILE-JSON in the environment.
---
 gnu/tests/docker.scm  | 16 ++++++++++------
 guix/docker.scm       | 17 +++++++++++++----
 guix/scripts/pack.scm | 23 +++++++++++++++++++----
 3 files changed, 42 insertions(+), 14 deletions(-)

diff --git a/gnu/tests/docker.scm b/gnu/tests/docker.scm
index f2674cdbe8..27fde49e75 100644
--- a/gnu/tests/docker.scm
+++ b/gnu/tests/docker.scm
@@ -27,7 +27,6 @@
   #:use-module (gnu services networking)
   #:use-module (gnu services docker)
   #:use-module (gnu services desktop)
-  #:use-module (gnu packages bootstrap) ; %bootstrap-guile
   #:use-module (gnu packages docker)
   #:use-module (gnu packages guile)
   #:use-module (guix gexp)
@@ -101,7 +100,7 @@ inside %DOCKER-OS."
              marionette))
 
           (test-equal "Load docker image and run it"
-            '("hello world" "hi!")
+            '("hello world" "hi!" "JSON!")
             (marionette-eval
              `(begin
                 (define slurp
@@ -125,8 +124,13 @@ inside %DOCKER-OS."
                        (response2 (slurp          ;default entry point
                                    ,(string-append #$docker-cli "/bin/docker")
                                    "run" repository&tag
-                                   "-c" "(display \"hi!\")")))
-                  (list response1 response2)))
+                                   "-c" "(display \"hi!\")"))
+                       (response3 (slurp    ;default entry point + environment
+                                   ,(string-append #$docker-cli "/bin/docker")
+                                   "run" repository&tag
+                                   "-c" "(use-modules (json))
+  (display (json-string->scm (scm->json-string \"JSON!\")))")))
+                  (list response1 response2 response3)))
              marionette))
 
           (test-end)
@@ -144,7 +148,7 @@ inside %DOCKER-OS."
           (version "0")
           (source #f)
           (build-system trivial-build-system)
-          (arguments `(#:guile ,%bootstrap-guile
+          (arguments `(#:guile ,guile-2.2
                        #:builder
                        (let ((out (assoc-ref %outputs "out")))
                          (mkdir out)
@@ -158,7 +162,7 @@ standard output device and then enters a new line.")
           (home-page #f)
           (license license:public-domain)))
        (profile (profile-derivation (packages->manifest
-                                     (list %bootstrap-guile
+                                     (list guile-2.2 guile-json
                                            guest-script-package))
                                     #:hooks '()
                                     #:locales? #f))
diff --git a/guix/docker.scm b/guix/docker.scm
index 7fe83d9797..b1bd226fa1 100644
--- a/guix/docker.scm
+++ b/guix/docker.scm
@@ -73,7 +73,7 @@
   `((,(generate-tag path) . ((latest . ,id)))))
 
 ;; See https://github.com/opencontainers/image-spec/blob/master/config.md
-(define* (config layer time arch #:key entry-point)
+(define* (config layer time arch #:key entry-point (environment '()))
   "Generate a minimal image configuration for the given LAYER file."
   ;; "architecture" must be values matching "platform.arch" in the
   ;; runtime-spec at
@@ -81,9 +81,13 @@
   `((architecture . ,arch)
     (comment . "Generated by GNU Guix")
     (created . ,time)
-    (config . ,(if entry-point
-                   `((entrypoint . ,entry-point))
-                   #nil))
+    (config . ,`((env . ,(map (match-lambda
+                                ((name . value)
+                                 (string-append name "=" value)))
+                              environment))
+                 ,@(if entry-point
+                       `((entrypoint . ,entry-point))
+                       '())))
     (container_config . #nil)
     (os . "linux")
     (rootfs . ((type . "layers")
@@ -113,6 +117,7 @@ return \"a\"."
                              (system (utsname:machine (uname)))
                              database
                              entry-point
+                             (environment '())
                              compressor
                              (creation-time (current-time time-utc)))
   "Write to IMAGE a Docker image archive containing the given PATHS.  PREFIX
@@ -124,6 +129,9 @@ When DATABASE is true, copy it to /var/guix/db in the image and create
 When ENTRY-POINT is true, it must be a list of strings; it is stored as the
 entry point in the Docker image JSON structure.
 
+ENVIRONMENT must be a list of name/value pairs.  It specifies the environment
+variables that must be defined in the resulting image.
+
 SYMLINKS must be a list of (SOURCE -> TARGET) tuples describing symlinks to be
 created in the image, where each TARGET is relative to PREFIX.
 TRANSFORMATIONS must be a list of (OLD -> NEW) tuples describing how to
@@ -234,6 +242,7 @@ SRFI-19 time-utc object, as the creation time in metadata."
         (lambda ()
           (scm->json (config (string-append id "/layer.tar")
                              time arch
+                             #:environment environment
                              #:entry-point entry-point))))
       (with-output-to-file "manifest.json"
         (lambda ()
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index c90b777222..bb6a8cda1a 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -27,6 +27,7 @@
   #:use-module (guix utils)
   #:use-module (guix store)
   #:use-module ((guix status) #:select (with-status-verbosity))
+  #:use-module ((guix self) #:select (make-config.scm))
   #:use-module (guix grafts)
   #:autoload   (guix inferior) (inferior-package?)
   #:use-module (guix monads)
@@ -440,11 +441,24 @@ the image."
   (define build
     ;; Guile-JSON and Guile-Gcrypt are required by (guix docker).
     (with-extensions (list guile-json guile-gcrypt)
-      (with-imported-modules (source-module-closure '((guix docker)
-                                                      (guix build store-copy))
-                                                    #:select? not-config?)
+      (with-imported-modules `(((guix config) => ,(make-config.scm))
+                               ,@(source-module-closure
+                                  `((guix docker)
+                                    (guix build store-copy)
+                                    (guix profiles)
+                                    (guix search-paths))
+                                  #:select? not-config?))
         #~(begin
-            (use-modules (guix docker) (srfi srfi-19) (guix build store-copy))
+            (use-modules (guix docker) (guix build store-copy)
+                         (guix profiles) (guix search-paths)
+                         (srfi srfi-19) (ice-9 match))
+
+            (define environment
+              (map (match-lambda
+                     ((spec . value)
+                      (cons (search-path-specification-variable spec)
+                            value)))
+                   (profile-search-paths #$profile)))
 
             (setenv "PATH" (string-append #$archiver "/bin"))
 
@@ -455,6 +469,7 @@ the image."
                                 #$profile
                                 #:database #+database
                                 #:system (or #$target (utsname:machine (uname)))
+                                #:environment environment
                                 #:entry-point #$(and entry-point
                                                      #~(string-append #$profile "/"
                                                                       #$entry-point))
-- 
2.22.0

[bug#36469] [PATCH 2/2] pack: 'squashfs' backend records the profile's search paths.

[Ludovic Courtès]

From: Ludovic Courtès <ludovic.courtes@inria.fr>

* 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"
-- 
2.22.0

[bug#36469] [PATCH 2/2] pack: 'squashfs' backend records the profile's search paths.

[Ricardo Wurmus]

Ludovic Courtès <ludo@gnu.org> writes:

> From: Ludovic Courtès <ludovic.courtes@inria.fr>
>
> * 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.

This looks good to me.

I think it would be good to separate squashfs-image and singularity
going forward as we discussed earlier, but for now mixing the two is
fine.

Thanks!

--
Ricardo

[bug#36469] Name of the Singularity/squashfs backend?

[Ludovic Courtès]

Hi!

I’ve pushed these two patches, with an extra comment in the Docker test
as you suggested.

Ricardo Wurmus <rekado@elephly.net> skribis:

> I think it would be good to separate squashfs-image and singularity
> going forward as we discussed earlier, but for now mixing the two is
> fine.

So I was on the verge of renaming the ‘squashfs’ backend as a first
step, but I wasn’t sure about the name—naming is hard!

I thought about ‘singularity’, but that could be confused with SIF:

  https://github.com/sylabs/sif

Then I thought about ‘singularity-squashfs’: it’s unambiguous but a bit
long.

Another option is the status quo since both ‘--help’ and the manual
mention Singularity.

WDYT?

Ludo’.

[bug#36469] [PATCH 1/2] pack: 'docker' backend records the profile's search paths.

[Ricardo Wurmus]

Ludovic Courtès <ludo@gnu.org> writes:

> * gnu/tests/docker.scm (run-docker-test)["Load docker image and run it"]:
> Add example that expects (json) to be available.

This message here is clearer than the actual test.  In the test all that
JSON stuff is really only there to test that (json) is available, right?

Maybe it’s worth adding a comment to the test itself.

> diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
> index c90b777222..bb6a8cda1a 100644
> --- a/guix/scripts/pack.scm
> +++ b/guix/scripts/pack.scm
> @@ -27,6 +27,7 @@
>    #:use-module (guix utils)
>    #:use-module (guix store)
>    #:use-module ((guix status) #:select (with-status-verbosity))
> +  #:use-module ((guix self) #:select (make-config.scm))
>    #:use-module (guix grafts)
>    #:autoload   (guix inferior) (inferior-package?)
>    #:use-module (guix monads)
> @@ -440,11 +441,24 @@ the image."
>    (define build
>      ;; Guile-JSON and Guile-Gcrypt are required by (guix docker).
>      (with-extensions (list guile-json guile-gcrypt)
> -      (with-imported-modules (source-module-closure '((guix docker)
> -                                                      (guix build store-copy))
> -                                                    #:select? not-config?)
> +      (with-imported-modules `(((guix config) => ,(make-config.scm))
> +                               ,@(source-module-closure
> +                                  `((guix docker)
> +                                    (guix build store-copy)
> +                                    (guix profiles)
> +                                    (guix search-paths))
> +                                  #:select? not-config?))

Woah, that “=>” thing is to generate a module dynamically?  I hadn’t
seen this before.  Nifty!

The rest of this commit looks good to me.  Thanks for working on it!

-- 
Ricardo

[bug#36469] [PATCH 1/2] pack: 'docker' backend records the profile's search paths.

[Ludovic Courtès]

Ricardo Wurmus <rekado@elephly.net> skribis:

> Ludovic Courtès <ludo@gnu.org> writes:
>
>> * gnu/tests/docker.scm (run-docker-test)["Load docker image and run it"]:
>> Add example that expects (json) to be available.
>
> This message here is clearer than the actual test.  In the test all that
> JSON stuff is really only there to test that (json) is available, right?

Yes, it ensures GUILE_LOAD_PATH is properly set.

> Maybe it’s worth adding a comment to the test itself.

Looks like it; I’ll add a comment.

Thank you!

Ludo’.

[bug#36469] [PATCH 0/2] 'guix pack' records environment variables

[zimoun]

Hi,

That's awesome !

I have not tried the patch yet because I am not able to `git pull`
(issue with gnu.org NS and the network of my University, whatever!)
and my current version seems too old.


> The change for Singularity is similar.  I’ve tested it with an
> instance of Singularity 3.2.0.  Unfortunately, we still have 2.x
> in Guix and that doesn’t quite support the environment file, so I’ve
> chosen to punt on this one.

In `docker.scm` you replace %bootstrap-guile by guile-2.2, that's you
are talking about?
And now both `docker.scm` and `singularity.scm` are consistent to
guile-2.2 and there were not. :-)


Thank you again for the patch
simon

[bug#36469] [PATCH 0/2] 'guix pack' records environment variables

[Ludovic Courtès]

Hi,

zimoun <zimon.toutoune@gmail.com> skribis:

> That's awesome !

Glad you like it!

>> The change for Singularity is similar.  I’ve tested it with an
>> instance of Singularity 3.2.0.  Unfortunately, we still have 2.x
>> in Guix and that doesn’t quite support the environment file, so I’ve
>> chosen to punt on this one.
>
> In `docker.scm` you replace %bootstrap-guile by guile-2.2, that's you
> are talking about?

No no, I was talking about Singularity 2.x, not Guile 2.x.  :-)

Thanks for your feedback,
Ludo’.