GNU bug report logs - #36093
[PATCH 0/2] 'guix pack --entry-point' and Singularity service

Previous Next

Package: guix-patches;

Reported by: Ludovic Courtès <ludo <at> gnu.org>

Date: Tue, 4 Jun 2019 20:53:03 UTC

Severity: normal

Tags: patch

Done: Ludovic Courtès <ludo <at> gnu.org>

Bug is archived. No further changes may be made.

To add a comment to this bug, you must first unarchive it, by sending
a message to control AT debbugs.gnu.org, with unarchive 36093 in the body.
You can then email your comments to 36093 AT debbugs.gnu.org in the normal way.

Toggle the display of automated, internal messages from the tracker.

View this report as an mbox folder, status mbox, maintainer mbox


Report forwarded to guix-patches <at> gnu.org:
bug#36093; Package guix-patches. (Tue, 04 Jun 2019 20:53:03 GMT) Full text and rfc822 format available.

Acknowledgement sent to Ludovic Courtès <ludo <at> gnu.org>:
New bug report received and forwarded. Copy sent to guix-patches <at> gnu.org. (Tue, 04 Jun 2019 20:53:03 GMT) Full text and rfc822 format available.

Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: guix-patches <at> gnu.org
Cc: Ludovic Courtès <ludo <at> gnu.org>
Subject: [PATCH 0/2] 'guix pack --entry-point' and Singularity service
Date: Tue,  4 Jun 2019 22:51:51 +0200
Hello,

This patch adds a ‘--entry-point’ flag to ‘guix pack’, which I think
is long overdue.

It also adds a Singularity service whose primary purpose is to allow
us to test ‘guix pack -f squashfs’.  (It would be nice to have
Singularity 3.x for testing purposes.)

Thoughts?

Ludo’.

Ludovic Courtès (2):
  services: Add Singularity.
  pack: Add '--entry-point'.

 doc/guix.texi             |  36 +++++++++-
 gnu/local.mk              |   1 +
 gnu/packages/linux.scm    |  10 ++-
 gnu/services/docker.scm   |  53 ++++++++++++++-
 gnu/tests/docker.scm      |  19 ++++--
 gnu/tests/singularity.scm | 137 ++++++++++++++++++++++++++++++++++++++
 guix/scripts/pack.scm     |  41 ++++++++++++
 7 files changed, 285 insertions(+), 12 deletions(-)
 create mode 100644 gnu/tests/singularity.scm

-- 
2.21.0





Information forwarded to guix-patches <at> gnu.org:
bug#36093; Package guix-patches. (Tue, 04 Jun 2019 21:02:02 GMT) Full text and rfc822 format available.

Message #8 received at 36093 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: 36093 <at> debbugs.gnu.org
Cc: Ludovic Courtès <ludovic.courtes <at> inria.fr>
Subject: [PATCH 1/2] services: Add Singularity.
Date: Tue,  4 Jun 2019 23:01:14 +0200
From: Ludovic Courtès <ludovic.courtes <at> inria.fr>

