mirror of
https://git.savannah.gnu.org/git/guix.git
synced 2025-01-18 21:46:35 +01:00
services: Add rootless-podman-service-type.
* 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 Signed-off-by: Ludovic Courtès <ludo@gnu.org>
This commit is contained in:
Giacomo Leidi
Ludovic Courtès
parent
17e5ca8190
commit
2767b4ef03
4 changed files with 690 additions and 0 deletions
110
doc/guix.texi
110
doc/guix.texi
|
|
@ -41292,6 +41292,116 @@ setuid-root (@pxref{Privileged Programs}) such that unprivileged users can
|
||||||
invoke @command{singularity run} and similar commands.
|
invoke @command{singularity run} and similar commands.
|
||||||
@end defvar
|
@end defvar
|
||||||
|
|
||||||
|
@cindex Rootless Podman
|
||||||
|
@subsubheading Rootless Podman Service
|
||||||
|
|
||||||
|
@cindex rootless podman, container management tool
|
||||||
|
@cindex podman, rootless
|
||||||
|
@cindex container management, podman
|
||||||
|
The @code{(gnu services containers)} module provides the following service.
|
||||||
|
|
||||||
|
|
||||||
|
@defvar rootless-podman-service-type
|
||||||
|
This is the service type for @url{https://podman.io, Podman} is a
|
||||||
|
container management tool.
|
||||||
|
|
||||||
|
In addition to providing a drop-in replacement for Docker, Podman offers
|
||||||
|
the ability to run containers in ``root-less'' mode, meaning that regular users can
|
||||||
|
deploy containers without elevated privileges. It does so mainly by leveraging
|
||||||
|
two Linux kernel features: unprivileged user namespaces, and subordinate
|
||||||
|
user and group IDs (@pxref{subordinate-user-group-ids, the subordinate
|
||||||
|
user and group ID service}).
|
||||||
|
|
||||||
|
The @code{rootless-podman-service-type} sets up the 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
|
||||||
|
(append (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")))))))
|
||||||
|
%base-services)))
|
||||||
|
@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
|
@cindex OCI-backed, Shepherd services
|
||||||
@subsubheading OCI backed services
|
@subsubheading OCI backed services
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -719,6 +719,7 @@ GNU_SYSTEM_MODULES = \
|
||||||
%D%/services/cgit.scm \
|
%D%/services/cgit.scm \
|
||||||
%D%/services/ci.scm \
|
%D%/services/ci.scm \
|
||||||
%D%/services/configuration.scm \
|
%D%/services/configuration.scm \
|
||||||
|
%D%/services/containers.scm \
|
||||||
%D%/services/cuirass.scm \
|
%D%/services/cuirass.scm \
|
||||||
%D%/services/cups.scm \
|
%D%/services/cups.scm \
|
||||||
%D%/services/databases.scm \
|
%D%/services/databases.scm \
|
||||||
|
|
@ -825,6 +826,7 @@ GNU_SYSTEM_MODULES = \
|
||||||
%D%/tests/base.scm \
|
%D%/tests/base.scm \
|
||||||
%D%/tests/cachefilesd.scm \
|
%D%/tests/cachefilesd.scm \
|
||||||
%D%/tests/ci.scm \
|
%D%/tests/ci.scm \
|
||||||
|
%D%/tests/containers.scm \
|
||||||
%D%/tests/cups.scm \
|
%D%/tests/cups.scm \
|
||||||
%D%/tests/databases.scm \
|
%D%/tests/databases.scm \
|
||||||
%D%/tests/desktop.scm \
|
%D%/tests/desktop.scm \
|
||||||
|
|
|
||||||
238
gnu/services/containers.scm
Normal file
238
gnu/services/containers.scm
Normal file
|
|
@ -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.")))
|
||||||
340
gnu/tests/containers.scm
Normal file
340
gnu/tests/containers.scm
Normal file
|
|
@ -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))))
|
||||||
Loading…
Reference in a new issue