services: Add Singularity.
* 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.master
Ludovic Courtès
Ludovic Courtès
parent
cd37b144e4
commit
08814aec6a
|
|
@ -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
|
||||
|
||||
|
|
@ -24163,6 +24163,17 @@ The audit 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
|
||||
|
||||
|
|
|
|||
|
|
@ -587,6 +587,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 \
|
||||
|
|
|
|||
|
|
@ -2899,12 +2899,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
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
|
|
|
|||
|
|
@ -0,0 +1,128 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2019 Ludovic Courtès <ludo@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))))
|
||||
Loading…
Reference in New Issue