* gnu/packages/linux.scm (singularity)[source](snippet): Change file
name of setuid helpers in libexec/cli/*.exec.
[arguments]: Remove "--disable-suid".
* gnu/services/docker.scm (%singularity-activation): New variable.
(singularity-setuid-programs): New procedure.
(singularity-service-type): New variable.
* gnu/tests/singularity.scm: New file.
* gnu/local.mk (GNU_SYSTEM_MODULES): Add it.
* doc/guix.texi (Miscellaneous Services): Document it.
---
 doc/guix.texi             |  13 +++-
 gnu/local.mk              |   1 +
 gnu/packages/linux.scm    |  10 ++-
 gnu/services/docker.scm   |  53 +++++++++++++++-
 gnu/tests/singularity.scm | 128 ++++++++++++++++++++++++++++++++++++++
 5 files changed, 200 insertions(+), 5 deletions(-)
 create mode 100644 gnu/tests/singularity.scm

diff --git a/doc/guix.texi b/doc/guix.texi
index a8f3a5ad27..2189f297bd 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -24090,7 +24090,7 @@ The following is an example @code{dicod-service} configuration.
 @cindex Docker
 @subsubheading Docker Service
 
-The @code{(gnu services docker)} module provides the following service.
+The @code{(gnu services docker)} module provides the following services.
 
 @defvr {Scheme Variable} docker-service-type
 
@@ -24114,6 +24114,17 @@ The Containerd package to use.
 @end table
 @end deftp
 
+@defvr {Scheme Variable} singularity-service-type
+This is the type of the service that runs
+@url{https://www.sylabs.io/singularity/, Singularity}, a Docker-style tool to
+create and run application bundles (aka. ``containers'').  The value for this
+service is the Singularity package to use.
+
+The service does not install a daemon; instead, it installs helper programs as
+setuid-root (@pxref{Setuid Programs}) such that unprivileged users can invoke
+@command{singularity run} and similar commands.
+@end defvr
+
 @node Setuid Programs
 @section Setuid Programs
 
diff --git a/gnu/local.mk b/gnu/local.mk
index b0992547b4..251c1eab64 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -586,6 +586,7 @@ GNU_SYSTEM_MODULES =				\
   %D%/tests/networking.scm			\
   %D%/tests/rsync.scm				\
   %D%/tests/security-token.scm			\
+  %D%/tests/singularity.scm			\
   %D%/tests/ssh.scm				\
   %D%/tests/version-control.scm			\
   %D%/tests/virtualization.scm			\
diff --git a/gnu/packages/linux.scm b/gnu/packages/linux.scm
index ef45465288..4997fac181 100644
--- a/gnu/packages/linux.scm
+++ b/gnu/packages/linux.scm
@@ -2884,12 +2884,16 @@ thanks to the use of namespaces.")
                   (substitute* "bin/singularity.in"
                     (("^PATH=.*" all)
                      (string-append "#" all "\n")))
+
+                  (substitute* (find-files "libexec/cli" "\\.exec$")
+                    (("\\$SINGULARITY_libexecdir/singularity/bin/([a-z]+)-suid"
+                      _ program)
+                     (string-append "/run/setuid-programs/singularity-"
+                                    program "-helper")))
                   #t))))
     (build-system gnu-build-system)
     (arguments
-     `(#:configure-flags
-       (list "--disable-suid"
-             "--localstatedir=/var")
+     `(#:configure-flags '("--localstatedir=/var")
        #:phases
        (modify-phases %standard-phases
          (add-after 'unpack 'patch-reference-to-squashfs-tools
diff --git a/gnu/services/docker.scm b/gnu/services/docker.scm
index 94a04c8996..b245513913 100644
--- a/gnu/services/docker.scm
+++ b/gnu/services/docker.scm
@@ -24,12 +24,14 @@
   #:use-module (gnu services shepherd)
   #:use-module (gnu system shadow)
   #:use-module (gnu packages docker)
+  #:use-module (gnu packages linux)               ;singularity
   #:use-module (guix records)
   #:use-module (guix gexp)
   #:use-module (guix packages)
 
   #:export (docker-configuration
-            docker-service-type))
+            docker-service-type
+            singularity-service-type))
 
 ;;; We're not using serialize-configuration, but we must define this because
 ;;; the define-configuration macro validates it exists.
@@ -120,3 +122,52 @@ bundles in Docker containers.")
                   (service-extension account-service-type
                                      (const %docker-accounts))))
                 (default-value (docker-configuration))))
+
+
+;;;
+;;; Singularity.
+;;;
+
+(define %singularity-activation
+  (with-imported-modules '((guix build utils))
+    #~(begin
+        (use-modules (guix build utils))
+
+        ;; Create the directories that Singularity 2.6 expects to find.
+        (for-each (lambda (directory)
+                    (mkdir-p (string-append "/var/singularity/mnt/"
+                                            directory)))
+                  '("container" "final" "overlay" "session")))))
+
+(define (singularity-setuid-programs singularity)
+  "Return the setuid-root programs that SINGULARITY needs."
+  (define helpers
+    ;; The helpers, under a meaningful name.
+    (computed-file "singularity-setuid-helpers"
+                   #~(begin
+                       (mkdir #$output)
+                       (for-each (lambda (program)
+                                   (symlink (string-append #$singularity
+                                                           "/libexec/singularity"
+                                                           "/bin/"
+                                                           program "-suid")
+                                            (string-append #$output
+                                                           "/singularity-"
+                                                           program
+                                                           "-helper")))
+                                 '("action" "mount" "start")))))
+
+  (list (file-append helpers "/singularity-action-helper")
+        (file-append helpers "/singularity-mount-helper")
+        (file-append helpers "/singularity-start-helper")))
+
+(define singularity-service-type
+  (service-type (name 'singularity)
+                (description
+                 "Install the Singularity application bundle tool.")
+                (extensions
+                 (list (service-extension setuid-program-service-type
+                                          singularity-setuid-programs)
+                       (service-extension activation-service-type
+                                          (const %singularity-activation))))
+                (default-value singularity)))
diff --git a/gnu/tests/singularity.scm b/gnu/tests/singularity.scm
new file mode 100644
index 0000000000..55324ef9ea
--- /dev/null
+++ b/gnu/tests/singularity.scm
@@ -0,0 +1,128 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2019 Ludovic Courtès <ludo <at> gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu tests singularity)
+  #:use-module (gnu tests)
+  #:use-module (gnu system)
+  #:use-module (gnu system vm)
+  #:use-module (gnu system shadow)
+  #:use-module (gnu services)
+  #:use-module (gnu services docker)
+  #:use-module (gnu packages bash)
+  #:use-module (gnu packages guile)
+  #:use-module (gnu packages linux)               ;singularity
+  #:use-module (guix gexp)
+  #:use-module (guix store)
+  #:use-module (guix grafts)
+  #:use-module (guix monads)
+  #:use-module (guix packages)
+  #:use-module (guix profiles)
+  #:use-module (guix scripts pack)
+  #:export (%test-singularity))
+
+(define %singularity-os
+  (simple-operating-system
+   (service singularity-service-type)
+   (simple-service 'guest-account
+                   account-service-type
+                   (list (user-account (name "guest") (uid 1000) (group "guest"))
+                         (user-group (name "guest") (id 1000))))))
+
+(define (run-singularity-test image)
+  "Load IMAGE, a Squashfs image, as a Singularity image and run it inside
+%SINGULARITY-OS."
+  (define os
+    (marionette-operating-system %singularity-os))
+
+  (define singularity-exec
+    #~(begin
+        (use-modules (ice-9 popen) (rnrs io ports))
+
+        (let* ((pipe (open-pipe* OPEN_READ
+                                 #$(file-append singularity
+                                                "/bin/singularity")
+                                 "exec" #$image "/bin/guile"
+                                 "-c" "(display \"hello, world\")"))
+               (str  (get-string-all pipe))
+               (status (close-pipe pipe)))
+          (and (zero? status)
+               (string=? str "hello, world")))))
+
+  (define test
+    (with-imported-modules '((gnu build marionette))
+      #~(begin
+          (use-modules (srfi srfi-11) (srfi srfi-64)
+                       (gnu build marionette))
+
+          (define marionette
+            (make-marionette (list #$(virtual-machine os))))
+
+          (mkdir #$output)
+          (chdir #$output)
+
+          (test-begin "singularity")
+
+          (test-assert "singularity exec /bin/guile (as root)"
+            (marionette-eval '#$singularity-exec
+                             marionette))
+
+          (test-equal "singularity exec /bin/guile (unprivileged)"
+            0
+            (marionette-eval
+             `(begin
+                (use-modules (ice-9 match))
+
+                (match (primitive-fork)
+                  (0
+                   (dynamic-wind
+                     (const #f)
+                     (lambda ()
+                       (setgid 1000)
+                       (setuid 1000)
+                       (execl #$(program-file "singularity-exec-test"
+                                              #~(exit #$singularity-exec))
+                              "test"))
+                     (lambda ()
+                       (primitive-exit 127))))
+                  (pid
+                   (cdr (waitpid pid)))))
+             marionette))
+
+          (test-end)
+          (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+  (gexp->derivation "singularity-test" test))
+
+(define (build-tarball&run-singularity-test)
+  (mlet* %store-monad
+      ((_        (set-grafting #f))
+       (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))
+                                     #:hooks '()
+                                     #:locales? #f))
+       (tarball  (squashfs-image "singularity-pack" profile
+                                 #:symlinks '(("/bin" -> "bin")))))
+    (run-singularity-test tarball)))
+
+(define %test-singularity
+  (system-test
+   (name "singularity")
+   (description "Test Singularity container of Guix.")
+   (value (build-tarball&run-singularity-test))))
-- 
2.21.0





Information forwarded to guix-patches <at> gnu.org:
bug#36093; Package guix-patches. (Tue, 04 Jun 2019 21:02:03 GMT) Full text and rfc822 format available.

Message #11 received at 36093 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: 36093 <at> debbugs.gnu.org
Cc: Ludovic Courtès <ludovic.courtes <at> inria.fr>
Subject: [PATCH 2/2] pack: Add '--entry-point'.
Date: Tue,  4 Jun 2019 23:01:15 +0200
From: Ludovic Courtès <ludovic.courtes <at> inria.fr>

* guix/scripts/pack.scm (self-contained-tarball): Add #:entry-point and
warn when it's true.
(squashfs-image): Add #:entry-point and honor it.
(docker-image): Add #:entry-point and honor it.
(%options, show-help): Add '--entry-point'.
(guix-pack): Honor '--entry-point' and pass #:entry-point to BUILD-IMAGE.
* gnu/tests/docker.scm (run-docker-test): Test 'docker run' with the
default entry point.
(build-tarball&run-docker-test): Pass #:entry-point to 'docker-image'.
* doc/guix.texi (Invoking guix pack): Document it.
* gnu/tests/singularity.scm (run-singularity-test)["singularity run"]:
New test.
(build-tarball&run-singularity-test): Pass #:entry-point to
'squashfs-image'.
---
 doc/guix.texi             | 23 ++++++++++++++++++++++
 gnu/tests/docker.scm      | 19 +++++++++++-------
 gnu/tests/singularity.scm |  9 +++++++++
 guix/scripts/pack.scm     | 41 +++++++++++++++++++++++++++++++++++++++
 4 files changed, 85 insertions(+), 7 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 2189f297bd..37af0ebd83 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -4866,6 +4866,29 @@ advantage to work without requiring special kernel support, but it incurs
 run-time overhead every time a system call is made.
 @end quotation
 
+@cindex entry point, for Docker images
+@item --entry-point=@var{command}
+Use @var{command} as the @dfn{entry point} of the resulting pack, if the pack
+format supports it---currently @code{docker} and @code{squashfs} (Singularity)
+support it.  @var{command} must be relative to the profile contained in the
+pack.
+
+The entry point specifies the command that tools like @code{docker run} or
+@code{singularity run} automatically start by default.  For example, you can
+do:
+
+@example
+guix pack -f docker --entry-point=bin/guile guile
+@end example
+
+The resulting pack can easily be loaded and @code{docker run} with no extra
+arguments will spawn @code{bin/guile}:
+
+@example
+docker load -i pack.tar.gz
+docker run @var{image-id}
+@end example
+
 @item --expression=@var{expr}
 @itemx -e @var{expr}
 Consider the package @var{expr} evaluates to.
diff --git a/gnu/tests/docker.scm b/gnu/tests/docker.scm
index 3cd3a27884..f2674cdbe8 100644
--- a/gnu/tests/docker.scm
+++ b/gnu/tests/docker.scm
@@ -101,7 +101,7 @@ inside %DOCKER-OS."
              marionette))
 
           (test-equal "Load docker image and run it"
-            "hello world"
+            '("hello world" "hi!")
             (marionette-eval
              `(begin
                 (define slurp
@@ -117,12 +117,16 @@ inside %DOCKER-OS."
                        (repository&tag (string-drop raw-line
                                                     (string-length
                                                      "Loaded image: ")))
-                       (response (slurp
-                                  ,(string-append #$docker-cli "/bin/docker")
-                                  "run" "--entrypoint" "bin/Guile"
-                                  repository&tag
-                                  "/aa.scm")))
-                  response))
+                       (response1 (slurp
+                                   ,(string-append #$docker-cli "/bin/docker")
+                                   "run" "--entrypoint" "bin/Guile"
+                                   repository&tag
+                                   "/aa.scm"))
+                       (response2 (slurp          ;default entry point
+                                   ,(string-append #$docker-cli "/bin/docker")
+                                   "run" repository&tag
+                                   "-c" "(display \"hi!\")")))
+                  (list response1 response2)))
              marionette))
 
           (test-end)
@@ -161,6 +165,7 @@ standard output device and then enters a new line.")
        (tarball (docker-image "docker-pack" profile
                               #:symlinks '(("/bin/Guile" -> "bin/guile")
                                            ("aa.scm" -> "a.scm"))
+                              #:entry-point "bin/guile"
                               #:localstatedir? #t)))
     (run-docker-test tarball)))
 
diff --git a/gnu/tests/singularity.scm b/gnu/tests/singularity.scm
index 55324ef9ea..668043a0bc 100644
--- a/gnu/tests/singularity.scm
+++ b/gnu/tests/singularity.scm
@@ -103,6 +103,14 @@
                    (cdr (waitpid pid)))))
              marionette))
 
+          (test-equal "singularity run"           ;test the entry point
+            42
+            (marionette-eval
+             `(status:exit-val
+               (system* #$(file-append singularity "/bin/singularity")
+                        "run" #$image "-c" "(exit 42)"))
+             marionette))
+
           (test-end)
           (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
 
@@ -118,6 +126,7 @@
                                      #:hooks '()
                                      #:locales? #f))
        (tarball  (squashfs-image "singularity-pack" profile
+                                 #:entry-point "bin/guile"
                                  #:symlinks '(("/bin" -> "bin")))))
     (run-singularity-test tarball)))
 
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index c17b374330..5da23e038b 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -152,6 +152,7 @@ dependencies are registered."
                                  #:key target
                                  (profile-name "guix-profile")
                                  deduplicate?
+                                 entry-point
                                  (compressor (first %compressors))
                                  localstatedir?
                                  (symlinks '())
@@ -275,6 +276,10 @@ added to the pack."
                                           (_ #f))
                                         directives)))))))))
 
+  (when entry-point
+    (warning (G_ "entry point not supported in the '~a' format~%")
+             'tarball))
+
   (gexp->derivation (string-append name ".tar"
                                    (compressor-extension compressor))
                     build
@@ -284,6 +289,7 @@ added to the pack."
                          #:key target
                          (profile-name "guix-profile")
                          (compressor (first %compressors))
+                         entry-point
                          localstatedir?
                          (symlinks '())
                          (archiver squashfs-tools-next))
@@ -315,6 +321,7 @@ added to the pack."
                        (ice-9 match))
 
           (define database #+database)
+          (define entry-point #$entry-point)
 
           (setenv "PATH" (string-append #$archiver "/bin"))
 
@@ -371,6 +378,28 @@ added to the pack."
                                                             target)))))))
                       '#$symlinks)
 
+                   ;; 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"
+                           ,(string-append
+                             "/.singularity.d/actions/run s 777 0 0 "
+                             (relative-file-name "/.singularity.d/actions"
+                                                 (string-append #$profile "/"
+                                                                entry-point)))
+
+                           ;; This one is for Singularity 3.x.
+                           "-p"
+                           ,(string-append
+                             "/.singularity.d/runscript s 777 0 0 "
+                             (relative-file-name "/.singularity.d"
+                                                 (string-append #$profile "/"
+                                                                entry-point))))
+                         '())
+
                    ;; Create empty mount points.
                    "-p" "/proc d 555 0 0"
                    "-p" "/sys d 555 0 0"
@@ -392,6 +421,7 @@ added to the pack."
                        #:key target
                        (profile-name "guix-profile")
                        (compressor (first %compressors))
+                       entry-point
                        localstatedir?
                        (symlinks '())
                        (archiver tar))
@@ -425,6 +455,8 @@ the image."
                                 #$profile
                                 #:database #+database
                                 #:system (or #$target (utsname:machine (uname)))
+                                #:entry-point (string-append #$profile "/"
+                                                             #$entry-point)
                                 #:symlinks '#$symlinks
                                 #:compressor '#$(compressor-command compressor)
                                 #:creation-time (make-time time-utc 0 1))))))
@@ -689,6 +721,9 @@ please email '~a'~%")
                  (lambda (opt name arg result)
                    (alist-cons 'system arg
                                (alist-delete 'system result eq?))))
+         (option '("entry-point") #t #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'entry-point arg result)))
          (option '("target") #t #f
                  (lambda (opt name arg result)
                    (alist-cons 'target arg
@@ -765,6 +800,9 @@ Create a bundle of PACKAGE.\n"))
   -S, --symlink=SPEC     create symlinks to the profile according to SPEC"))
   (display (G_ "
   -m, --manifest=FILE    create a pack with the manifest from FILE"))
+  (display (G_ "
+      --entry-point=PROGRAM
+                         use PROGRAM as the entry point of the pack"))
   (display (G_ "
       --save-provenance  save provenance information"))
   (display (G_ "
@@ -889,6 +927,7 @@ Create a bundle of PACKAGE.\n"))
                                  (leave (G_ "~a: unknown pack format~%")
                                         pack-format))))
                  (localstatedir? (assoc-ref opts 'localstatedir?))
+                 (entry-point    (assoc-ref opts 'entry-point))
                  (profile-name   (assoc-ref opts 'profile-name))
                  (gc-root        (assoc-ref opts 'gc-root)))
             (when (null? (manifest-entries manifest))
@@ -919,6 +958,8 @@ Create a bundle of PACKAGE.\n"))
                                                      symlinks
                                                      #:localstatedir?
                                                      localstatedir?
+                                                     #:entry-point
+                                                     entry-point
                                                      #:profile-name
                                                      profile-name
                                                      #:archiver
-- 
2.21.0





Information forwarded to guix-patches <at> gnu.org:
bug#36093; Package guix-patches. (Wed, 05 Jun 2019 15:03:02 GMT) Full text and rfc822 format available.

Message #14 received at 36093 <at> debbugs.gnu.org (full text, mbox):

From: Danny Milosavljevic <dannym <at> scratchpost.org>
To: Ludovic Courtès <ludo <at> gnu.org>
Cc: Ludovic Courtès <ludovic.courtes <at> inria.fr>,
 36093 <at> debbugs.gnu.org
Subject: Re: [bug#36093] [PATCH 1/2] services: Add Singularity.
Date: Wed, 5 Jun 2019 17:02:17 +0200
[Message part 1 (text/plain, inline)]
Hi Ludo,

On Tue,  4 Jun 2019 23:01:14 +0200
Ludovic Courtès <ludo <at> gnu.org> wrote:

> +@defvr {Scheme Variable} singularity-service-type
> +This is the type of the service that runs
> +@url{https://www.sylabs.io/singularity/, Singularity}, 

Does it?
Doesn't it just "allow you to invoke"?

> +                  (substitute* (find-files "libexec/cli" "\\.exec$")
> +                    (("\\$SINGULARITY_libexecdir/singularity/bin/([a-z]+)-suid"
> +                      _ program)
> +                     (string-append "/run/setuid-programs/singularity-"
> +                                    program "-helper")))

Is absolute path OK?  There have been some efforts to get guix to relocate in
the past.  Does this apply here?

> +        ;; Create the directories that Singularity 2.6 expects to find.
> +        (for-each (lambda (directory)
> +                    (mkdir-p (string-append "/var/singularity/mnt/"
> +                                            directory)))
> +                  '("container" "final" "overlay" "session")))))

Are permissions OK?

LGTM!
[Message part 2 (application/pgp-signature, inline)]

Information forwarded to guix-patches <at> gnu.org:
bug#36093; Package guix-patches. (Wed, 05 Jun 2019 15:07:02 GMT) Full text and rfc822 format available.

Message #17 received at 36093 <at> debbugs.gnu.org (full text, mbox):

From: Danny Milosavljevic <dannym <at> scratchpost.org>
To: Ludovic Courtès <ludo <at> gnu.org>
Cc: Ludovic Courtès <ludovic.courtes <at> inria.fr>,
 36093 <at> debbugs.gnu.org
Subject: Re: [bug#36093] [PATCH 2/2] pack: Add '--entry-point'.
Date: Wed, 5 Jun 2019 17:06:53 +0200
[Message part 1 (text/plain, inline)]
Hi Ludo,

On Tue,  4 Jun 2019 23:01:15 +0200
Ludovic Courtès <ludo <at> gnu.org> wrote:
> +                   ,@(if entry-point
> +                         `(;; This one if for Singularity 2.x.
> +                           "-p"
> +                           ,(string-append
> +                             "/.singularity.d/actions/run s 777 0 0 "
> +                             (relative-file-name "/.singularity.d/actions"
> +                                                 (string-append #$profile "/"
> +                                                                entry-point)))
> +
> +                           ;; This one is for Singularity 3.x.
> +                           "-p"
> +                           ,(string-append
> +                             "/.singularity.d/runscript s 777 0 0 "
> +                             (relative-file-name "/.singularity.d"
> +                                                 (string-append #$profile "/"
> +                                                                entry-point))))

Hmm, 777 (anyone can write)?  It it necessary?

Also, in general, do we conflate "squashfs" and "singularity"?  It has been
that way in guix/scripts/pack.scm's squashfs-image before this patch already
and a few extra files can't hurt, but we could also just provide a
function "singularity-image" or something.

LGTM!
[Message part 2 (application/pgp-signature, inline)]

Information forwarded to guix-patches <at> gnu.org:
bug#36093; Package guix-patches. (Wed, 05 Jun 2019 20:25:01 GMT) Full text and rfc822 format available.

Message #20 received at 36093 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: Danny Milosavljevic <dannym <at> scratchpost.org>
Cc: 36093 <at> debbugs.gnu.org
Subject: Re: [bug#36093] [PATCH 1/2] services: Add Singularity.
Date: Wed, 05 Jun 2019 22:24:05 +0200
Hi Danny,

Danny Milosavljevic <dannym <at> scratchpost.org> skribis:

> On Tue,  4 Jun 2019 23:01:14 +0200
> Ludovic Courtès <ludo <at> gnu.org> wrote:
>
>> +@defvr {Scheme Variable} singularity-service-type
>> +This is the type of the service that runs
>> +@url{https://www.sylabs.io/singularity/, Singularity}, 
>
> Does it?
> Doesn't it just "allow you to invoke"?

Yes, you’re right.  I’ll reword as you suggest.

>> +                  (substitute* (find-files "libexec/cli" "\\.exec$")
>> +                    (("\\$SINGULARITY_libexecdir/singularity/bin/([a-z]+)-suid"
>> +                      _ program)
>> +                     (string-append "/run/setuid-programs/singularity-"
>> +                                    program "-helper")))
>
> Is absolute path OK?  There have been some efforts to get guix to relocate in
> the past.  Does this apply here?

I think it’s OK: those setuid helpers can only be used on Guix System,
not on a foreign distro, and it goes hand-in-hand with
‘singularity-service-type’.

>> +        ;; Create the directories that Singularity 2.6 expects to find.
>> +        (for-each (lambda (directory)
>> +                    (mkdir-p (string-append "/var/singularity/mnt/"
>> +                                            directory)))
>> +                  '("container" "final" "overlay" "session")))))
>
> Are permissions OK?

They’re good enough for the test, but perhaps it should be #o700.
I’ll check if it works like that.

There’s been a nice CVE for Singularity 3.x in this area recently:

  https://nvd.nist.gov/vuln/detail/CVE-2019-11328

It’s not directly applicable here but there could be similar issues.

Thanks,
Ludo’.




Information forwarded to guix-patches <at> gnu.org:
bug#36093; Package guix-patches. (Wed, 05 Jun 2019 20:28:02 GMT) Full text and rfc822 format available.

Message #23 received at 36093 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: Danny Milosavljevic <dannym <at> scratchpost.org>
Cc: Ricardo Wurmus <ricardo.wurmus <at> mdc-berlin.de>, 36093 <at> debbugs.gnu.org
Subject: Re: [bug#36093] [PATCH 2/2] pack: Add '--entry-point'.
Date: Wed, 05 Jun 2019 22:27:27 +0200
Hello,

Danny Milosavljevic <dannym <at> scratchpost.org> skribis:

> On Tue,  4 Jun 2019 23:01:15 +0200
> Ludovic Courtès <ludo <at> gnu.org> wrote:
>> +                   ,@(if entry-point
>> +                         `(;; This one if for Singularity 2.x.
>> +                           "-p"
>> +                           ,(string-append
>> +                             "/.singularity.d/actions/run s 777 0 0 "
>> +                             (relative-file-name "/.singularity.d/actions"
>> +                                                 (string-append #$profile "/"
>> +                                                                entry-point)))
>> +
>> +                           ;; This one is for Singularity 3.x.
>> +                           "-p"
>> +                           ,(string-append
>> +                             "/.singularity.d/runscript s 777 0 0 "
>> +                             (relative-file-name "/.singularity.d"
>> +                                                 (string-append #$profile "/"
>> +                                                                entry-point))))
>
> Hmm, 777 (anyone can write)?  It it necessary?

For a symlink it doesn’t matter, AIUI.

> Also, in general, do we conflate "squashfs" and "singularity"?  It has been
> that way in guix/scripts/pack.scm's squashfs-image before this patch already
> and a few extra files can't hurt, but we could also just provide a
> function "singularity-image" or something.

Yes, we do conflate Singularity and Squashfs, but I think there’s no
other “container tool” that uses Squashfs anyway.

We could rename it to “singularity”, but it turns out Singularity 3.x
has its own image format unimaginatively called SIF, so perhaps we’re
better off with the status quo.

Thoughts?  Ricardo?

Thanks,
Ludo’.




Information forwarded to guix-patches <at> gnu.org:
bug#36093; Package guix-patches. (Thu, 06 Jun 2019 11:04:01 GMT) Full text and rfc822 format available.

Message #26 received at 36093 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: 36093 <at> debbugs.gnu.org
Cc: Ludovic Courtès <ludovic.courtes <at> inria.fr>
Subject: [PATCH v2 1/2] services: Add Singularity.
Date: Thu,  6 Jun 2019 13:03:05 +0200
From: Ludovic Courtès <ludovic.courtes <at> inria.fr>

* gnu/packages/linux.scm (singularity)[source](snippet): Change file
name of setuid helpers in libexec/cli/*.exec.
[arguments]: Remove "--disable-suid".
* gnu/services/docker.scm (%singularity-activation): New variable.
(singularity-setuid-programs): New procedure.
(singularity-service-type): New variable.
* gnu/tests/singularity.scm: New file.
* gnu/local.mk (GNU_SYSTEM_MODULES): Add it.
* doc/guix.texi (Miscellaneous Services): Document it.
---
 doc/guix.texi             |  13 +++-
 gnu/local.mk              |   1 +
 gnu/packages/linux.scm    |  10 ++-
 gnu/services/docker.scm   |  61 +++++++++++++++++-
 gnu/tests/singularity.scm | 128 ++++++++++++++++++++++++++++++++++++++
 5 files changed, 208 insertions(+), 5 deletions(-)
 create mode 100644 gnu/tests/singularity.scm

diff --git a/doc/guix.texi b/doc/guix.texi
index 996255d9dc..c89df4ade3 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -24090,7 +24090,7 @@ The following is an example @code{dicod-service} configuration.
 @cindex Docker
 @subsubheading Docker Service
 
-The @code{(gnu services docker)} module provides the following service.
+The @code{(gnu services docker)} module provides the following services.
 
 @defvr {Scheme Variable} docker-service-type
 
@@ -24114,6 +24114,17 @@ The Containerd package to use.
 @end table
 @end deftp
 
+@defvr {Scheme Variable} singularity-service-type
+This is the type of the service that allows you to run
+@url{https://www.sylabs.io/singularity/, Singularity}, a Docker-style tool to
+create and run application bundles (aka. ``containers'').  The value for this
+service is the Singularity package to use.
+
+The service does not install a daemon; instead, it installs helper programs as
+setuid-root (@pxref{Setuid Programs}) such that unprivileged users can invoke
+@command{singularity run} and similar commands.
+@end defvr
+
 @node Setuid Programs
 @section Setuid Programs
 
diff --git a/gnu/local.mk b/gnu/local.mk
index 6878aef44a..c61ccff5e8 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -586,6 +586,7 @@ GNU_SYSTEM_MODULES =				\
   %D%/tests/networking.scm			\
   %D%/tests/rsync.scm				\
   %D%/tests/security-token.scm			\
+  %D%/tests/singularity.scm			\
   %D%/tests/ssh.scm				\
   %D%/tests/version-control.scm			\
   %D%/tests/virtualization.scm			\
diff --git a/gnu/packages/linux.scm b/gnu/packages/linux.scm
index ffc5e9736e..e3cf2d729c 100644
--- a/gnu/packages/linux.scm
+++ b/gnu/packages/linux.scm
@@ -2884,12 +2884,16 @@ thanks to the use of namespaces.")
                   (substitute* "bin/singularity.in"
                     (("^PATH=.*" all)
                      (string-append "#" all "\n")))
+
+                  (substitute* (find-files "libexec/cli" "\\.exec$")
+                    (("\\$SINGULARITY_libexecdir/singularity/bin/([a-z]+)-suid"
+                      _ program)
+                     (string-append "/run/setuid-programs/singularity-"
+                                    program "-helper")))
                   #t))))
     (build-system gnu-build-system)
     (arguments
-     `(#:configure-flags
-       (list "--disable-suid"
-             "--localstatedir=/var")
+     `(#:configure-flags '("--localstatedir=/var")
        #:phases
        (modify-phases %standard-phases
          (add-after 'unpack 'patch-reference-to-squashfs-tools
diff --git a/gnu/services/docker.scm b/gnu/services/docker.scm
index 94a04c8996..04f9127346 100644
--- a/gnu/services/docker.scm
+++ b/gnu/services/docker.scm
@@ -24,12 +24,14 @@
   #:use-module (gnu services shepherd)
   #:use-module (gnu system shadow)
   #:use-module (gnu packages docker)
+  #:use-module (gnu packages linux)               ;singularity
   #:use-module (guix records)
   #:use-module (guix gexp)
   #:use-module (guix packages)
 
   #:export (docker-configuration
-            docker-service-type))
+            docker-service-type
+            singularity-service-type))
 
 ;;; We're not using serialize-configuration, but we must define this because
 ;;; the define-configuration macro validates it exists.
@@ -120,3 +122,60 @@ bundles in Docker containers.")
                   (service-extension account-service-type
                                      (const %docker-accounts))))
                 (default-value (docker-configuration))))
+
+
+;;;
+;;; Singularity.
+;;;
+
+(define %singularity-activation
+  (with-imported-modules '((guix build utils))
+    #~(begin
+        (use-modules (guix build utils))
+
+        (define %mount-directory
+          "/var/singularity/mnt/")
+
+        ;; Create the directories that Singularity 2.6 expects to find.  Make
+        ;; them #o755 like the 'install-data-hook' rule in 'Makefile.am' of
+        ;; Singularity 2.6.1.
+        (for-each (lambda (directory)
+                    (let ((directory (string-append %mount-directory
+                                                    directory)))
+                      (mkdir-p directory)
+                      (chmod directory #o755)))
+                  '("container" "final" "overlay" "session"))
+        (chmod %mount-directory #o755))))
+
+(define (singularity-setuid-programs singularity)
+  "Return the setuid-root programs that SINGULARITY needs."
+  (define helpers
+    ;; The helpers, under a meaningful name.
+    (computed-file "singularity-setuid-helpers"
+                   #~(begin
+                       (mkdir #$output)
+                       (for-each (lambda (program)
+                                   (symlink (string-append #$singularity
+                                                           "/libexec/singularity"
+                                                           "/bin/"
+                                                           program "-suid")
+                                            (string-append #$output
+                                                           "/singularity-"
+                                                           program
+                                                           "-helper")))
+                                 '("action" "mount" "start")))))
+
+  (list (file-append helpers "/singularity-action-helper")
+        (file-append helpers "/singularity-mount-helper")
+        (file-append helpers "/singularity-start-helper")))
+
+(define singularity-service-type
+  (service-type (name 'singularity)
+                (description
+                 "Install the Singularity application bundle tool.")
+                (extensions
+                 (list (service-extension setuid-program-service-type
+                                          singularity-setuid-programs)
+                       (service-extension activation-service-type
+                                          (const %singularity-activation))))
+                (default-value singularity)))
diff --git a/gnu/tests/singularity.scm b/gnu/tests/singularity.scm
new file mode 100644
index 0000000000..55324ef9ea
--- /dev/null
+++ b/gnu/tests/singularity.scm
@@ -0,0 +1,128 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2019 Ludovic Courtès <ludo <at> gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu tests singularity)
+  #:use-module (gnu tests)
+  #:use-module (gnu system)
+  #:use-module (gnu system vm)
+  #:use-module (gnu system shadow)
+  #:use-module (gnu services)
+  #:use-module (gnu services docker)
+  #:use-module (gnu packages bash)
+  #:use-module (gnu packages guile)
+  #:use-module (gnu packages linux)               ;singularity
+  #:use-module (guix gexp)
+  #:use-module (guix store)
+  #:use-module (guix grafts)
+  #:use-module (guix monads)
+  #:use-module (guix packages)
+  #:use-module (guix profiles)
+  #:use-module (guix scripts pack)
+  #:export (%test-singularity))
+
+(define %singularity-os
+  (simple-operating-system
+   (service singularity-service-type)
+   (simple-service 'guest-account
+                   account-service-type
+                   (list (user-account (name "guest") (uid 1000) (group "guest"))
+                         (user-group (name "guest") (id 1000))))))
+
+(define (run-singularity-test image)
+  "Load IMAGE, a Squashfs image, as a Singularity image and run it inside
+%SINGULARITY-OS."
+  (define os
+    (marionette-operating-system %singularity-os))
+
+  (define singularity-exec
+    #~(begin
+        (use-modules (ice-9 popen) (rnrs io ports))
+
+        (let* ((pipe (open-pipe* OPEN_READ
+                                 #$(file-append singularity
+                                                "/bin/singularity")
+                                 "exec" #$image "/bin/guile"
+                                 "-c" "(display \"hello, world\")"))
+               (str  (get-string-all pipe))
+               (status (close-pipe pipe)))
+          (and (zero? status)
+               (string=? str "hello, world")))))
+
+  (define test
+    (with-imported-modules '((gnu build marionette))
+      #~(begin
+          (use-modules (srfi srfi-11) (srfi srfi-64)
+                       (gnu build marionette))
+
+          (define marionette
+            (make-marionette (list #$(virtual-machine os))))
+
+          (mkdir #$output)
+          (chdir #$output)
+
+          (test-begin "singularity")
+
+          (test-assert "singularity exec /bin/guile (as root)"
+            (marionette-eval '#$singularity-exec
+                             marionette))
+
+          (test-equal "singularity exec /bin/guile (unprivileged)"
+            0
+            (marionette-eval
+             `(begin
+                (use-modules (ice-9 match))
+
+                (match (primitive-fork)
+                  (0
+                   (dynamic-wind
+                     (const #f)
+                     (lambda ()
+                       (setgid 1000)
+                       (setuid 1000)
+                       (execl #$(program-file "singularity-exec-test"
+                                              #~(exit #$singularity-exec))
+                              "test"))
+                     (lambda ()
+                       (primitive-exit 127))))
+                  (pid
+                   (cdr (waitpid pid)))))
+             marionette))
+
+          (test-end)
+          (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+  (gexp->derivation "singularity-test" test))
+
+(define (build-tarball&run-singularity-test)
+  (mlet* %store-monad
+      ((_        (set-grafting #f))
+       (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))
+                                     #:hooks '()
+                                     #:locales? #f))
+       (tarball  (squashfs-image "singularity-pack" profile
+                                 #:symlinks '(("/bin" -> "bin")))))
+    (run-singularity-test tarball)))
+
+(define %test-singularity
+  (system-test
+   (name "singularity")
+   (description "Test Singularity container of Guix.")
+   (value (build-tarball&run-singularity-test))))
-- 
2.21.0





Information forwarded to guix-patches <at> gnu.org:
bug#36093; Package guix-patches. (Thu, 06 Jun 2019 11:04:02 GMT) Full text and rfc822 format available.

Message #29 received at 36093 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: 36093 <at> debbugs.gnu.org
Cc: Ludovic Courtès <ludovic.courtes <at> inria.fr>
Subject: [PATCH v2 2/2] pack: Add '--entry-point'.
Date: Thu,  6 Jun 2019 13:03:06 +0200
From: Ludovic Courtès <ludovic.courtes <at> inria.fr>

* guix/scripts/pack.scm (self-contained-tarball): Add #:entry-point and
warn when it's true.
(squashfs-image): Add #:entry-point and honor it.
(docker-image): Add #:entry-point and honor it.
(%options, show-help): Add '--entry-point'.
(guix-pack): Honor '--entry-point' and pass #:entry-point to BUILD-IMAGE.
* gnu/tests/docker.scm (run-docker-test): Test 'docker run' with the
default entry point.
(build-tarball&run-docker-test): Pass #:entry-point to 'docker-image'.
* doc/guix.texi (Invoking guix pack): Document it.
* gnu/tests/singularity.scm (run-singularity-test)["singularity run"]:
New test.
(build-tarball&run-singularity-test): Pass #:entry-point to
'squashfs-image'.
---
 doc/guix.texi             | 23 ++++++++++++++++++++++
 gnu/tests/docker.scm      | 19 +++++++++++-------
 gnu/tests/singularity.scm |  9 +++++++++
 guix/scripts/pack.scm     | 41 +++++++++++++++++++++++++++++++++++++++
 4 files changed, 85 insertions(+), 7 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index c89df4ade3..6851b911c0 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -4866,6 +4866,29 @@ advantage to work without requiring special kernel support, but it incurs
 run-time overhead every time a system call is made.
 @end quotation
 
+@cindex entry point, for Docker images
+@item --entry-point=@var{command}
+Use @var{command} as the @dfn{entry point} of the resulting pack, if the pack
+format supports it---currently @code{docker} and @code{squashfs} (Singularity)
+support it.  @var{command} must be relative to the profile contained in the
+pack.
+
+The entry point specifies the command that tools like @code{docker run} or
+@code{singularity run} automatically start by default.  For example, you can
+do:
+
+@example
+guix pack -f docker --entry-point=bin/guile guile
+@end example
+
+The resulting pack can easily be loaded and @code{docker run} with no extra
+arguments will spawn @code{bin/guile}:
+
+@example
+docker load -i pack.tar.gz
+docker run @var{image-id}
+@end example
+
 @item --expression=@var{expr}
 @itemx -e @var{expr}
 Consider the package @var{expr} evaluates to.
diff --git a/gnu/tests/docker.scm b/gnu/tests/docker.scm
index 3cd3a27884..f2674cdbe8 100644
--- a/gnu/tests/docker.scm
+++ b/gnu/tests/docker.scm
@@ -101,7 +101,7 @@ inside %DOCKER-OS."
              marionette))
 
           (test-equal "Load docker image and run it"
-            "hello world"
+            '("hello world" "hi!")
             (marionette-eval
              `(begin
                 (define slurp
@@ -117,12 +117,16 @@ inside %DOCKER-OS."
                        (repository&tag (string-drop raw-line
                                                     (string-length
                                                      "Loaded image: ")))
-                       (response (slurp
-                                  ,(string-append #$docker-cli "/bin/docker")
-                                  "run" "--entrypoint" "bin/Guile"
-                                  repository&tag
-                                  "/aa.scm")))
-                  response))
+                       (response1 (slurp
+                                   ,(string-append #$docker-cli "/bin/docker")
+                                   "run" "--entrypoint" "bin/Guile"
+                                   repository&tag
+                                   "/aa.scm"))
+                       (response2 (slurp          ;default entry point
+                                   ,(string-append #$docker-cli "/bin/docker")
+                                   "run" repository&tag
+                                   "-c" "(display \"hi!\")")))
+                  (list response1 response2)))
              marionette))
 
           (test-end)
@@ -161,6 +165,7 @@ standard output device and then enters a new line.")
        (tarball (docker-image "docker-pack" profile
                               #:symlinks '(("/bin/Guile" -> "bin/guile")
                                            ("aa.scm" -> "a.scm"))
+                              #:entry-point "bin/guile"
                               #:localstatedir? #t)))
     (run-docker-test tarball)))
 
diff --git a/gnu/tests/singularity.scm b/gnu/tests/singularity.scm
index 55324ef9ea..668043a0bc 100644
--- a/gnu/tests/singularity.scm
+++ b/gnu/tests/singularity.scm
@@ -103,6 +103,14 @@
                    (cdr (waitpid pid)))))
              marionette))
 
+          (test-equal "singularity run"           ;test the entry point
+            42
+            (marionette-eval
+             `(status:exit-val
+               (system* #$(file-append singularity "/bin/singularity")
+                        "run" #$image "-c" "(exit 42)"))
+             marionette))
+
           (test-end)
           (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
 
@@ -118,6 +126,7 @@
                                      #:hooks '()
                                      #:locales? #f))
        (tarball  (squashfs-image "singularity-pack" profile
+                                 #:entry-point "bin/guile"
                                  #:symlinks '(("/bin" -> "bin")))))
     (run-singularity-test tarball)))
 
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index c17b374330..5da23e038b 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -152,6 +152,7 @@ dependencies are registered."
                                  #:key target
                                  (profile-name "guix-profile")
                                  deduplicate?
+                                 entry-point
                                  (compressor (first %compressors))
                                  localstatedir?
                                  (symlinks '())
@@ -275,6 +276,10 @@ added to the pack."
                                           (_ #f))
                                         directives)))))))))
 
+  (when entry-point
+    (warning (G_ "entry point not supported in the '~a' format~%")
+             'tarball))
+
   (gexp->derivation (string-append name ".tar"
                                    (compressor-extension compressor))
                     build
@@ -284,6 +289,7 @@ added to the pack."
                          #:key target
                          (profile-name "guix-profile")
                          (compressor (first %compressors))
+                         entry-point
                          localstatedir?
                          (symlinks '())
                          (archiver squashfs-tools-next))
@@ -315,6 +321,7 @@ added to the pack."
                        (ice-9 match))
 
           (define database #+database)
+          (define entry-point #$entry-point)
 
           (setenv "PATH" (string-append #$archiver "/bin"))
 
@@ -371,6 +378,28 @@ added to the pack."
                                                             target)))))))
                       '#$symlinks)
 
+                   ;; 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"
+                           ,(string-append
+                             "/.singularity.d/actions/run s 777 0 0 "
+                             (relative-file-name "/.singularity.d/actions"
+                                                 (string-append #$profile "/"
+                                                                entry-point)))
+
+                           ;; This one is for Singularity 3.x.
+                           "-p"
+                           ,(string-append
+                             "/.singularity.d/runscript s 777 0 0 "
+                             (relative-file-name "/.singularity.d"
+                                                 (string-append #$profile "/"
+                                                                entry-point))))
+                         '())
+
                    ;; Create empty mount points.
                    "-p" "/proc d 555 0 0"
                    "-p" "/sys d 555 0 0"
@@ -392,6 +421,7 @@ added to the pack."
                        #:key target
                        (profile-name "guix-profile")
                        (compressor (first %compressors))
+                       entry-point
                        localstatedir?
                        (symlinks '())
                        (archiver tar))
@@ -425,6 +455,8 @@ the image."
                                 #$profile
                                 #:database #+database
                                 #:system (or #$target (utsname:machine (uname)))
+                                #:entry-point (string-append #$profile "/"
+                                                             #$entry-point)
                                 #:symlinks '#$symlinks
                                 #:compressor '#$(compressor-command compressor)
                                 #:creation-time (make-time time-utc 0 1))))))
@@ -689,6 +721,9 @@ please email '~a'~%")
                  (lambda (opt name arg result)
                    (alist-cons 'system arg
                                (alist-delete 'system result eq?))))
+         (option '("entry-point") #t #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'entry-point arg result)))
          (option '("target") #t #f
                  (lambda (opt name arg result)
                    (alist-cons 'target arg
@@ -765,6 +800,9 @@ Create a bundle of PACKAGE.\n"))
   -S, --symlink=SPEC     create symlinks to the profile according to SPEC"))
   (display (G_ "
   -m, --manifest=FILE    create a pack with the manifest from FILE"))
+  (display (G_ "
+      --entry-point=PROGRAM
+                         use PROGRAM as the entry point of the pack"))
   (display (G_ "
       --save-provenance  save provenance information"))
   (display (G_ "
@@ -889,6 +927,7 @@ Create a bundle of PACKAGE.\n"))
                                  (leave (G_ "~a: unknown pack format~%")
                                         pack-format))))
                  (localstatedir? (assoc-ref opts 'localstatedir?))
+                 (entry-point    (assoc-ref opts 'entry-point))
                  (profile-name   (assoc-ref opts 'profile-name))
                  (gc-root        (assoc-ref opts 'gc-root)))
             (when (null? (manifest-entries manifest))
@@ -919,6 +958,8 @@ Create a bundle of PACKAGE.\n"))
                                                      symlinks
                                                      #:localstatedir?
                                                      localstatedir?
+                                                     #:entry-point
+                                                     entry-point
                                                      #:profile-name
                                                      profile-name
                                                      #:archiver
-- 
2.21.0





Reply sent to Ludovic Courtès <ludo <at> gnu.org>:
You have taken responsibility. (Fri, 07 Jun 2019 07:59:02 GMT) Full text and rfc822 format available.

Notification sent to Ludovic Courtès <ludo <at> gnu.org>:
bug acknowledged by developer. (Fri, 07 Jun 2019 07:59:02 GMT) Full text and rfc822 format available.

Message #34 received at 36093-done <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: 36093-done <at> debbugs.gnu.org
Subject: Re: [bug#36093] [PATCH v2 2/2] pack: Add '--entry-point'.
Date: Fri, 07 Jun 2019 09:58:43 +0200
Pushed as a0f352b30f4869a7af7017b8a5011ac7602dd115!

Ludo’.




Information forwarded to guix-patches <at> gnu.org:
bug#36093; Package guix-patches. (Fri, 07 Jun 2019 10:22:02 GMT) Full text and rfc822 format available.

Message #37 received at 36093 <at> debbugs.gnu.org (full text, mbox):

From: Ricardo Wurmus <ricardo.wurmus <at> mdc-berlin.de>
To: Ludovic Courtès <ludo <at> gnu.org>
Cc: Danny Milosavljevic <dannym <at> scratchpost.org>, 36093 <at> debbugs.gnu.org
Subject: Re: [bug#36093] [PATCH 2/2] pack: Add '--entry-point'.
Date: Fri, 7 Jun 2019 12:21:32 +0200
Ludovic Courtès <ludo <at> gnu.org> writes:

>> Also, in general, do we conflate "squashfs" and "singularity"?  It has been
>> that way in guix/scripts/pack.scm's squashfs-image before this patch already
>> and a few extra files can't hurt, but we could also just provide a
>> function "singularity-image" or something.
>
> Yes, we do conflate Singularity and Squashfs, but I think there’s no
> other “container tool” that uses Squashfs anyway.

When I originally added the squashfs support to “guix pack” I had
Singularity in mind, but since it didn’t do anything particular for
Singularity I named it “squashfs”.

squashfs is used as a format by Snap (which we don’t explicitly support
yet), but it is also generally useful as a way to share disk images,
which could for example be used with lxc containers.

> We could rename it to “singularity”, but it turns out Singularity 3.x
> has its own image format unimaginatively called SIF, so perhaps we’re
> better off with the status quo.
>
> Thoughts?  Ricardo?

In my opinion, going forward we should not conflate “squashfs” and
Singularity more and eventually *add* a format handler for Singularity
3.x.

But these changes to the “squashfs” format handler look fine to me.
Let’s deal with Singularity 3.x later.

Thanks!

--
Ricardo




Information forwarded to guix-patches <at> gnu.org:
bug#36093; Package guix-patches. (Fri, 07 Jun 2019 13:16:02 GMT) Full text and rfc822 format available.

Message #40 received at 36093 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: Ricardo Wurmus <ricardo.wurmus <at> mdc-berlin.de>
Cc: Danny Milosavljevic <dannym <at> scratchpost.org>, 36093 <at> debbugs.gnu.org
Subject: Re: [bug#36093] [PATCH 2/2] pack: Add '--entry-point'.
Date: Fri, 07 Jun 2019 15:15:39 +0200
Hello,

Ricardo Wurmus <ricardo.wurmus <at> mdc-berlin.de> skribis:

> Ludovic Courtès <ludo <at> gnu.org> writes:
>
>>> Also, in general, do we conflate "squashfs" and "singularity"?  It has been
>>> that way in guix/scripts/pack.scm's squashfs-image before this patch already
>>> and a few extra files can't hurt, but we could also just provide a
>>> function "singularity-image" or something.
>>
>> Yes, we do conflate Singularity and Squashfs, but I think there’s no
>> other “container tool” that uses Squashfs anyway.
>
> When I originally added the squashfs support to “guix pack” I had
> Singularity in mind, but since it didn’t do anything particular for
> Singularity I named it “squashfs”.
>
> squashfs is used as a format by Snap (which we don’t explicitly support
> yet), but it is also generally useful as a way to share disk images,
> which could for example be used with lxc containers.

Oh, I didn’t know LXC and Snap support squashfs.

>> We could rename it to “singularity”, but it turns out Singularity 3.x
>> has its own image format unimaginatively called SIF, so perhaps we’re
>> better off with the status quo.
>>
>> Thoughts?  Ricardo?
>
> In my opinion, going forward we should not conflate “squashfs” and
> Singularity more and eventually *add* a format handler for Singularity
> 3.x.
>
> But these changes to the “squashfs” format handler look fine to me.
> Let’s deal with Singularity 3.x later.

What about:

  1. Renaming ‘squashfs’ to ‘singularity-squashfs’, and deprecating
     ‘squashfs’.

  2. Eventually, add a ‘sif’ format for Singularity 3’s native image
     format.

  3. Add a ‘snap’ backend, and perhaps an ‘lxc’ backend too.

Thanks,
Ludo’.




Information forwarded to guix-patches <at> gnu.org:
bug#36093; Package guix-patches. (Sat, 08 Jun 2019 17:22:02 GMT) Full text and rfc822 format available.

Message #43 received at 36093 <at> debbugs.gnu.org (full text, mbox):

From: Ricardo Wurmus <ricardo.wurmus <at> mdc-berlin.de>
To: Ludovic Courtès <ludo <at> gnu.org>
Cc: Danny Milosavljevic <dannym <at> scratchpost.org>, 36093 <at> debbugs.gnu.org
Subject: Re: [bug#36093] [PATCH 2/2] pack: Add '--entry-point'.
Date: Sat, 8 Jun 2019 19:21:50 +0200
Ludovic Courtès <ludo <at> gnu.org> writes:

> What about:
>
>   1. Renaming ‘squashfs’ to ‘singularity-squashfs’, and deprecating
>      ‘squashfs’.
>
>   2. Eventually, add a ‘sif’ format for Singularity 3’s native image
>      format.
>
>   3. Add a ‘snap’ backend, and perhaps an ‘lxc’ backend too.

Sounds like a good plan!

-- 
Ricardo




bug archived. Request was from Debbugs Internal Request <help-debbugs <at> gnu.org> to internal_control <at> debbugs.gnu.org. (Sun, 07 Jul 2019 11:24:05 GMT) Full text and rfc822 format available.

This bug report was last modified 4 years and 287 days ago.

Previous Next


GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.