[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[bug#72740] [PATCH v2 4/4] services: Add rootless-podman-service-type.
|
From: |
Giacomo Leidi |
|
Subject: |
[bug#72740] [PATCH v2 4/4] services: Add rootless-podman-service-type. |
|
Date: |
Wed, 21 Aug 2024 10:19:27 +0200 |
* gnu/services/containers.scm: New file;
(rootless-podman-configuration): new variable;
(rootless-podman-service-subids): new variable;
(rootless-podman-service-accounts): new variable;
(rootless-podman-service-profile): new variable;
(rootless-podman-shepherd-services): new variable;
(rootless-podman-service-etc): new variable;
(rootless-podman-service-type): new variable.
* gnu/local.mk: Test it.
* gnu/local.mk: Add them.
* doc/guix.texi (Miscellaneous Services): Document it.
Change-Id: I041496474c1027da353bd6852f2554a065914d7a
---
doc/guix.texi | 104 +++++++++++
gnu/local.mk | 2 +
gnu/services/containers.scm | 238 +++++++++++++++++++++++++
gnu/tests/containers.scm | 340 ++++++++++++++++++++++++++++++++++++
4 files changed, 684 insertions(+)
create mode 100644 gnu/services/containers.scm
create mode 100644 gnu/tests/containers.scm
diff --git a/doc/guix.texi b/doc/guix.texi
index 0e1e253b02..eb6a1b2442 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -40852,6 +40852,110 @@ Miscellaneous Services
invoke @command{singularity run} and similar commands.
@end defvar
+@cindex Rootless Podman
+@subsubheading Rootless Podman Service
+
+The @code{(gnu services containers)} module provides the following service.
+
+
+@cindex Rootless Podman, container management tool
+@defvar rootless-podman-service-type
+
+@url{https://www.sylabs.io/singularity/, Singularity} is a container management
+tool. In addition to providing a drop-in replacement for Docker, Podman offers
+the ability to run containers in rootless mode. This allows regular users to
+deploy containers without elevated privileges.
+
+The @code{rootless-podman-service-type} sets up the Guix System to allow
+unprivileged users to run @command{podman} commands:
+
+@lisp
+(use-service-modules containers networking @dots{})
+
+(operating-system
+ ;; @dots{}
+ (users (cons (user-account
+ (name "alice")
+ (comment "Bob's sister")
+ (group "users")
+
+ ;; Adding the account to the "cgroup" group
+ ;; makes it possible to run podman commands.
+ (supplementary-groups '("cgroup" "wheel"
+ "audio" "video")))
+ %base-user-accounts))
+ (services
+ (list
+ (service iptables-service-type)
+ (service rootless-podman-service-type
+ (rootless-podman-configuration
+ (subgids
+ (list (subid-range (name "alice"))))
+ (subuids
+ (list (subid-range (name "alice")))))))))
+@end lisp
+
+The @code{iptables-service-type} is required for Podman to be able to setup its
+own networks. Due to the change in user groups and file systems it is
+recommended to reboot (or at least logout), before trying to run Podman
commands.
+
+To test your installation you can run:
+
+@example
+$ podman run -it --rm docker.io/alpine cat /etc/*release*
+NAME="Alpine Linux"
+ID=alpine
+VERSION_ID=3.20.2
+PRETTY_NAME="Alpine Linux v3.20"
+HOME_URL="https://alpinelinux.org/";
+BUG_REPORT_URL="https://gitlab.alpinelinux.org/alpine/aports/-/issues";
+@end example
+
+@end defvar
+
+@c %start of fragment
+
+@deftp {Data Type} rootless-podman-configuration
+Available @code{rootless-podman-configuration} fields are:
+
+@table @asis
+@item @code{podman} (default: @code{podman}) (type: package)
+The Podman package that will be installed in the system profile.
+
+@item @code{group-name} (default: @code{"cgroup"}) (type: string)
+The name of the group that will own /sys/fs/cgroup resources. Users that
+want to use rootless Podman have to be in this group.
+
+@item @code{containers-registries} (type: lowerable)
+A string or a gexp evaluating to the path of Podman's
+@code{containers/registries.conf} configuration file.
+
+@item @code{containers-storage} (type: lowerable)
+A string or a gexp evaluating to the path of Podman's
+@code{containers/storage.conf} configuration file.
+
+@item @code{containers-policy} (type: lowerable)
+A string or a gexp evaluating to the path of Podman's
+@code{containers/policy.json} configuration file.
+
+@item @code{pam-limits} (type: list-of-pam-limits-entries)
+The PAM limits to be set for rootless Podman.
+
+@item @code{subgids} (default: @code{()}) (type: list-of-subid-ranges)
+A list of subid ranges representing the subgids that will be
+available for each configured user.
+
+@item @code{subuids} (default: @code{()}) (type: list-of-subid-ranges)
+A list of subid ranges representing the subuids that will be
+available for each configured user.
+
+@end table
+
+@end deftp
+
+
+@c %end of fragment
+
@cindex OCI-backed, Shepherd services
@subsubheading OCI backed services
diff --git a/gnu/local.mk b/gnu/local.mk
index 3b0a3858f7..a543f1ddc9 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -708,6 +708,7 @@ GNU_SYSTEM_MODULES = \
%D%/services/cgit.scm \
%D%/services/ci.scm \
%D%/services/configuration.scm \
+ %D%/services/containers.scm \
%D%/services/cuirass.scm \
%D%/services/cups.scm \
%D%/services/databases.scm \
@@ -813,6 +814,7 @@ GNU_SYSTEM_MODULES = \
%D%/tests/base.scm \
%D%/tests/cachefilesd.scm \
%D%/tests/ci.scm \
+ %D%/tests/containers.scm \
%D%/tests/cups.scm \
%D%/tests/databases.scm \
%D%/tests/desktop.scm \
diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm
new file mode 100644
index 0000000000..03f0649c0d
--- /dev/null
+++ b/gnu/services/containers.scm
@@ -0,0 +1,238 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2024 Giacomo Leidi <goodoldpaul@autistici.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 services containers)
+ #:use-module (gnu packages containers)
+ #:use-module (gnu packages file-systems)
+ #:use-module (gnu services)
+ #:use-module (gnu services base)
+ #:use-module (gnu services configuration)
+ #:use-module (gnu services shepherd)
+ #:use-module (gnu system accounts)
+ #:use-module (gnu system shadow)
+ #:use-module (gnu system pam)
+ #:use-module (guix gexp)
+ #:use-module (guix packages)
+ #:use-module (srfi srfi-1)
+ #:export (rootless-podman-configuration
+ rootless-podman-configuration?
+ rootless-podman-configuration-fields
+ rootless-podman-configuration-podman
+ rootless-podman-configuration-group-name
+ rootless-podman-configuration-containers-registries
+ rootless-podman-configuration-containers-storage
+ rootless-podman-configuration-containers-policy
+ rootless-podman-configuration-pam-limits
+ rootless-podman-configuration-subgids
+ rootless-podman-configuration-subuids
+
+ rootless-podman-service-subids
+ rootless-podman-service-accounts
+ rootless-podman-service-profile
+ rootless-podman-shepherd-services
+ rootless-podman-service-etc
+
+ rootless-podman-service-type))
+
+(define (gexp-or-string? value)
+ (or (gexp? value)
+ (string? value)))
+
+(define (lowerable? value)
+ (or (file-like? value)
+ (gexp-or-string? value)))
+
+(define list-of-pam-limits-entries?
+ (list-of pam-limits-entry?))
+
+(define list-of-subid-ranges?
+ (list-of subid-range?))
+
+(define-configuration/no-serialization rootless-podman-configuration
+ (podman
+ (package podman)
+ "The Podman package that will be installed in the system profile.")
+ (group-name
+ (string "cgroup")
+ "The name of the group that will own /sys/fs/cgroup resources. Users that
+want to use rootless Podman have to be in this group.")
+ (containers-registries
+ (lowerable
+ (plain-file "registries.conf"
+ (string-append "unqualified-search-registries = ['docker.io','"
+
"registry.fedora.org','registry.opensuse.org']")))
+ "A string or a gexp evaluating to the path of Podman's
+@code{containers/registries.conf} configuration file.")
+ (containers-storage
+ (lowerable
+ (plain-file "storage.conf"
+ "[storage]
+driver = \"overlay\""))
+ "A string or a gexp evaluating to the path of Podman's
+@code{containers/storage.conf} configuration file.")
+ (containers-policy
+ (lowerable
+ (plain-file "policy.json"
+ "{\"default\": [{\"type\": \"insecureAcceptAnything\"}]}"))
+ "A string or a gexp evaluating to the path of Podman's
+@code{containers/policy.json} configuration file.")
+ (pam-limits
+ (list-of-pam-limits-entries
+ (list (pam-limits-entry "*" 'both 'nofile 100000)))
+ "The PAM limits to be set for rootless Podman.")
+ (subgids
+ (list-of-subid-ranges '())
+ "A list of subid ranges representing the subgids that will be
+available for each configured user.")
+ (subuids
+ (list-of-subid-ranges '())
+ "A list of subid ranges representing the subuids that will be
+available for each configured user."))
+
+(define rootless-podman-service-profile
+ (lambda (config)
+ (list
+ (rootless-podman-configuration-podman config))))
+
+(define rootless-podman-service-etc
+ (lambda (config)
+ (list `("containers/registries.conf"
+ ,(rootless-podman-configuration-containers-registries config))
+ `("containers/storage.conf"
+ ,(rootless-podman-configuration-containers-storage config))
+ `("containers/policy.json"
+ ,(rootless-podman-configuration-containers-policy config)))))
+
+(define rootless-podman-service-subids
+ (lambda (config)
+ (subids-extension
+ (subgids (rootless-podman-configuration-subgids config))
+ (subuids (rootless-podman-configuration-subuids config)))))
+
+(define rootless-podman-service-accounts
+ (lambda (config)
+ (list (user-group (name (rootless-podman-configuration-group-name config))
+ (system? #t)))))
+
+(define (cgroups-fs-owner-entrypoint config)
+ (define group
+ (rootless-podman-configuration-group-name config))
+ (program-file "cgroups2-fs-owner-entrypoint"
+ #~(system*
+ "bash" "-c"
+ (string-append "echo Setting /sys/fs/cgroup "
+ "group ownership to " #$group " && chown -v "
+ "root:" #$group " /sys/fs/cgroup && "
+ "chmod -v 775 /sys/fs/cgroup && chown -v "
+ "root:" #$group " /sys/fs/cgroup/cgroup."
+ "{procs,subtree_control,threads} && "
+ "chmod -v 664 /sys/fs/cgroup/cgroup."
+ "{procs,subtree_control,threads}"))))
+
+(define (rootless-podman-cgroups-fs-owner-service config)
+ (shepherd-service (provision '(cgroups2-fs-owner))
+ (requirement
+ '(dbus-system
+ elogind
+ file-system-/sys/fs/cgroup
+ networking
+ udev
+ cgroups2-limits))
+ (one-shot? #t)
+ (documentation
+ "Set ownership of /sys/fs/cgroup to the configured
group.")
+ (start
+ #~(make-forkexec-constructor
+ (list
+ #$(cgroups-fs-owner-entrypoint config))))
+ (stop
+ #~(make-kill-destructor))))
+
+(define cgroups-limits-entrypoint
+ (program-file "cgroups2-limits-entrypoint"
+ #~(system*
+ "bash" "-c"
+ (string-append "echo Setting cgroups v2 limits && "
+ "echo +cpu +cpuset +memory +pids"
+ " >>
/sys/fs/cgroup/cgroup.subtree_control"))))
+
+(define (rootless-podman-cgroups-limits-service config)
+ (shepherd-service (provision '(cgroups2-limits))
+ (requirement
+ '(dbus-system
+ elogind
+ networking
+ udev
+ file-system-/sys/fs/cgroup
+ rootless-podman-shared-root-fs))
+ (one-shot? #t)
+ (documentation
+ "Allow setting cgroups limits: cpu, cpuset, memory and
+pids.")
+ (start
+ #~(make-forkexec-constructor
+ (list
+ #$cgroups-limits-entrypoint)))
+ (stop
+ #~(make-kill-destructor))))
+
+(define rootless-podman-shared-root-fs-entrypoint
+ (program-file "rootless-podman-shared-root-fs-entrypoint"
+ #~(system*
+ "mount" "--make-shared" "/")))
+
+(define (rootless-podman-shared-root-fs-service config)
+ (shepherd-service (provision '(rootless-podman-shared-root-fs))
+ (requirement
+ '(user-processes))
+ (one-shot? #t)
+ (documentation
+ "Buildah/Podman running as rootless expects the bind mount
+to be shared. This service sets it so.")
+ (start
+ #~(make-forkexec-constructor
+ (list
+ #$rootless-podman-shared-root-fs-entrypoint)))
+ (stop
+ #~(make-kill-destructor))))
+
+(define (rootless-podman-shepherd-services config)
+ (list
+ (rootless-podman-shared-root-fs-service config)
+ (rootless-podman-cgroups-limits-service config)
+ (rootless-podman-cgroups-fs-owner-service config)))
+
+(define rootless-podman-service-type
+ (service-type (name 'rootless-podman)
+ (extensions
+ (list
+ (service-extension subids-service-type
+ rootless-podman-service-subids)
+ (service-extension account-service-type
+ rootless-podman-service-accounts)
+ (service-extension profile-service-type
+ rootless-podman-service-profile)
+ (service-extension shepherd-root-service-type
+ rootless-podman-shepherd-services)
+ (service-extension pam-limits-service-type
+ rootless-podman-configuration-pam-limits)
+ (service-extension etc-service-type
+ rootless-podman-service-etc)))
+ (default-value (rootless-podman-configuration))
+ (description
+ "This service configures rootless @code{podman} on the Guix
System.")))
diff --git a/gnu/tests/containers.scm b/gnu/tests/containers.scm
new file mode 100644
index 0000000000..ba2fb22df6
--- /dev/null
+++ b/gnu/tests/containers.scm
@@ -0,0 +1,340 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2024 Giacomo Leidi <goodoldpaul@autistici.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 containers)
+ #:use-module (gnu)
+ #:use-module (gnu tests)
+ #:use-module (guix build-system trivial)
+ #:use-module (gnu packages bash)
+ #:use-module (gnu packages containers)
+ #:use-module (gnu packages guile)
+ #:use-module (gnu packages guile-xyz)
+ #:use-module (gnu services)
+ #:use-module (gnu services containers)
+ #:use-module (gnu services desktop)
+ #:use-module (gnu services dbus)
+ #:use-module (gnu services networking)
+ #:use-module (gnu system)
+ #:use-module (gnu system accounts)
+ #:use-module (gnu system vm)
+ #:use-module (guix gexp)
+ #:use-module ((guix licenses) #:prefix license:)
+ #:use-module (guix monads)
+ #:use-module (guix packages)
+ #:use-module (guix profiles)
+ #:use-module ((guix scripts pack) #:prefix pack:)
+ #:use-module (guix store)
+ #:export (%test-rootless-podman))
+
+
+(define %rootless-podman-os
+ (simple-operating-system
+ (service rootless-podman-service-type
+ (rootless-podman-configuration
+ (subgids
+ (list (subid-range (name "dummy"))))
+ (subuids
+ (list (subid-range (name "dummy"))))))
+
+ (service dhcp-client-service-type)
+ (service dbus-root-service-type)
+ (service polkit-service-type)
+ (service elogind-service-type)
+
+ (simple-service 'accounts
+ account-service-type
+ (list (user-account
+ (name "dummy")
+ (group "users")
+ (supplementary-groups '("wheel" "netdev" "cgroup"
+ "audio" "video")))))))
+
+(define (run-rootless-podman-test oci-tarball)
+
+ (define os
+ (marionette-operating-system
+ (operating-system-with-gc-roots
+ %rootless-podman-os
+ (list oci-tarball))
+ #:imported-modules '((gnu services herd)
+ (guix combinators))))
+
+ (define vm
+ (virtual-machine
+ (operating-system os)
+ (volatile? #f)
+ (memory-size 1024)
+ (disk-image-size (* 3000 (expt 2 20)))
+ (port-forwardings '())))
+
+ (define test
+ (with-imported-modules '((gnu build marionette)
+ (gnu services herd))
+ #~(begin
+ (use-modules (srfi srfi-11) (srfi srfi-64)
+ (gnu build marionette))
+
+ (define marionette
+ ;; Relax timeout to accommodate older systems and
+ ;; allow for pulling the image.
+ (make-marionette (list #$vm) #:timeout 60))
+ (define out-dir "/tmp")
+
+ (test-runner-current (system-test-runner #$output))
+ (test-begin "rootless-podman")
+
+ (test-assert "service started"
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (match (start-service 'cgroups2-fs-owner)
+ (#f #f)
+ ;; herd returns (running #f), likely because of one shot,
+ ;; so consider any non-error a success.
+ (('service response-parts ...) #t)))
+ marionette))
+
+ (test-equal "/sys/fs/cgroup/cgroup.subtree_control content is sound"
+ (list "cpu" "cpuset" "memory" "pids")
+ (marionette-eval
+ `(begin
+ (use-modules (srfi srfi-1)
+ (ice-9 popen)
+ (ice-9 match)
+ (ice-9 rdelim))
+
+ (define (read-lines file-or-port)
+ (define (loop-lines port)
+ (let loop ((lines '()))
+ (match (read-line port)
+ ((? eof-object?)
+ (reverse lines))
+ (line
+ (loop (cons line lines))))))
+
+ (if (port? file-or-port)
+ (loop-lines file-or-port)
+ (call-with-input-file file-or-port
+ loop-lines)))
+
+ (define slurp
+ (lambda args
+ (let* ((port (apply open-pipe* OPEN_READ args))
+ (output (read-lines port))
+ (status (close-pipe port)))
+ output)))
+ (let* ((response1 (slurp
+ ,(string-append #$coreutils "/bin/cat")
+ "/sys/fs/cgroup/cgroup.subtree_control")))
+ (sort-list (string-split (first response1) #\space)
string<?)))
+ marionette))
+
+ (test-equal "/sys/fs/cgroup has correct permissions"
+ '("cgroup" "cgroup")
+ (marionette-eval
+ `(begin
+ (use-modules (ice-9 popen)
+ (ice-9 match)
+ (ice-9 rdelim))
+
+ (define (read-lines file-or-port)
+ (define (loop-lines port)
+ (let loop ((lines '()))
+ (match (read-line port)
+ ((? eof-object?)
+ (reverse lines))
+ (line
+ (loop (cons line lines))))))
+
+ (if (port? file-or-port)
+ (loop-lines file-or-port)
+ (call-with-input-file file-or-port
+ loop-lines)))
+
+ (define slurp
+ (lambda args
+ (let* ((port (apply open-pipe* OPEN_READ args))
+ (output (read-lines port))
+ (status (close-pipe port)))
+ output)))
+ (let* ((bash
+ ,(string-append #$bash "/bin/bash"))
+ (response1
+ (slurp bash "-c"
+ (string-append "ls -la /sys/fs/cgroup | "
+ "grep -E ' \\./?$' | awk '{
print $4 }'")))
+ (response2 (slurp bash "-c"
+ (string-append "ls -l
/sys/fs/cgroup/cgroup"
+
".{procs,subtree_control,threads} | "
+ "awk '{ print $4 }' |
sort -u"))))
+ (list (string-join response1 "\n") (string-join response2
"\n"))))
+ marionette))
+
+ (test-equal "Load oci image and run it (unprivileged)"
+ '("hello world" "hi!" "JSON!" #o1777)
+ (marionette-eval
+ `(begin
+ (use-modules (srfi srfi-1)
+ (ice-9 popen)
+ (ice-9 match)
+ (ice-9 rdelim))
+
+ (define (wait-for-file file)
+ ;; Wait until FILE shows up.
+ (let loop ((i 60))
+ (cond ((file-exists? file)
+ #t)
+ ((zero? i)
+ (error "file didn't show up" file))
+ (else
+ (pk 'wait-for-file file)
+ (sleep 1)
+ (loop (- i 1))))))
+
+ (define (read-lines file-or-port)
+ (define (loop-lines port)
+ (let loop ((lines '()))
+ (match (read-line port)
+ ((? eof-object?)
+ (reverse lines))
+ (line
+ (loop (cons line lines))))))
+
+ (if (port? file-or-port)
+ (loop-lines file-or-port)
+ (call-with-input-file file-or-port
+ loop-lines)))
+
+ (define slurp
+ (lambda args
+ (let* ((port (apply open-pipe* OPEN_READ
+ (list "sh" "-l" "-c"
+ (string-join
+ args
+ " "))))
+ (output (read-lines port))
+ (status (close-pipe port)))
+ output)))
+
+ (match (primitive-fork)
+ (0
+ (dynamic-wind
+ (const #f)
+ (lambda ()
+ (setgid (passwd:gid (getpwnam "dummy")))
+ (setuid (passwd:uid (getpw "dummy")))
+
+ (let* ((loaded (slurp ,(string-append #$podman
+ "/bin/podman")
+ "load" "-i"
+ ,#$oci-tarball))
+ (repository&tag "localhost/guile-guest:latest")
+ (response1 (slurp
+ ,(string-append #$podman
"/bin/podman")
+ "run" "--pull" "never"
+ "--entrypoint" "bin/Guile"
+ repository&tag
+ "/aa.scm"))
+ (response2 (slurp ;default entry point
+ ,(string-append #$podman
"/bin/podman")
+ "run" "--pull" "never" repository&tag
+ "-c" "'(display \"hi!\")'"))
+
+ ;; Check whether (json) is in $GUILE_LOAD_PATH.
+ (response3 (slurp ;default entry point +
environment
+ ,(string-append #$podman
"/bin/podman")
+ "run" "--pull" "never" repository&tag
+ "-c" "'(use-modules (json))
+ (display (json-string->scm (scm->json-string \"JSON!\")))'"))
+
+ ;; Check whether /tmp exists.
+ (response4 (slurp
+ ,(string-append #$podman
"/bin/podman")
+ "run" "--pull" "never"
repository&tag "-c"
+ "'(display (stat:perms (lstat
\"/tmp\")))'")))
+ (call-with-output-file (string-append ,out-dir
"/response1")
+ (lambda (port)
+ (display (string-join response1 " ") port)))
+ (call-with-output-file (string-append ,out-dir
"/response2")
+ (lambda (port)
+ (display (string-join response2 " ") port)))
+ (call-with-output-file (string-append ,out-dir
"/response3")
+ (lambda (port)
+ (display (string-join response3 " ") port)))
+ (call-with-output-file (string-append ,out-dir
"/response4")
+ (lambda (port)
+ (display (string-join response4 " ") port)))))
+ (lambda ()
+ (primitive-exit 127))))
+ (pid
+ (cdr (waitpid pid))))
+ (wait-for-file (string-append ,out-dir "/response4"))
+ (append
+ (slurp "cat" (string-append ,out-dir "/response1"))
+ (slurp "cat" (string-append ,out-dir "/response2"))
+ (slurp "cat" (string-append ,out-dir "/response3"))
+ (map string->number (slurp "cat" (string-append ,out-dir
"/response4")))))
+ marionette))
+
+ (test-end))))
+
+ (gexp->derivation "rootless-podman-test" test))
+
+(define (build-tarball&run-rootless-podman-test)
+ (mlet* %store-monad
+ ((_ (set-grafting #f))
+ (guile (set-guile-for-build (default-guile)))
+ (guest-script-package ->
+ (package
+ (name "guest-script")
+ (version "0")
+ (source #f)
+ (build-system trivial-build-system)
+ (arguments `(#:guile ,guile-3.0
+ #:builder
+ (let ((out (assoc-ref %outputs "out")))
+ (mkdir out)
+ (call-with-output-file (string-append out "/a.scm")
+ (lambda (port)
+ (display "(display \"hello world\n\")" port)))
+ #t)))
+ (synopsis "Display hello world using Guile")
+ (description "This package displays the text \"hello world\" on the
+standard output device and then enters a new line.")
+ (home-page #f)
+ (license license:public-domain)))
+ (profile (profile-derivation (packages->manifest
+ (list guile-3.0 guile-json-3
+ guest-script-package))
+ #:hooks '()
+ #:locales? #f))
+ (tarball (pack:docker-image
+ "docker-pack" profile
+ #:symlinks '(("/bin/Guile" -> "bin/guile")
+ ("aa.scm" -> "a.scm"))
+ #:extra-options
+ '(#:image-tag "guile-guest")
+ #:entry-point "bin/guile"
+ #:localstatedir? #t)))
+ (run-rootless-podman-test tarball)))
+
+(define %test-rootless-podman
+ (system-test
+ (name "rootless-podman")
+ (description "Test rootless Podman service.")
+ (value (build-tarball&run-rootless-podman-test))))
--
2.45.2