Package: guix-patches;
Reported by: paul <goodoldpaul <at> autistici.org>
Date: Wed, 5 Feb 2025 22:01:03 UTC
Severity: normal
To reply to this bug, email your comments to 76081 AT debbugs.gnu.org.
Toggle the display of automated, internal messages from the tracker.
View this report as an mbox folder, status mbox, maintainer mbox
guix-patches <at> gnu.org:bug#76081; Package guix-patches.
(Wed, 05 Feb 2025 22:01:03 GMT) Full text and rfc822 format available.paul <goodoldpaul <at> autistici.org>:guix-patches <at> gnu.org.
(Wed, 05 Feb 2025 22:01:03 GMT) Full text and rfc822 format available.Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):
From: paul <goodoldpaul <at> autistici.org> To: guix-patches <at> gnu.org Subject: OCI provisioning service Date: Wed, 5 Feb 2025 22:59:57 +0100
[Message part 1 (text/plain, inline)]
Hi Guix,
for a while now, we have been able to run Docker/OCI images as Shepherd
services with the oci-container-service-type. This was useful especially
to run software that is not packaged yet (or sometimes not packageable
at all, due to JS and other bootstrapping issues). It allows to declare
a list of oci-container-configuration records which would map to Docker
backed Shepherd services:
(service oci-container-service-type
(list
(oci-container-configuration
(image "prom/prometheus")
(network "host")
(ports
'(("9000" . "9000")
("9090" . "9090"))))
(oci-container-configuration
(image "grafana/grafana:10.0.1")
(network "host")
(volumes
'("/var/lib/grafana:/var/lib/grafana")))))
This allows us to have containerized but apparently native services
running on the Guix System. The downside is that unless some isolation
mechanism are disabled, or unless the running services are very simple
and don't have to interact with the world outside them, we lose some of
the nice virtualization features of containers. Above all is the need to
have all containers connected to the host network to be able to interact
with other containers. This is effectively the default behavior of most
if not all Guix native services but with the downside that usually OCI
images lack all the provenance information that is typical of Guix
packages, hence are less trustable than a native Guix package so in some
cases users do prefer to have them running in an isolated environment.
Another shortcoming of the oci-container-service-type is that it only
supports Docker as an OCI runtime which must have a running daemon with
full root privileges to be able to execute containers. Since some weeks
now, with the help of subids/subgids and unprivileged namespaces, we are
able to run completely rootless containers with the
rootless-podman-service-type.
This patch implements a generalization of the
oci-container-service-type, which consequently is made deprecated. The
oci-service-type, in addition to all the features from the
oci-container-service-type, can now provision OCI networks and volumes:
(service iptables-service-type)
(service rootless-podman-service-type)
(service oci-service-type
(oci-configuration
(runtime 'podman)))
(simple-service 'oci-provisioning
oci-service-type
(oci-extension
(volumes
(list
(oci-network-configuration (name "grafana"))))
(networks
(list
(oci-network-configuration (name "monitoring"))))
(containers
(list
(oci-container-configuration
(image "docker.io/grafana/grafana:10.1.5")
(network "host")
(volumes
`(,( . "/opt/bitnami/grafana/conf/grafana.ini")
("grafana" . "/var/lib/grafana"))))))))
Please mind that this is only an example and it probably won't work on
your system without some more thought. The oci-service-type currently
only handles OCI objects creation, the user is supposed to handle state
once the objects are provsioned. It currently supports two different OCI
runtimes: Docker and rootless Podman. Both runtimes are tested to make
sure provisioned containers can connect to each other through
provisioned networks and can read/write data with provisioned volumes.
Compared to the oci-container-service-type I added some utility Shepherd
actions that are supposed to help with debugging. The above
configuration would yield the following
$ sudo herd command-line podman-networks
/run/current-system/profile/bin/podman network create monitoring
$ sudo herd command-line podman-volumes
/run/current-system/profile/bin/podman volume create grafana
$ sudo herd doc podman-grafana list-actions
command-line:
Prints podman-grafana's OCI runtime command line invokation.
pull:
Pull podman-grafana's image (docker.io/grafana/grafana:10.1.5).
$ sudo herd command-line podman-grafana
/run/current-system/profile/bin/podman run --rm --name podman-grafana --network host -v grafana:/var/lib/grafana -v /gnu/store/yqfvhvf8j4008ykr52zh2dmc1d2mjxih-grafana.ini:/opt/bitnami/grafana/conf/grafana.ini docker.io/bitnami/grafana:10.1.5
At last the Scheme API is thought to facilitate the implementation of a
Guix Home service in the future (you can find an untested version of
that at [0]). I tested my changes with:
guix shell -D guix -CPW -- make check-system TESTS="oci-service-docker oci-container oci-service-rootless-podman docker docker-system rootless-podman"
Please let me know your thoughts about this!
Thank you for all your work,
giacomo
[0]:
https://github.com/fishinthecalculator/gocix/blob/main/modules/oci/home/services/containers.scm
[Message part 2 (text/html, inline)]
guix-patches <at> gnu.org:bug#76081; Package guix-patches.
(Wed, 05 Feb 2025 22:04:02 GMT) Full text and rfc822 format available.Message #8 received at 76081 <at> debbugs.gnu.org (full text, mbox):
From: Giacomo Leidi <goodoldpaul <at> autistici.org> To: 76081 <at> debbugs.gnu.org Cc: Giacomo Leidi <goodoldpaul <at> autistici.org> Subject: [PATCH 1/4] services: rootless-podman: Use login shell. Date: Wed, 5 Feb 2025 23:02:28 +0100
This commit allows for having PATH set when changing the owner of
/sys/fs/group.
* gnu/services/containers.scm (crgroups-fs-owner): Use login shell.
Change-Id: I9510c637a5332325e05ca5ebc9dfd4de32685c50
---
gnu/services/containers.scm | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm
index 19d35ccbcb6..dc66ac4f967 100644
--- a/gnu/services/containers.scm
+++ b/gnu/services/containers.scm
@@ -140,7 +140,7 @@ (define (cgroups-fs-owner-entrypoint config)
(rootless-podman-configuration-group-name config))
(program-file "cgroups2-fs-owner-entrypoint"
#~(system*
- (string-append #+bash-minimal "/bin/bash") "-c"
+ (string-append #+bash-minimal "/bin/bash") "-l" "-c"
(string-append "echo Setting /sys/fs/cgroup "
"group ownership to " #$group " && chown -v "
"root:" #$group " /sys/fs/cgroup && "
base-commit: 5a897c5c95a81278b044c18d962d3bd83131ba06
--
2.48.1
guix-patches <at> gnu.org:bug#76081; Package guix-patches.
(Wed, 05 Feb 2025 22:04:02 GMT) Full text and rfc822 format available.Message #11 received at 76081 <at> debbugs.gnu.org (full text, mbox):
From: Giacomo Leidi <goodoldpaul <at> autistici.org> To: 76081 <at> debbugs.gnu.org Cc: Giacomo Leidi <goodoldpaul <at> autistici.org> Subject: [PATCH 4/4] tests: Use oci-image in container tests. Date: Wed, 5 Feb 2025 23:02:31 +0100
This patch replaces boilerplate in container related tests with
oci-image plumbing from (gnu services containers).
* gnu/services/containers.scm: Export lower-oci-image.
* gnu/tests/containers.scm (%oci-tarball): New variable;
(run-rootless-podman-test): use %oci-tarball;
(build-tarball&run-rootless-podman-test): drop procedure.
* gnu/tests/docker.scm (%docker-tarball): New variable;
(build-tarball&run-docker-test): use %docker-tarball;
(%docker-system-tarball): New variable;
(build-tarball&run-docker-system-test): new procedure.
Change-Id: Iad6f0704aee188d89464c83722dea0bb7adb084a
---
gnu/services/containers.scm | 2 +
gnu/tests/containers.scm | 80 ++++++++++++++----------------
gnu/tests/docker.scm | 98 ++++++++++++++++++++-----------------
3 files changed, 93 insertions(+), 87 deletions(-)
diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm
index c45f79c4ed1..e15dbc6a21c 100644
--- a/gnu/services/containers.scm
+++ b/gnu/services/containers.scm
@@ -74,6 +74,8 @@ (define-module (gnu services containers)
oci-image-system
oci-image-grafts?
+ lower-oci-image
+
oci-container-configuration
oci-container-configuration?
oci-container-configuration-fields
diff --git a/gnu/tests/containers.scm b/gnu/tests/containers.scm
index 719647c298e..024000bca14 100644
--- a/gnu/tests/containers.scm
+++ b/gnu/tests/containers.scm
@@ -69,13 +69,47 @@ (define %rootless-podman-os
(supplementary-groups '("wheel" "netdev" "cgroup"
"audio" "video")))))))
-(define (run-rootless-podman-test oci-tarball)
+(define %oci-tarball
+ (lower-oci-image
+ "guile-guest"
+ (oci-image
+ (repository "guile-guest")
+ (value
+ (packages->manifest
+ (list
+ guile-3.0 guile-json-3
+ (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)))))
+ (pack-options
+ '(#:entry-point "bin/guile"
+ #:localstatedir? #t
+ #:extra-options (#:image-tag "guile-guest")
+ #:symlinks (("/bin/Guile" -> "bin/guile")
+ ("aa.scm" -> "a.scm")))))))
+
+(define (run-rootless-podman-test)
(define os
(marionette-operating-system
(operating-system-with-gc-roots
%rootless-podman-os
- (list oci-tarball))
+ (list %oci-tarball))
#:imported-modules '((gnu services herd)
(guix combinators))))
@@ -254,7 +288,7 @@ (define (run-rootless-podman-test oci-tarball)
(let* ((loaded (slurp ,(string-append #$podman
"/bin/podman")
"load" "-i"
- ,#$oci-tarball))
+ ,#$%oci-tarball))
(repository&tag "localhost/guile-guest:latest")
(response1 (slurp
,(string-append #$podman "/bin/podman")
@@ -307,49 +341,11 @@ (define (run-rootless-podman-test oci-tarball)
(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))))
+ (value (run-rootless-podman-test))))
(define %guile-oci-image
diff --git a/gnu/tests/docker.scm b/gnu/tests/docker.scm
index 5dcf05a17e3..d969b28a68f 100644
--- a/gnu/tests/docker.scm
+++ b/gnu/tests/docker.scm
@@ -26,6 +26,7 @@ (define-module (gnu tests docker)
#:use-module (gnu system image)
#:use-module (gnu system vm)
#:use-module (gnu services)
+ #:use-module (gnu services containers)
#:use-module (gnu services dbus)
#:use-module (gnu services networking)
#:use-module (gnu services docker)
@@ -57,6 +58,40 @@ (define %docker-os
(service containerd-service-type)
(service docker-service-type)))
+(define %docker-tarball
+ (lower-oci-image
+ "guile-guest"
+ (oci-image
+ (repository "guile-guest")
+ (value
+ (packages->manifest
+ (list
+ guile-3.0 guile-json-3
+ (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)))))
+ (pack-options
+ '(#:entry-point "bin/guile"
+ #:localstatedir? #t
+ #:extra-options (#:image-tag "guile-guest")
+ #:symlinks (("/bin/Guile" -> "bin/guile")
+ ("aa.scm" -> "a.scm")))))))
+
(define (run-docker-test docker-tarball)
"Load DOCKER-TARBALL as Docker image and run it in a Docker container,
inside %DOCKER-OS."
@@ -173,40 +208,7 @@ (define (run-docker-test docker-tarball)
(gexp->derivation "docker-test" test))
(define (build-tarball&run-docker-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"))
- #:entry-point "bin/guile"
- #:localstatedir? #t)))
- (run-docker-test tarball)))
+ (run-docker-test %docker-tarball))
(define %test-docker
(system-test
@@ -215,8 +217,20 @@ (define %test-docker
(value (build-tarball&run-docker-test))))
+(define %docker-system-tarball
+ (lower-oci-image
+ "guix-system-guest"
+ (oci-image
+ (repository "guix-system-guest")
+ (value
+ (operating-system
+ (inherit (simple-operating-system))
+ ;; Use locales for a single libc to
+ ;; reduce space requirements.
+ (locale-libcs (list glibc)))))))
+
(define (run-docker-system-test tarball)
- "Load DOCKER-TARBALL as Docker image and run it in a Docker container,
+ "Load TARBALL as Docker image and run it in a Docker container,
inside %DOCKER-OS."
(define os
(marionette-operating-system
@@ -333,21 +347,15 @@ (define (run-docker-system-test tarball)
(gexp->derivation "docker-system-test" test))
+(define (build-tarball&run-docker-system-test)
+ (run-docker-system-test %docker-system-tarball))
+
(define %test-docker-system
(system-test
(name "docker-system")
(description "Run a system image as produced by @command{guix system
docker-image} inside Docker.")
- (value (with-monad %store-monad
- (>>= (lower-object
- (system-image (os->image
- (operating-system
- (inherit (simple-operating-system))
- ;; Use locales for a single libc to
- ;; reduce space requirements.
- (locale-libcs (list glibc)))
- #:type docker-image-type)))
- run-docker-system-test)))))
+ (value (build-tarball&run-docker-system-test))))
(define %oci-os
--
2.48.1
ludo <at> gnu.org, maxim.cournoyer <at> gmail.com, guix-patches <at> gnu.org:bug#76081; Package guix-patches.
(Wed, 05 Feb 2025 22:04:03 GMT) Full text and rfc822 format available.Message #14 received at 76081 <at> debbugs.gnu.org (full text, mbox):
From: Giacomo Leidi <goodoldpaul <at> autistici.org> To: 76081 <at> debbugs.gnu.org Cc: Giacomo Leidi <goodoldpaul <at> autistici.org> Subject: [PATCH 3/4] services: Add oci-service-type. Date: Wed, 5 Feb 2025 23:02:30 +0100
This patch implements a generalization of the
oci-container-service-type, which consequently is made deprecated. The
oci-service-type, in addition to all the features from the
oci-container-service-type, can now provision OCI networks and volumes.
It only handles OCI objects creation, the user is supposed to handle
state once the objects are provsioned.
It currently supports two different OCI runtimes: Docker and rootless
Podman. Both runtimes are tested to make sure provisioned containers
can connect to each other through provisioned networks and can
read/write data with provisioned volumes.
At last the Scheme API is thought to facilitate the implementation of a
Guix Home service in the future.
* gnu/services/containers.scm (%oci-supported-runtimes): New variable;
(oci-runtime-cli): new variable;
(oci-runtime-name): new variable;
(oci-network-configuration): new variable;
(oci-volume-configuration): new variable;
(oci-configuration): new variable;
(oci-extension): new variable;
(oci-networks-shepherd-name): new variable;
(oci-service-type): new variable;
(oci-state->shepherd-services): new variable.
* doc/guix.texi: Document it.
* gnu/tests/containers.scm: Test it.
* gnu/services/docker.scm: Deprecate the oci-container-service-type.
Change-Id: I656b3db85832e42d53072fcbfb91d1226f39ef38
---
doc/guix.texi | 295 +++++++---
gnu/services/containers.scm | 1038 +++++++++++++++++++++++++++++++----
gnu/services/docker.scm | 37 +-
gnu/tests/containers.scm | 956 +++++++++++++++++++++++++++++++-
4 files changed, 2130 insertions(+), 196 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index bb5f29277fb..ff3e77a1d00 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -41778,59 +41778,155 @@ Miscellaneous Services
@cindex OCI-backed, Shepherd services
@subsubheading OCI backed services
-Should you wish to manage your Docker containers with the same consistent
-interface you use for your other Shepherd services,
-@var{oci-container-service-type} is the tool to use: given an
-@acronym{Open Container Initiative, OCI} container image, it will run it in a
+Should you wish to manage your @acronym{Open Container Initiative, OCI} containers
+with the same consistent interface you use for your other Shepherd services,
+@var{oci-service-type} is the tool to use: given an
+OCI container image, it will run it in a
Shepherd service. One example where this is useful: it lets you run services
-that are available as Docker/OCI images but not yet packaged for Guix.
+that are available as OCI images but not yet packaged for Guix.
-@defvar oci-container-service-type
+@defvar oci-service-type
-This is a thin wrapper around Docker's CLI that executes OCI images backed
+This is a thin wrapper around Docker's or Podman's CLI that executes OCI images backed
processes as Shepherd Services.
@lisp
-(service oci-container-service-type
- (list
- (oci-container-configuration
- (network "host")
- (image
- (oci-image
- (repository "guile")
- (tag "3")
- (value (specifications->manifest '("guile")))
- (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile"))
- #:max-layers 2))))
- (entrypoint "/bin/guile")
- (command
- '("-c" "(display \"hello!\n\")")))
- (oci-container-configuration
- (image "prom/prometheus")
- (ports
- '(("9000" . "9000")
- ("9090" . "9090"))))
- (oci-container-configuration
- (image "grafana/grafana:10.0.1")
- (network "host")
- (volumes
- '("/var/lib/grafana:/var/lib/grafana")))))
+(simple-service 'oci-provisioning
+ oci-service-type
+ (oci-extension
+ (networks
+ (list
+ (oci-network-configuration (name "monitoring"))))
+ (containers
+ (list
+ (oci-container-configuration
+ (network "monitoring")
+ (image
+ (oci-image
+ (repository "guile")
+ (tag "3")
+ (value (specifications->manifest '("guile")))
+ (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile"))
+ #:max-layers 2))))
+ (entrypoint "/bin/guile")
+ (command
+ '("-c" "(display \"hello!\n\")")))
+ (oci-container-configuration
+ (image "prom/prometheus")
+ (network "host")
+ (ports
+ '(("9000" . "9000")
+ ("9090" . "9090"))))
+ (oci-container-configuration
+ (image "grafana/grafana:10.0.1")
+ (network "host")
+ (volumes
+ '("/var/lib/grafana:/var/lib/grafana")))))))
@end lisp
In this example three different Shepherd services are going to be added to the
system. Each @code{oci-container-configuration} record translates to a
-@code{docker run} invocation and its fields directly map to options. You can
-refer to the
-@url{https://docs.docker.com/engine/reference/commandline/run,upstream}
-documentation for the semantics of each value. If the images are not found,
-they will be
-@url{https://docs.docker.com/engine/reference/commandline/pull/,pulled}. The
+@command{docker run} or @command{podman run} invocation and its fields directly
+map to options. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html,Podman}
+upstream documentation for semantics of each value. If the images are not found,
+they will be pulled. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/pull/,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-pull.1.html,Podman}
+upstream documentation for semantics. The
services with @code{(network "host")} are going to be attached to the
host network and are supposed to behave like native processes with regard to
networking.
@end defvar
+@c %start of fragment
+
+@deftp {Data Type} oci-configuration
+Available @code{oci-configuration} fields are:
+
+@table @asis
+@item @code{runtime} (default: @code{'docker}) (type: symbol)
+The OCI runtime to use to run commands. It can be either @code{'docker} or
+@code{'podman}.
+
+@item @code{runtime-cli} (type: maybe-package)
+The OCI runtime command line to be installed in the system profile and used
+to provision OCI resources. When unset it will default to @code{docker-cli}
+package for the @code{'docker} runtime or to @code{podman} package for the
+@code{'podman} runtime.
+
+@item @code{user} (default: @code{"oci-container"}) (type: string)
+The user name under whose authority OCI commands will be run.
+
+@item @code{group} (default: @code{"docker"}) (type: string)
+The group name under whose authority OCI commands will be run. When
+using the @code{'podman} OCI runtime, this field will be ignored and the
+default group of the user configured in the @code{user} field will be used.
+
+@item @code{subuids-range} (type: maybe-subid-range)
+An optional @code{subid-range} record allocating subuids for the user from
+the @code{user} field. When unset, with the rootless Podman OCI runtime, it
+defaults to @code{(subid-range (name "oci-container"))}.
+
+@item @code{subgids-range} (type: maybe-subid-range)
+An optional @code{subid-range} record allocating subgids for the user from
+the @code{user} field. When unset, with the rootless Podman OCI runtime, it
+defaults to @code{(subid-range (name "oci-container"))}.
+
+@item @code{containers} (default: @code{'()}) (type: list-of-oci-containers)
+The list of @code{oci-container-configuration} records representing the
+containers to provision. Most users are supposed not to use this field and use
+the @code{oci-extension} record instead.
+
+@item @code{networks} (default: @code{'()}) (type: list-of-oci-networks)
+The list of @code{oci-network-configuration} records representing the
+containers to provision. Most users are supposed not to use this field and use
+the @code{oci-extension} record instead.
+
+@item @code{volumes} (default: @code{'()}) (type: list-of-oci-volumes)
+The list of @code{oci-volumes-configuration} records representing the
+containers to provision. Most users are supposed not to use this field and use
+the @code{oci-extension} record instead.
+
+@item @code{verbose?} (default: @code{#f}) (type: boolean)
+When true, additional output will be printed, allowing to better follow the
+flow of execution.
+
+@end table
+
+@end deftp
+
+
+@c %end of fragment
+
+@c %start of fragment
+
+@deftp {Data Type} oci-extension
+Available @code{oci-extension} fields are:
+
+@table @asis
+@item @code{containers} (default: @code{'()}) (type: list-of-oci-containers)
+The list of @code{oci-container-configuration} records representing the
+containers to provision.
+
+@item @code{networks} (default: @code{'()}) (type: list-of-oci-networks)
+The list of @code{oci-network-configuration} records representing the
+containers to provision.
+
+@item @code{volumes} (default: @code{'()}) (type: list-of-oci-volumes)
+The list of @code{oci-volumes-configuration} records representing the
+containers to provision.
+
+@end table
+
+@end deftp
+
+
+@c %end of fragment
+
+
@c %start of fragment
@deftp {Data Type} oci-container-configuration
@@ -41850,16 +41946,16 @@ Miscellaneous Services
Overwrite the default entrypoint (@code{ENTRYPOINT}) of the image.
@item @code{host-environment} (default: @code{'()}) (type: list)
-Set environment variables in the host environment where @command{docker
-run} is invoked. This is especially useful to pass secrets from the
-host to the container without having them on the @command{docker run}'s
-command line: by setting the @code{MYSQL_PASSWORD} on the host and by passing
+Set environment variables in the host environment where @command{docker run}
+or @command{podman run} are invoked. This is especially useful to pass secrets
+from the host to the container without having them on the OCI runtime command line,
+for example: by setting the @code{MYSQL_PASSWORD} on the host and by passing
@code{--env MYSQL_PASSWORD} through the @code{extra-arguments} field, it is
possible to securely set values in the container environment. This field's
value can be a list of pairs or strings, even mixed:
@lisp
-(list '("LANGUAGE\" . "eo:ca:eu")
+(list '("LANGUAGE" . "eo:ca:eu")
"JAVA_HOME=/opt/java")
@end lisp
@@ -41867,22 +41963,24 @@ Miscellaneous Services
directly to @code{make-forkexec-constructor}.
@item @code{environment} (default: @code{'()}) (type: list)
-Set environment variables. This can be a list of pairs or strings, even mixed:
+Set environment variables inside the container. This can be a list of pairs
+or strings, even mixed:
@lisp
(list '("LANGUAGE" . "eo:ca:eu")
"JAVA_HOME=/opt/java")
@end lisp
-Pair members can be strings, gexps or file-like objects.
-Strings are passed directly to the Docker CLI. You can refer to the
-@uref{https://docs.docker.com/engine/reference/commandline/run/#env,upstream}
-documentation for semantics.
+Pair members can be strings, gexps or file-like objects. Strings are passed
+directly to the OCI runtime CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#env,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#env-e-env,Podman}
+upstream documentation for semantics.
@item @code{image} (type: string-or-oci-image)
The image used to build the container. It can be a string or an
-@code{oci-image} record. Strings are resolved by the Docker Engine, and
-follow the usual format
+@code{oci-image} record. Strings are resolved by the OCI runtime,
+and follow the usual format
@code{myregistry.local:5000/testing/test-image:tag}.
@item @code{provision} (default: @code{""}) (type: string)
@@ -41910,7 +42008,7 @@ Miscellaneous Services
by the service.
@item @code{network} (default: @code{""}) (type: string)
-Set a Docker network for the spawned container.
+Set an OCI network for the spawned container.
@item @code{ports} (default: @code{'()}) (type: list)
Set the port or port ranges to expose from the spawned container. This can be a
@@ -41921,10 +42019,11 @@ Miscellaneous Services
"10443:443")
@end lisp
-Pair members can be strings, gexps or file-like objects.
-Strings are passed directly to the Docker CLI. You can refer to the
-@uref{https://docs.docker.com/engine/reference/commandline/run/#publish,upstream}
-documentation for semantics.
+Pair members can be strings, gexps or file-like objects. Strings are passed
+directly to the OCI runtime CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#publish,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#publish-p-ip-hostport-containerport-protocol,Podman}
+upstream documentation for semantics.
@item @code{volumes} (default: @code{'()}) (type: list)
Set volume mappings for the spawned container. This can be a
@@ -41935,25 +42034,95 @@ Miscellaneous Services
"/gnu/store:/gnu/store")
@end lisp
-Pair members can be strings, gexps or file-like objects.
-Strings are passed directly to the Docker CLI. You can refer to the
-@uref{https://docs.docker.com/engine/reference/commandline/run/#volume,upstream}
-documentation for semantics.
+Pair members can be strings, gexps or file-like objects. Strings are passed
+directly to the OCI runtime CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#volume,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#volume-v-source-volume-host-dir-container-dir-options,Podman}
+upstream documentation for semantics.
@item @code{container-user} (default: @code{""}) (type: string)
Set the current user inside the spawned container. You can refer to the
-@url{https://docs.docker.com/engine/reference/run/#user,upstream}
-documentation for semantics.
+@url{https://docs.docker.com/engine/reference/run/#user,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#user-u-user-group,Podman}
+upstream documentation for semantics.
@item @code{workdir} (default: @code{""}) (type: string)
Set the current working directory for the spawned Shepherd service.
You can refer to the
-@url{https://docs.docker.com/engine/reference/run/#workdir,upstream}
-documentation for semantics.
+@url{https://docs.docker.com/engine/reference/run/#workdir,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#workdir-w-dir,Podman}
+upstream documentation for semantics.
+
+@item @code{extra-arguments} (default: @code{'()}) (type: list)
+A list of strings, gexps or file-like objects that will be directly passed
+to the @command{docker run} or @command{podman run} invokation.
+
+@end table
+
+@end deftp
+
+
+@c %end of fragment
+
+@c %start of fragment
+
+@deftp {Data Type} oci-network-configuration
+Available @code{oci-network-configuration} fields are:
+
+@table @asis
+@item @code{name} (type: string)
+The name of the OCI network to provision.
+
+@item @code{driver} (type: maybe-string)
+The driver to manage the network.
+
+@item @code{gateway} (type: maybe-string)
+IPv4 or IPv6 gateway for the subnet.
+
+@item @code{internal?} (default: @code{#f}) (type: boolean)
+Restrict external access to the network
+
+@item @code{ip-range} (type: maybe-string)
+Allocate container ip from a sub-range in CIDR format.
+
+@item @code{ipam-driver} (type: maybe-string)
+IP Address Management Driver.
+
+@item @code{ipv6?} (default: @code{#f}) (type: boolean)
+Enable IPv6 networking.
+
+@item @code{subnet} (type: maybe-string)
+Subnet in CIDR format that represents a network segment.
+
+@item @code{labels} (default: @code{'()}) (type: list)
+The list of labels that will be used to tag the current volume.
+
+@item @code{extra-arguments} (default: @code{'()}) (type: list)
+A list of strings, gexps or file-like objects that will be directly
+passed to the runtime invokation.
+
+@end table
+
+@end deftp
+
+
+@c %end of fragment
+
+@c %start of fragment
+
+@deftp {Data Type} oci-volume-configuration
+Available @code{oci-volume-configuration} fields are:
+
+@table @asis
+@item @code{name} (type: string)
+The name of the OCI volume to provision.
+
+@item @code{labels} (default: @code{'()}) (type: list)
+The list of labels that will be used to tag the current volume.
@item @code{extra-arguments} (default: @code{'()}) (type: list)
A list of strings, gexps or file-like objects that will be directly
-passed to the @command{docker run} invocation.
+passed to the runtime invokation.
@end table
diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm
index 50bf6c05549..c45f79c4ed1 100644
--- a/gnu/services/containers.scm
+++ b/gnu/services/containers.scm
@@ -41,6 +41,7 @@ (define-module (gnu services containers)
#:use-module ((guix scripts pack) #:prefix pack:)
#:use-module (guix store)
#:use-module (srfi srfi-1)
+ #:use-module (ice-9 format)
#:use-module (ice-9 match)
#:export (rootless-podman-configuration
rootless-podman-configuration?
@@ -96,8 +97,68 @@ (define-module (gnu services containers)
oci-container-configuration-workdir
oci-container-configuration-extra-arguments
+ list-of-oci-containers?
+ list-of-oci-networks?
+ list-of-oci-volumes?
+
+ %oci-supported-runtimes
+ oci-sanitize-runtime
+ oci-runtime-system-requirement
+ oci-runtime-cli
+ oci-runtime-system-cli
+ oci-runtime-name
+ oci-runtime-group
+
+ oci-network-configuration
+ oci-network-configuration?
+ oci-network-configuration-fields
+ oci-network-configuration-name
+ oci-network-configuration-driver
+ oci-network-configuration-gateway
+ oci-network-configuration-internal?
+ oci-network-configuration-ip-range
+ oci-network-configuration-ipam-driver
+ oci-network-configuration-ipv6?
+ oci-network-configuration-subnet
+ oci-network-configuration-labels
+ oci-network-configuration-extra-arguments
+
+ oci-volume-configuration
+ oci-volume-configuration?
+ oci-volume-configuration-fields
+ oci-volume-configuration-name
+ oci-volume-configuration-labels
+ oci-volume-configuration-extra-arguments
+
+ oci-configuration
+ oci-configuration?
+ oci-configuration-fields
+ oci-configuration-runtime
+ oci-configuration-runtime-cli
+ oci-configuration-user
+ oci-configuration-group
+ oci-configuration-containers
+ oci-configuration-networks
+ oci-configuration-volumes
+ oci-configuration-verbose?
+
+ oci-extension
+ oci-extension?
+ oci-extension-fields
+ oci-extension-containers
+ oci-extension-networks
+ oci-extension-volumes
+
+ oci-networks-shepherd-name
+ oci-volumes-shepherd-name
+
oci-container-shepherd-service
- %oci-container-accounts))
+ oci-service-type
+ oci-service-accounts
+ oci-service-profile
+ oci-service-subids
+ oci-state->shepherd-services
+ oci-configuration->shepherd-services))
(define (gexp-or-string? value)
(or (gexp? value)
@@ -294,9 +355,42 @@ (define rootless-podman-service-type
;;;
-;;; OCI container.
+;;; OCI provisioning service.
;;;
+(define %oci-supported-runtimes
+ '(docker podman))
+
+(define (oci-runtime-system-requirement runtime)
+ "Return a list of Shepherd service names required by a given OCI runtime,
+before it is able to run containers."
+ (if (eq? 'podman runtime)
+ '(cgroups2-fs-owner cgroups2-limits
+ rootless-podman-shared-root-fs)
+ '(dockerd)))
+
+(define (oci-runtime-name runtime)
+ "Return a human readable name for a given OCI runtime."
+ (if (eq? 'podman runtime)
+ "Podman" "Docker"))
+
+(define (oci-runtime-group runtime maybe-group)
+ "Implement the logic behind selection of the group that is to be used by
+Shepherd to execute OCI commands."
+ (if (maybe-value-set? maybe-group)
+ maybe-group
+ (if (eq? 'podman runtime)
+ "cgroup"
+ "docker")))
+
+(define (oci-sanitize-runtime value)
+ (unless (member value %oci-supported-runtimes)
+ (raise
+ (formatted-message
+ (G_ "OCI runtime must be a symbol and one of ~a,
+but ~a was found") %oci-supported-runtimes value)))
+ value)
+
(define (oci-sanitize-pair pair delimiter)
(define (valid? member)
(or (string? member)
@@ -345,6 +439,11 @@ (define (oci-sanitize-volumes value)
;; '(("/mnt/dir" . "/dir") "/run/current-system/profile:/java")
(oci-sanitize-mixed-list "volumes" value ":"))
+(define (oci-sanitize-labels value)
+ ;; Expected spec format:
+ ;; '(("foo" . "bar") "foo=bar")
+ (oci-sanitize-mixed-list "labels" value "="))
+
(define (oci-sanitize-shepherd-actions value)
(map
(lambda (el)
@@ -372,6 +471,7 @@ (define (oci-sanitize-extra-arguments value)
value))
(define (oci-image-reference image)
+ "Return a string OCI image reference representing IMAGE."
(if (string? image)
image
(string-append (oci-image-repository image)
@@ -390,7 +490,19 @@ (define (string-or-oci-image? image)
(define list-of-symbols?
(list-of symbol?))
+(define (list-of-oci-records? name predicate value)
+ (map
+ (lambda (el)
+ (if (predicate el)
+ el
+ (raise
+ (formatted-message
+ (G_ "~a contains an illegal value: ~a") name el))))
+ value))
+
(define-maybe/no-serialization string)
+(define-maybe/no-serialization package)
+(define-maybe/no-serialization subid-range)
(define-configuration/no-serialization oci-image
(repository
@@ -436,10 +548,12 @@ (define-configuration/no-serialization oci-image
(define-configuration/no-serialization oci-container-configuration
(user
(string "oci-container")
- "The user under whose authority docker commands will be run.")
+ "The user name under whose authority OCI commands will be run.")
(group
(string "docker")
- "The group under whose authority docker commands will be run.")
+ "The group name under whose authority OCI commands will be run. When
+using the @code{'podman} OCI runtime, this field will be ignored and the
+default group of the user configured in the @code{user} field will be used.")
(command
(list-of-strings '())
"Overwrite the default command (@code{CMD}) of the image.")
@@ -449,9 +563,9 @@ (define-configuration/no-serialization oci-container-configuration
(host-environment
(list '())
"Set environment variables in the host environment where @command{docker run}
-is invoked. This is especially useful to pass secrets from the host to the
-container without having them on the @command{docker run}'s command line: by
-setting the @code{MYSQL_PASSWORD} on the host and by passing
+or @command{podman run} are invoked. This is especially useful to pass secrets
+from the host to the container without having them on the OCI runtime command line,
+for example: by setting the @code{MYSQL_PASSWORD} on the host and by passing
@code{--env MYSQL_PASSWORD} through the @code{extra-arguments} field, it is
possible to securely set values in the container environment. This field's
value can be a list of pairs or strings, even mixed:
@@ -475,15 +589,16 @@ (define-configuration/no-serialization oci-container-configuration
@end lisp
Pair members can be strings, gexps or file-like objects. Strings are passed
-directly to the Docker CLI. You can refer to the
-@url{https://docs.docker.com/engine/reference/commandline/run/#env,upstream}
-documentation for semantics."
+directly to the OCI runtime CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#env,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#env-e-env,Podman}
+upstream documentation for semantics."
(sanitizer oci-sanitize-environment))
(image
(string-or-oci-image)
"The image used to build the container. It can be a string or an
-@code{oci-image} record. Strings are resolved by the Docker
-Engine, and follow the usual format
+@code{oci-image} record. Strings are resolved by the OCI runtime,
+and follow the usual format
@code{myregistry.local:5000/testing/test-image:tag}.")
(provision
(maybe-string)
@@ -512,7 +627,7 @@ (define-configuration/no-serialization oci-container-configuration
(sanitizer oci-sanitize-shepherd-actions))
(network
(maybe-string)
- "Set a Docker network for the spawned container.")
+ "Set an OCI network for the spawned container.")
(ports
(list '())
"Set the port or port ranges to expose from the spawned container. This can
@@ -524,9 +639,10 @@ (define-configuration/no-serialization oci-container-configuration
@end lisp
Pair members can be strings, gexps or file-like objects. Strings are passed
-directly to the Docker CLI. You can refer to the
-@url{https://docs.docker.com/engine/reference/commandline/run/#publish,upstream}
-documentation for semantics."
+directly to the OCI runtime CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#publish,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#publish-p-ip-hostport-containerport-protocol,Podman}
+upstream documentation for semantics."
(sanitizer oci-sanitize-ports))
(volumes
(list '())
@@ -539,63 +655,307 @@ (define-configuration/no-serialization oci-container-configuration
@end lisp
Pair members can be strings, gexps or file-like objects. Strings are passed
-directly to the Docker CLI. You can refer to the
-@url{https://docs.docker.com/engine/reference/commandline/run/#volume,upstream}
-documentation for semantics."
+directly to the OCI runtime CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#volume,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#volume-v-source-volume-host-dir-container-dir-options,Podman}
+upstream documentation for semantics."
(sanitizer oci-sanitize-volumes))
(container-user
(maybe-string)
"Set the current user inside the spawned container. You can refer to the
-@url{https://docs.docker.com/engine/reference/run/#user,upstream}
-documentation for semantics.")
+@url{https://docs.docker.com/engine/reference/run/#user,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#user-u-user-group,Podman}
+upstream documentation for semantics.")
(workdir
(maybe-string)
- "Set the current working for the spawned Shepherd service.
+ "Set the current working directory for the spawned Shepherd service.
You can refer to the
-@url{https://docs.docker.com/engine/reference/run/#workdir,upstream}
-documentation for semantics.")
+@url{https://docs.docker.com/engine/reference/run/#workdir,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#workdir-w-dir,Podman}
+upstream documentation for semantics.")
(extra-arguments
(list '())
"A list of strings, gexps or file-like objects that will be directly passed
-to the @command{docker run} invokation."
+to the @command{docker run} or @command{podman run} invokation."
(sanitizer oci-sanitize-extra-arguments)))
-(define oci-container-configuration->options
- (lambda (config)
- (let ((entrypoint
- (oci-container-configuration-entrypoint config))
- (network
- (oci-container-configuration-network config))
- (user
- (oci-container-configuration-container-user config))
- (workdir
- (oci-container-configuration-workdir config)))
- (apply append
- (filter (compose not unspecified?)
- `(,(if (maybe-value-set? entrypoint)
- `("--entrypoint" ,entrypoint)
- '())
- ,(append-map
- (lambda (spec)
- (list "--env" spec))
- (oci-container-configuration-environment config))
- ,(if (maybe-value-set? network)
- `("--network" ,network)
- '())
- ,(if (maybe-value-set? user)
- `("--user" ,user)
- '())
- ,(if (maybe-value-set? workdir)
- `("--workdir" ,workdir)
- '())
- ,(append-map
- (lambda (spec)
- (list "-p" spec))
- (oci-container-configuration-ports config))
- ,(append-map
- (lambda (spec)
- (list "-v" spec))
- (oci-container-configuration-volumes config))))))))
+(define (list-of-oci-containers? value)
+ (list-of-oci-records? "containers" oci-container-configuration? value))
+
+(define-configuration/no-serialization oci-volume-configuration
+ (name
+ (string)
+ "The name of the OCI volume to provision.")
+ (labels
+ (list '())
+ "The list of labels that will be used to tag the current volume."
+ (sanitizer oci-sanitize-labels))
+ (extra-arguments
+ (list '())
+ "A list of strings, gexps or file-like objects that will be directly passed
+to the runtime invokation."
+ (sanitizer oci-sanitize-extra-arguments)))
+
+(define (list-of-oci-volumes? value)
+ (list-of-oci-records? "volumes" oci-volume-configuration? value))
+
+(define-configuration/no-serialization oci-network-configuration
+ (name
+ (string)
+ "The name of the OCI network to provision.")
+ (driver
+ (maybe-string)
+ "The driver to manage the network.")
+ (gateway
+ (maybe-string)
+ "IPv4 or IPv6 gateway for the subnet.")
+ (internal?
+ (boolean #f)
+ "Restrict external access to the network")
+ (ip-range
+ (maybe-string)
+ "Allocate container ip from a sub-range in CIDR format.")
+ (ipam-driver
+ (maybe-string)
+ "IP Address Management Driver.")
+ (ipv6?
+ (boolean #f)
+ "Enable IPv6 networking.")
+ (subnet
+ (maybe-string)
+ "Subnet in CIDR format that represents a network segment.")
+ (labels
+ (list '())
+ "The list of labels that will be used to tag the current volume."
+ (sanitizer oci-sanitize-labels))
+ (extra-arguments
+ (list '())
+ "A list of strings, gexps or file-like objects that will be directly passed
+to the runtime invokation."
+ (sanitizer oci-sanitize-extra-arguments)))
+
+(define (list-of-oci-networks? value)
+ (list-of-oci-records? "networks" oci-network-configuration? value))
+
+(define-configuration/no-serialization oci-configuration
+ (runtime
+ (symbol 'docker)
+ "The OCI runtime to use to run commands. It can be either @code{'docker} or
+@code{'podman}."
+ (sanitizer oci-sanitize-runtime))
+ (runtime-cli
+ (maybe-package)
+ "The OCI runtime command line to be installed in the system profile and used
+to provision OCI resources. When unset it will default to @code{docker-cli}
+package for the @code{'docker} runtime or to @code{podman} package for the
+@code{'podman} runtime.")
+ (user
+ (string "oci-container")
+ "The user name under whose authority OCI runtime commands will be run.")
+ (group
+ (maybe-string)
+ "The group name under whose authority OCI commands will be run. When
+using the @code{'podman} OCI runtime, this field will be ignored and the
+default group of the user configured in the @code{user} field will be used.")
+ (subuids-range
+ (maybe-subid-range)
+ "An optional @code{subid-range} record allocating subuids for the user from
+the @code{user} field. When unset, with the rootless Podman OCI runtime, it
+defaults to @code{(subid-range (name \"oci-container\"))}.")
+ (subgids-range
+ (maybe-subid-range)
+ "An optional @code{subid-range} record allocating subgids for the user from
+the @code{user} field. When unset, with the rootless Podman OCI runtime, it
+defaults to @code{(subid-range (name \"oci-container\"))}.")
+ (containers
+ (list-of-oci-containers '())
+ "The list of @code{oci-container-configuration} records representing the
+containers to provision. Most users are supposed not to use this field and use
+the @code{oci-extension} record instead.")
+ (networks
+ (list-of-oci-networks '())
+ "The list of @code{oci-network-configuration} records representing the
+networks to provision. Most users are supposed not to use this field and use
+the @code{oci-extension} record instead.")
+ (volumes
+ (list-of-oci-volumes '())
+ "The list of @code{oci-volume-configuration} records representing the
+volumes to provision. Most users are supposed not to use this field and use
+the @code{oci-extension} record instead.")
+ (verbose?
+ (boolean #f)
+ "When true, additional output will be printed, allowing to better follow the
+flow of execution."))
+
+(define (oci-runtime-cli runtime runtime-cli path)
+ "Return a gexp that, when lowered, evaluates to the file system path of the OCI
+runtime command requested by the user."
+ (if (string? runtime-cli)
+ ;; It is a user defined absolute path
+ runtime-cli
+ #~(string-append
+ (if #$(maybe-value-set? runtime-cli)
+ #$runtime-cli
+ #$path)
+ (if #$(eq? 'podman runtime)
+ "/bin/podman"
+ "/bin/docker"))))
+
+(define* (oci-runtime-system-cli config #:key (path "/run/current-system/profile"))
+ (let ((runtime-cli
+ (oci-configuration-runtime-cli config))
+ (runtime
+ (oci-configuration-runtime config)))
+ (oci-runtime-cli runtime runtime-cli path)))
+
+(define-configuration/no-serialization oci-extension
+ (containers
+ (list-of-oci-containers '())
+ "The list of @code{oci-container-configuration} records representing the
+containers to add.")
+ (networks
+ (list-of-oci-networks '())
+ "The list of @code{oci-network-configuration} records representing the
+networks to add.")
+ (volumes
+ (list-of-oci-volumes '())
+ "The list of @code{oci-volume-configuration} records representing the
+volumes to add."))
+
+(define (oci-image->container-name image)
+ "Infer the name of an OCI backed Shepherd service from its OCI image."
+ (basename
+ (if (string? image)
+ (first (string-split image #\:))
+ (oci-image-repository image))))
+
+(define (oci-object-command-shepherd-action object-name invokation)
+ "Return a Shepherd action printing a given INVOKATION of an OCI command for the
+given OBJECT-NAME."
+ (shepherd-action
+ (name 'command-line)
+ (documentation
+ (format #f "Prints ~a's OCI runtime command line invokation."
+ object-name))
+ (procedure
+ #~(lambda _
+ (format #t "~a~%" #$invokation)))))
+
+(define (oci-container-shepherd-name runtime config)
+ "Return the name of an OCI backed Shepherd service based on CONFIG.
+The name configured in the configuration record is returned when
+CONFIG's name field has a value, otherwise a name is inferred from CONFIG's
+image field."
+ (define name (oci-container-configuration-provision config))
+ (define image (oci-container-configuration-image config))
+
+ (if (maybe-value-set? name)
+ name
+ (string-append (symbol->string runtime) "-"
+ (oci-image->container-name image))))
+
+(define (oci-networks-shepherd-name runtime)
+ "Return the name of the OCI networks provisioning Shepherd service based on
+RUNTIME."
+ (string-append (symbol->string runtime) "-networks"))
+
+(define (oci-volumes-shepherd-name runtime)
+ "Return the name of the OCI volumes provisioning Shepherd service based on
+RUNTIME."
+ (string-append (symbol->string runtime) "-volumes"))
+
+(define (oci-container-configuration->options config)
+ "Map CONFIG, an oci-container-configuration record, to a gexp that, upon
+lowering, will be evaluated to a list of strings containing command line options
+for the OCI runtime run command."
+ (let ((entrypoint
+ (oci-container-configuration-entrypoint config))
+ (network
+ (oci-container-configuration-network config))
+ (user
+ (oci-container-configuration-container-user config))
+ (workdir
+ (oci-container-configuration-workdir config)))
+ (apply append
+ (filter (compose not unspecified?)
+ `(,(if (maybe-value-set? entrypoint)
+ `("--entrypoint" ,entrypoint)
+ '())
+ ,(append-map
+ (lambda (spec)
+ (list "--env" spec))
+ (oci-container-configuration-environment config))
+ ,(if (maybe-value-set? network)
+ `("--network" ,network)
+ '())
+ ,(if (maybe-value-set? user)
+ `("--user" ,user)
+ '())
+ ,(if (maybe-value-set? workdir)
+ `("--workdir" ,workdir)
+ '())
+ ,(append-map
+ (lambda (spec)
+ (list "-p" spec))
+ (oci-container-configuration-ports config))
+ ,(append-map
+ (lambda (spec)
+ (list "-v" spec))
+ (oci-container-configuration-volumes config)))))))
+
+(define (oci-network-configuration->options config)
+ "Map CONFIG, an oci-network-configuration record, to a gexp that, upon
+lowering, will be evaluated to a list of strings containing command line options
+for the OCI runtime network create command."
+ (let ((driver (oci-network-configuration-driver config))
+ (gateway
+ (oci-network-configuration-gateway config))
+ (internal?
+ (oci-network-configuration-internal? config))
+ (ip-range
+ (oci-network-configuration-ip-range config))
+ (ipam-driver
+ (oci-network-configuration-ipam-driver config))
+ (ipv6?
+ (oci-network-configuration-ipv6? config))
+ (subnet
+ (oci-network-configuration-subnet config)))
+ (apply append
+ (filter (compose not unspecified?)
+ `(,(if (maybe-value-set? driver)
+ `("--driver" ,driver)
+ '())
+ ,(if (maybe-value-set? gateway)
+ `("--gateway" ,gateway)
+ '())
+ ,(if internal?
+ `("--internal")
+ '())
+ ,(if (maybe-value-set? ip-range)
+ `("--ip-range" ,ip-range)
+ '())
+ ,(if (maybe-value-set? ipam-driver)
+ `("--ipam-driver" ,ipam-driver)
+ '())
+ ,(if ipv6?
+ `("--ipv6")
+ '())
+ ,(if (maybe-value-set? subnet)
+ `("--subnet" ,subnet)
+ '())
+ ,(append-map
+ (lambda (spec)
+ (list "--label" spec))
+ (oci-network-configuration-labels config)))))))
+
+(define (oci-volume-configuration->options config)
+ "Map CONFIG, an oci-volume-configuration record, to a gexp that, upon
+lowering, will be evaluated to a list of strings containing command line options
+for the OCI runtime volume create command."
+ (append-map
+ (lambda (spec)
+ (list "--label" spec))
+ (oci-volume-configuration-labels config)))
(define* (get-keyword-value args keyword #:key (default #f))
(let ((kv (memq keyword args)))
@@ -604,6 +964,7 @@ (define* (get-keyword-value args keyword #:key (default #f))
default)))
(define (lower-operating-system os target system)
+ "Lower OS, an operating-system record, into a tarball containing an OCI image."
(mlet* %store-monad
((tarball
(lower-object
@@ -613,6 +974,7 @@ (define (lower-operating-system os target system)
(return tarball)))
(define (lower-manifest name image target system)
+ "Lower IMAGE, a manifest record, into a tarball containing an OCI image."
(define value (oci-image-value image))
(define options (oci-image-pack-options image))
(define image-reference
@@ -645,6 +1007,7 @@ (define (lower-manifest name image target system)
(return tarball)))
(define (lower-oci-image name image)
+ "Lower IMAGE, a oci-image record, into a tarball containing an OCI image."
(define value (oci-image-value image))
(define image-target (oci-image-target image))
(define image-system (oci-image-system image))
@@ -675,9 +1038,10 @@ (define (lower-oci-image name image)
#:target target
#:system system)))
-(define (%oci-image-loader name image tag)
- (let ((docker (file-append docker-cli "/bin/docker"))
- (tarball (lower-oci-image name image)))
+(define* (oci-image-loader runtime-cli name image tag #:key (verbose? #f))
+ "Return a file-like object that, once lowered, will evaluate to a program able
+to load IMAGE through RUNTIME-CLI and to tag it with TAG afterwards."
+ (let ((tarball (lower-oci-image name image)))
(with-imported-modules '((guix build utils))
(program-file (format #f "~a-image-loader" name)
#~(begin
@@ -686,102 +1050,536 @@ (define (%oci-image-loader name image tag)
(ice-9 rdelim))
(format #t "Loading image for ~a from ~a...~%" #$name #$tarball)
+ (define load-command
+ (string-append #$runtime-cli
+ " load -i " #$tarball))
+ (when #$verbose?
+ (format #t "Running ~a~%" load-command))
(define line
(read-line
- (open-input-pipe
- (string-append #$docker " load -i " #$tarball))))
+ (open-input-pipe load-command)))
(unless (or (eof-object? line)
(string-null? line))
(format #t "~a~%" line)
- (let ((repository&tag
- (string-drop line
- (string-length
- "Loaded image: "))))
+ (let* ((repository&tag
+ (string-drop line
+ (string-length
+ "Loaded image: ")))
+ (tag-command
+ (list #$runtime-cli "tag" repository&tag #$tag)))
+
+ (when #$verbose?
+ (format #t "Running~{ ~a~}~%" tag-command))
- (invoke #$docker "tag" repository&tag #$tag)
+ (apply invoke tag-command)
(format #t "Tagged ~a with ~a...~%" #$tarball #$tag))))))))
-(define (oci-container-shepherd-service config)
- (define (guess-name name image)
- (if (maybe-value-set? name)
- name
- (string-append "docker-"
- (basename
- (if (string? image)
- (first (string-split image #\:))
- (oci-image-repository image))))))
-
- (let* ((docker (file-append docker-cli "/bin/docker"))
- (actions (oci-container-configuration-shepherd-actions config))
+(define* (oci-container-entrypoint runtime-cli name image image-reference
+ invokation #:key (verbose? #f))
+ "Return a file-like object that, once lowered, will evaluate to the entrypoint
+for the Shepherd service that will run IMAGE through RUNTIME-CLI."
+ (program-file
+ (string-append "oci-entrypoint-" name)
+ #~(begin
+ (use-modules (ice-9 format))
+ (when #$verbose?
+ (format #t "Running in verbose mode..."))
+ (define invokation (list #$@invokation))
+ #$@(if (oci-image? image)
+ #~((system*
+ #$(oci-image-loader
+ runtime-cli name image
+ image-reference #:verbose? verbose?)))
+ #~())
+ (when #$verbose?
+ (format #t "Running~{ ~a~}~%" invokation))
+ (apply execlp invokation))))
+
+(define* (oci-container-shepherd-service runtime runtime-cli config
+ #:key
+ (oci-requirement '())
+ (user #f)
+ (group #f)
+ (verbose? #f))
+ "Return a Shepherd service object that will run the OCI container represented
+by CONFIG through RUNTIME-CLI."
+ (let* ((actions (oci-container-configuration-shepherd-actions config))
(auto-start?
(oci-container-configuration-auto-start? config))
- (user (oci-container-configuration-user config))
- (group (oci-container-configuration-group config))
+ (user (or user (oci-container-configuration-user config)))
+ (group (if (and group (maybe-value-set? group))
+ group
+ (oci-container-configuration-group config)))
(host-environment
(oci-container-configuration-host-environment config))
(command (oci-container-configuration-command config))
(log-file (oci-container-configuration-log-file config))
- (provision (oci-container-configuration-provision config))
(requirement (oci-container-configuration-requirement config))
(respawn?
(oci-container-configuration-respawn? config))
(image (oci-container-configuration-image config))
(image-reference (oci-image-reference image))
(options (oci-container-configuration->options config))
- (name (guess-name provision image))
+ (name
+ (oci-container-shepherd-name runtime config))
(extra-arguments
- (oci-container-configuration-extra-arguments config)))
+ (oci-container-configuration-extra-arguments config))
+ (invokation
+ ;; run [OPTIONS] IMAGE [COMMAND] [ARG...]
+ `(,runtime-cli ,runtime-cli "run"
+ "--rm" "--name" ,name
+ ,@options ,@extra-arguments
+ ,image-reference ,@command)))
(shepherd-service (provision `(,(string->symbol name)))
- (requirement `(dockerd user-processes ,@requirement))
+ (requirement `(,@(oci-runtime-system-requirement runtime)
+ user-processes
+ ,@oci-requirement
+ ,@requirement))
(respawn? respawn?)
(auto-start? auto-start?)
(documentation
(string-append
- "Docker backed Shepherd service for "
+ (oci-runtime-name runtime) " backed Shepherd service for "
(if (oci-image? image) name image) "."))
(start
- #~(lambda ()
- #$@(if (oci-image? image)
- #~((invoke #$(%oci-image-loader
- name image image-reference)))
- #~())
+ #~(lambda _
(fork+exec-command
- ;; docker run [OPTIONS] IMAGE [COMMAND] [ARG...]
- (list #$docker "run" "--rm" "--name" #$name
- #$@options #$@extra-arguments
- #$image-reference #$@command)
+ (list
+ #$(oci-container-entrypoint
+ runtime-cli name image image-reference
+ invokation #:verbose? verbose?))
#:user #$user
- #:group #$group
+ #:group
+ (if #$(eq? runtime 'podman)
+ (group:name
+ (getgrgid
+ (passwd:gid (getpwnam #$user))))
+ #$group)
#$@(if (maybe-value-set? log-file)
(list #:log-file log-file)
'())
#:environment-variables
- (list #$@host-environment))))
+ (append
+ (list #$@host-environment)
+ (if #$(eq? runtime 'podman)
+ (list
+ (string-append
+ "HOME=" (passwd:dir (getpwnam #$user))))
+ '())))))
(stop
#~(lambda _
- (invoke #$docker "rm" "-f" #$name)))
+ (invoke #$runtime-cli "rm" "-f" #$name)))
(actions
- (if (oci-image? image)
- '()
- (append
+ (append
+ (list
+ (oci-object-command-shepherd-action
+ name #~(string-join (cdr (list #$@invokation)) " ")))
+ (if (oci-image? image)
+ '()
(list
- (shepherd-action
- (name 'pull)
- (documentation
- (format #f "Pull ~a's image (~a)."
- name image))
- (procedure
- #~(lambda _
- (invoke #$docker "pull" #$image)))))
- actions))))))
-
-(define %oci-container-accounts
+ (let ((service-name name))
+ (shepherd-action
+ (name 'pull)
+ (documentation
+ (format #f "Pull ~a's image (~a)."
+ service-name image))
+ (procedure
+ #~(lambda _
+ (invoke #$runtime-cli "pull" #$image)))))))
+ actions)))))
+
+(define (oci-object-create-invokation object runtime-cli name options
+ extra-arguments)
+ "Return a gexp that, upon lowering, will evaluate to the OCI runtime
+invokation for creating networks and volumes."
+ ;; network|volume create [options] [NAME]
+ #~(list #$runtime-cli #$object "create"
+ #$@options #$@extra-arguments #$name))
+
+(define (format-oci-invokations invokations)
+ "Return a gexp that, upon lowering, will evaluate to a formatted message
+containing the INVOKATIONS that the OCI runtime will execute to provision
+networks or volumes."
+ #~(string-join (map (lambda (i) (string-join i " "))
+ (list #$@invokations))
+ "\n"))
+
+(define* (oci-object-create-script object runtime runtime-cli invokations
+ #:key (verbose? #f))
+ "Return a file-like object that, once lowered, will evaluate to a program able
+to create OCI networks and volumes through RUNTIME-CLI."
+ (define runtime-string (symbol->string runtime))
+ (program-file
+ (string-append runtime-string "-" object "s-create.scm")
+ #~(begin
+ (use-modules (ice-9 format)
+ (ice-9 match)
+ (ice-9 popen)
+ (ice-9 rdelim)
+ (srfi srfi-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 (object-exists? name)
+ (if (string=? #$runtime-string "podman")
+ (let ((command
+ (list #$runtime-cli
+ #$object "exists" name)))
+ (when #$verbose?
+ (format #t "Running~{ ~a~}~%" command))
+ (define exit-code (status:exit-val (apply system* command)))
+ (when #$verbose?
+ (format #t "Exit code: ~a~%" exit-code))
+ (equal? EXIT_SUCCESS exit-code))
+ (let ((command
+ (string-append #$runtime-cli
+ " " #$object " ls --format "
+ "\"{{.Name}}\"")))
+ (when #$verbose?
+ (format #t "Running ~a~%" command))
+ (member name (read-lines (open-input-pipe command))))))
+
+ (for-each
+ (lambda (invokation)
+ (define name (last invokation))
+ (if (object-exists? name)
+ (format #t "~a ~a ~a already exists, skipping creation.~%"
+ #$(oci-runtime-name runtime) name #$object)
+ (begin
+ (when #$verbose?
+ (format #t "Running~{ ~a~}~%" invokation))
+ (let ((exit-code (status:exit-val (apply system* invokation))))
+ (when #$verbose?
+ (format #t "Exit code: ~a~%" exit-code))))))
+ (list #$@invokations)))))
+
+(define* (oci-object-shepherd-service object runtime runtime-cli name requirement invokations
+ #:key
+ (user #f)
+ (group #f)
+ (verbose? #f))
+ "Return a Shepherd service object that will create the OBJECTs represented
+by INVOKATIONS through RUNTIME-CLI."
+ (shepherd-service (provision `(,(string->symbol name)))
+ (requirement `(user-processes ,@requirement))
+ (one-shot? #t)
+ (documentation
+ (string-append
+ (oci-runtime-name runtime) " " object
+ " provisioning service"))
+ (start
+ #~(lambda _
+ (fork+exec-command
+ (list
+ #$(oci-object-create-script
+ object runtime runtime-cli
+ invokations
+ #:verbose? verbose?))
+ #:user #$user
+ #:group
+ (if #$(eq? runtime 'podman)
+ (group:name
+ (getgrgid
+ (passwd:gid (getpwnam #$user))))
+ #$group)
+ #$@(if (eq? runtime 'podman)
+ (list
+ #:environment-variables
+ #~(list
+ (string-append
+ "HOME=" (passwd:dir (getpwnam #$user)))))
+ '()))))
+ (actions
+ (list
+ (oci-object-command-shepherd-action
+ name (format-oci-invokations invokations))))))
+
+(define* (oci-networks-shepherd-service runtime runtime-cli name networks
+ #:key
+ (user #f)
+ (group #f)
+ (runtime-requirement '())
+ (default-requirement '(networking))
+ (verbose? #f))
+ "Return a Shepherd service object that will create the networks represented
+in CONFIG."
+ (let ((invokations
+ (map
+ (lambda (network)
+ (oci-object-create-invokation
+ "network" runtime-cli
+ (oci-network-configuration-name network)
+ (oci-network-configuration->options network)
+ (oci-network-configuration-extra-arguments network)))
+ networks)))
+
+ (oci-object-shepherd-service
+ "network" runtime runtime-cli name
+ (append default-requirement runtime-requirement) invokations
+ #:user user #:group group #:verbose? verbose?)))
+
+(define* (oci-volumes-shepherd-service runtime runtime-cli name volumes
+ #:key (user #f) (group #f) (verbose? #f)
+ (runtime-requirement '()))
+ "Return a Shepherd service object that will create the volumes represented
+in CONFIG."
+ (let ((invokations
+ (map
+ (lambda (volume)
+ (oci-object-create-invokation
+ "volume" runtime-cli
+ (oci-volume-configuration-name volume)
+ (oci-volume-configuration->options volume)
+ (oci-volume-configuration-extra-arguments volume)))
+ volumes)))
+
+ (oci-object-shepherd-service
+ "volume" runtime runtime-cli name runtime-requirement invokations
+ #:user user #:group group #:verbose? verbose?)))
+
+(define (oci-service-accounts config)
+ (define user (oci-configuration-user config))
+ (define maybe-group (oci-configuration-group config))
+ (define runtime (oci-configuration-runtime config))
(list (user-account
- (name "oci-container")
+ (name user)
(comment "OCI services account")
- (group "docker")
- (system? #t)
- (home-directory "/var/empty")
+ (group "users")
+ (supplementary-groups
+ (list (oci-runtime-group runtime maybe-group)))
+ (system? (eq? 'docker runtime))
+ (home-directory (if (eq? 'podman runtime)
+ (string-append "/home/" user)
+ "/var/empty"))
+ (create-home-directory? (eq? 'podman runtime))
(shell (file-append shadow "/sbin/nologin")))))
+
+(define* (oci-state->shepherd-services runtime runtime-cli containers networks volumes
+ #:key (user #f) (group #f) (verbose? #f)
+ (networks-name #f) (volumes-name #f)
+ (runtime-requirement '())
+ (networks-default-requirement '()))
+ (let* ((networks?
+ (> (length networks) 0))
+ (networks-requirement
+ (if networks?
+ (list
+ (string->symbol
+ (oci-networks-shepherd-name runtime)))
+ '()))
+ (volumes?
+ (> (length volumes) 0))
+ (volumes-requirement
+ (if volumes?
+ (list
+ (string->symbol
+ (oci-volumes-shepherd-name runtime)))
+ '())))
+ (append
+ (map
+ (lambda (c)
+ (oci-container-shepherd-service
+ runtime runtime-cli c
+ #:user user
+ #:group group
+ #:oci-requirement
+ (append networks-requirement volumes-requirement)
+ #:verbose? verbose?))
+ containers)
+ (if networks?
+ (list
+ (oci-networks-shepherd-service
+ runtime runtime-cli
+ (if (string? networks-name)
+ networks-name
+ (oci-networks-shepherd-name runtime))
+ networks
+ #:user user #:group group
+ #:default-requirement networks-default-requirement
+ #:runtime-requirement runtime-requirement
+ #:verbose? verbose?))
+ '())
+ (if volumes?
+ (list
+ (oci-volumes-shepherd-service runtime runtime-cli
+ (if (string? volumes-name)
+ volumes-name
+ (oci-volumes-shepherd-name runtime))
+ volumes
+ #:user user #:group group
+ #:runtime-requirement runtime-requirement
+ #:verbose? verbose?))
+ '()))))
+
+(define (oci-configuration->shepherd-services config)
+ (let* ((runtime (oci-configuration-runtime config))
+ (runtime-cli
+ (oci-runtime-system-cli config))
+ (containers (oci-configuration-containers config))
+ (networks (oci-configuration-networks config))
+ (volumes (oci-configuration-volumes config))
+ (user (oci-configuration-user config))
+ (group (oci-runtime-group
+ runtime (oci-configuration-group config)))
+ (verbose? (oci-configuration-verbose? config)))
+ (oci-state->shepherd-services runtime runtime-cli containers networks volumes
+ #:user user #:group group #:verbose? verbose?
+ #:runtime-requirement
+ (oci-runtime-system-requirement runtime))))
+
+(define (oci-service-subids config)
+ "Return a subids-extension record representing subuids and subgids required by
+the rootless Podman backend."
+ (define (delete-duplicate-ranges ranges)
+ (delete-duplicates ranges
+ (lambda args
+ (apply string=? (map subid-range-name ranges)))))
+ (define runtime
+ (oci-configuration-runtime config))
+ (define user
+ (oci-configuration-user config))
+ (define subgids (oci-configuration-subgids-range config))
+ (define subuids (oci-configuration-subuids-range config))
+ (define container-users
+ (filter (lambda (range) (not (string=? (subid-range-name range) user)))
+ (map (lambda (container)
+ (subid-range
+ (name
+ (oci-container-configuration-user container))))
+ (oci-configuration-containers config))))
+ (define subgid-ranges
+ (delete-duplicate-ranges
+ (cons
+ (if (maybe-value-set? subgids)
+ subgids
+ (subid-range (name user)))
+ container-users)))
+ (define subuid-ranges
+ (delete-duplicate-ranges
+ (cons
+ (if (maybe-value-set? subuids)
+ subuids
+ (subid-range (name user)))
+ container-users)))
+
+ (if (eq? 'podman runtime)
+ (subids-extension
+ (subgids
+ subgid-ranges)
+ (subuids
+ subuid-ranges))
+ (subids-extension)))
+
+(define (oci-objects-merge-lst a b object get-name)
+ (define (contains? value lst)
+ (member value (map get-name lst)))
+ (let loop ((merged '())
+ (lst (append a b)))
+ (if (null? lst)
+ merged
+ (loop
+ (let ((element (car lst)))
+ (when (contains? element merged)
+ (raise
+ (formatted-message
+ (G_ "Duplicated ~a: ~a. ~as names should be unique, please
+remove the duplicate.") object (get-name element) object)))
+ (cons element merged))
+ (cdr lst)))))
+
+(define (oci-extension-merge a b)
+ (oci-extension
+ (containers (oci-objects-merge-lst
+ (oci-extension-containers a)
+ (oci-extension-containers b)
+ "container"
+ (lambda (config)
+ (define maybe-name (oci-container-configuration-provision config))
+ (if (maybe-value-set? maybe-name)
+ maybe-name
+ (oci-image->container-name
+ (oci-container-configuration-image config))))))
+ (networks (oci-objects-merge-lst
+ (oci-extension-networks a)
+ (oci-extension-networks b)
+ "network"
+ oci-networks-shepherd-name))
+ (volumes (oci-objects-merge-lst
+ (oci-extension-volumes a)
+ (oci-extension-volumes b)
+ "volume"
+ oci-volumes-shepherd-name))))
+
+(define (oci-service-profile runtime runtime-cli)
+ (list bash-minimal
+ (cond
+ ((maybe-value-set? runtime-cli)
+ runtime-cli)
+ ((eq? 'podman runtime)
+ podman)
+ (else
+ docker-cli))))
+
+(define oci-service-type
+ (service-type (name 'oci)
+ (extensions
+ (list
+ (service-extension profile-service-type
+ (lambda (config)
+ (let ((runtime-cli
+ (oci-configuration-runtime-cli config))
+ (runtime
+ (oci-configuration-runtime config)))
+ (oci-service-profile runtime runtime-cli))))
+ (service-extension subids-service-type
+ oci-service-subids)
+ (service-extension account-service-type
+ oci-service-accounts)
+ (service-extension shepherd-root-service-type
+ oci-configuration->shepherd-services)))
+ ;; Concatenate OCI object lists.
+ (compose (lambda (args)
+ (fold oci-extension-merge
+ (oci-extension)
+ args)))
+ (extend
+ (lambda (config extension)
+ (oci-configuration
+ (inherit config)
+ (containers
+ (oci-objects-merge-lst
+ (oci-configuration-containers config)
+ (oci-extension-containers extension)
+ "container"
+ (lambda (oci-config)
+ (define runtime
+ (oci-configuration-runtime config))
+ (oci-container-shepherd-name runtime oci-config))))
+ (networks (oci-objects-merge-lst
+ (oci-configuration-networks config)
+ (oci-extension-networks extension)
+ "network"
+ oci-networks-shepherd-name))
+ (volumes (oci-objects-merge-lst
+ (oci-configuration-volumes config)
+ (oci-extension-volumes extension)
+ "volume"
+ oci-volumes-shepherd-name)))))
+ (default-value (oci-configuration))
+ (description
+ "This service implements the provisioning of OCI object such
+as containers, networks and volumes.")))
diff --git a/gnu/services/docker.scm b/gnu/services/docker.scm
index 69ff9f1d9e4..98ee175873d 100644
--- a/gnu/services/docker.scm
+++ b/gnu/services/docker.scm
@@ -31,7 +31,10 @@ (define-module (gnu services docker)
#:use-module (gnu system shadow)
#:use-module (gnu packages docker)
#:use-module (gnu packages linux) ;singularity
+ #:use-module (guix deprecation)
+ #:use-module (guix diagnostics)
#:use-module (guix gexp)
+ #:use-module (guix i18n)
#:use-module (guix records)
#:use-module (srfi srfi-1)
#:use-module (ice-9 format)
@@ -67,16 +70,18 @@ (define-module (gnu services docker)
oci-container-configuration-volumes
oci-container-configuration-container-user
oci-container-configuration-workdir
- oci-container-configuration-extra-arguments
- oci-container-shepherd-service
- %oci-container-accounts)
+ oci-container-configuration-extra-arguments)
#:export (containerd-configuration
containerd-service-type
docker-configuration
docker-service-type
singularity-service-type
- oci-container-service-type))
+ ;; for backwards compatibility, until the
+ ;; oci-container-service-type is fully deprecated
+ oci-container-shepherd-service
+ oci-container-service-type
+ %oci-container-accounts))
(define-maybe file-like)
@@ -295,17 +300,25 @@ (define singularity-service-type
;;; OCI container.
;;;
-(define (configs->shepherd-services configs)
- (map oci-container-shepherd-service configs))
+;; for backwards compatibility, until the
+;; oci-container-service-type is fully deprecated
+(define-deprecated (oci-container-shepherd-service config)
+ oci-service-type
+ ((@ (gnu services containers) oci-container-shepherd-service)
+ 'docker config))
+(define %oci-container-accounts
+ (filter user-account? (oci-service-accounts (oci-configuration))))
(define oci-container-service-type
(service-type (name 'oci-container)
- (extensions (list (service-extension profile-service-type
- (lambda _ (list docker-cli)))
- (service-extension account-service-type
- (const %oci-container-accounts))
- (service-extension shepherd-root-service-type
- configs->shepherd-services)))
+ (extensions
+ (list (service-extension oci-service-type
+ (lambda (containers)
+ (warning
+ (G_
+ "'oci-container-service-type' is deprecated, use 'oci-service-type' instead~%"))
+ (oci-extension
+ (containers containers))))))
(default-value '())
(extend append)
(compose concatenate)
diff --git a/gnu/tests/containers.scm b/gnu/tests/containers.scm
index 0ecc8ddb126..719647c298e 100644
--- a/gnu/tests/containers.scm
+++ b/gnu/tests/containers.scm
@@ -27,6 +27,9 @@ (define-module (gnu tests containers)
#:use-module (gnu services)
#:use-module (gnu services containers)
#:use-module (gnu services desktop)
+ #:use-module ((gnu services docker)
+ #:select (containerd-service-type
+ docker-service-type))
#:use-module (gnu services dbus)
#:use-module (gnu services networking)
#:use-module (gnu system)
@@ -39,7 +42,9 @@ (define-module (gnu tests containers)
#:use-module (guix profiles)
#:use-module ((guix scripts pack) #:prefix pack:)
#:use-module (guix store)
- #:export (%test-rootless-podman))
+ #:export (%test-rootless-podman
+ %test-oci-service-rootless-podman
+ %test-oci-service-docker))
(define %rootless-podman-os
@@ -345,3 +350,952 @@ (define %test-rootless-podman
(name "rootless-podman")
(description "Test rootless Podman service.")
(value (build-tarball&run-rootless-podman-test))))
+
+
+(define %guile-oci-image
+ (oci-image
+ (repository "guile")
+ (value
+ (specifications->manifest '("guile")))
+ (pack-options
+ '(#:symlinks (("/bin" -> "bin"))))))
+
+(define %oci-test-containers
+ (list
+ (oci-container-configuration
+ (provision "first")
+ (image %guile-oci-image)
+ (entrypoint "/bin/guile")
+ (network "my-network")
+ (command
+ '("-c" "(use-modules (web server))
+(define (handler request request-body)
+ (values '((content-type . (text/plain))) \"out of office\"))
+(run-server handler 'http `(#:addr ,(inet-pton AF_INET \"0.0.0.0\")))"))
+ (host-environment
+ '(("VARIABLE" . "value")))
+ (volumes
+ '(("my-volume" . "/my-volume")))
+ (extra-arguments
+ '("--env" "VARIABLE")))
+ (oci-container-configuration
+ (provision "second")
+ (image %guile-oci-image)
+ (entrypoint "/bin/guile")
+ (network "my-network")
+ (command
+ '("-c" "(let l ((c 300))(display c)(sleep 1)(when(positive? c)(l (- c 1))))"))
+ (volumes
+ '(("my-volume" . "/my-volume")
+ ("/shared.txt" . "/shared.txt:ro"))))))
+
+(define %oci-extension-test
+ (oci-extension
+ (networks
+ (list (oci-network-configuration (name "my-network"))))
+ (volumes
+ (list (oci-volume-configuration (name "my-volume"))))
+ (containers %oci-test-containers)))
+
+(define %oci-rootless-podman-os
+ (simple-operating-system
+ (service dhcp-client-service-type)
+ (service dbus-root-service-type)
+ (service polkit-service-type)
+ (service elogind-service-type)
+ (service iptables-service-type)
+ (service rootless-podman-service-type)
+ (extra-special-file "/shared.txt"
+ (plain-file "shared.txt" "hello"))
+ (service oci-service-type
+ (oci-configuration
+ (runtime 'podman)
+ (verbose? #t)))
+ (simple-service 'oci-provisioning
+ oci-service-type
+ %oci-extension-test)))
+
+(define (run-rootless-podman-oci-service-test)
+ (define os
+ (marionette-operating-system
+ (operating-system-with-gc-roots
+ %oci-rootless-podman-os
+ (list))
+ #: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))
+ #~(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-oci-service")
+
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (wait-for-service 'user-processes))
+ marionette)
+
+ (test-assert "rootless-podman services started successfully"
+ (begin
+ (define (run-test)
+ (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))
+ ;; Allow services to come up on slower machines
+ (let loop ((attempts 0))
+ (if (= attempts 60)
+ (error "Services didn't come up after more than 60 seconds")
+ (if (equal? '("cgroup" "cgroup")
+ (run-test))
+ #t
+ (begin
+ (sleep 1)
+ (format #t "Services didn't come up yet, retrying with attempt ~a~%"
+ (+ 1 attempts))
+ (loop (+ 1 attempts))))))))
+
+ (test-assert "podman-volumes running"
+ (begin
+ (define (run-test)
+ (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 6))
+ (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 "oci-container")))
+ (setuid (passwd:uid (getpw "oci-container")))
+
+ (let ((response (slurp
+ "/run/current-system/profile/bin/podman"
+ "volume" "ls" "-n" "--format" "\"{{.Name}}\""
+ "|" "tr" "' '" "'\n'")))
+
+ (call-with-output-file (string-append ,out-dir "/response")
+ (lambda (port)
+ (display (string-join response "\n") port)))))
+ (lambda ()
+ (primitive-exit 127))))
+ (pid
+ (cdr (waitpid pid))))
+
+ (wait-for-file (string-append ,out-dir "/response"))
+
+ (stable-sort
+ (slurp "cat" (string-append ,out-dir "/response"))
+ string<=?))
+ marionette))
+ ;; Allow services to come up on slower machines
+ (let loop ((attempts 0))
+ (if (= attempts 80)
+ (error "Service didn't come up after more than 80 seconds")
+ (if (equal? '("my-volume")
+ (run-test))
+ #t
+ (begin
+ (sleep 1)
+ (loop (+ 1 attempts))))))))
+
+ (test-assert "podman-networks running"
+ (begin
+ (define (run-test)
+ (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 6))
+ (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 "oci-container")))
+ (setuid (passwd:uid (getpw "oci-container")))
+
+ (let ((response (slurp
+ "/run/current-system/profile/bin/podman"
+ "network" "ls" "-n" "--format" "\"{{.Name}}\""
+ "|" "tr" "' '" "'\n'")))
+
+ (call-with-output-file (string-append ,out-dir "/response")
+ (lambda (port)
+ (display (string-join response "\n") port)))))
+ (lambda ()
+ (primitive-exit 127))))
+ (pid
+ (cdr (waitpid pid))))
+
+ (wait-for-file (string-append ,out-dir "/response"))
+
+ (stable-sort
+ (slurp "cat" (string-append ,out-dir "/response"))
+ string<=?))
+ marionette))
+ ;; Allow services to come up on slower machines
+ (let loop ((attempts 0))
+ (if (= attempts 80)
+ (error "Service didn't come up after more than 80 seconds")
+ (if (equal? '("my-network" "podman")
+ (run-test))
+ #t
+ (begin
+ (sleep 1)
+ (loop (+ 1 attempts))))))))
+
+ (test-assert "first container running"
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (wait-for-service 'first #:timeout 120)
+ #t)
+ marionette))
+
+ (test-assert "second container running"
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (wait-for-service 'second #:timeout 120)
+ #t)
+ marionette))
+
+ (test-assert "passing host environment variables"
+ (begin
+ (define (run-test)
+ (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 "oci-container")))
+ (setuid (passwd:uid (getpw "oci-container")))
+
+ (let ((response (slurp
+ "/run/current-system/profile/bin/podman"
+ "exec" "first"
+ "/bin/guile" "-c" "'(display (getenv \"VARIABLE\"))'")))
+ (call-with-output-file (string-append ,out-dir "/response")
+ (lambda (port)
+ (display (string-join response "\n") port)))))
+ (lambda ()
+ (primitive-exit 127))))
+ (pid
+ (cdr (waitpid pid))))
+
+ (wait-for-file (string-append ,out-dir "/response"))
+ (slurp "cat" (string-append ,out-dir "/response")))
+ marionette))
+ ;; Allow image to be loaded on slower machines
+ (let loop ((attempts 0))
+ (if (= attempts 180)
+ (error "Service didn't come up after more than 180 seconds")
+ (if (equal? (list "value")
+ (run-test))
+ #t
+ (begin
+ (sleep 1)
+ (loop (+ 1 attempts))))))))
+
+ (test-equal "mounting host files"
+ '("hello")
+ (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 "oci-container")))
+ (setuid (passwd:uid (getpw "oci-container")))
+
+ (let ((response (slurp
+ "/run/current-system/profile/bin/podman"
+ "exec" "second"
+ "/bin/guile" "-c" "'(begin (use-modules (ice-9 popen) (ice-9 rdelim))
+(display (call-with-input-file \"/shared.txt\" read-line)))'")))
+ (call-with-output-file (string-append ,out-dir "/response")
+ (lambda (port)
+ (display (string-join response " ") port)))))
+ (lambda ()
+ (primitive-exit 127))))
+ (pid
+ (cdr (waitpid pid))))
+
+ (wait-for-file (string-append ,out-dir "/response"))
+ (slurp "cat" (string-append ,out-dir "/response")))
+ marionette))
+
+ (test-equal "write to volumes"
+ '("world")
+ (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 "oci-container")))
+ (setuid (passwd:uid (getpw "oci-container")))
+
+ (slurp
+ "/run/current-system/profile/bin/podman"
+ "exec" "first"
+ "/bin/guile" "-c" "'(begin (use-modules (ice-9 popen) (ice-9 rdelim))
+(call-with-output-file \"/my-volume/out.txt\" (lambda (p) (display \"world\" p))))'")
+
+ (let ((response (slurp
+ "/run/current-system/profile/bin/podman"
+ "exec" "second"
+ "/bin/guile" "-c" "'(begin (use-modules (ice-9 popen) (ice-9 rdelim))
+(display (call-with-input-file \"/my-volume/out.txt\" read-line)))'")))
+ (call-with-output-file (string-append ,out-dir "/response")
+ (lambda (port)
+ (display (string-join response " ") port)))))
+ (lambda ()
+ (primitive-exit 127))))
+ (pid
+ (cdr (waitpid pid))))
+
+ (wait-for-file (string-append ,out-dir "/response"))
+ (slurp "cat" (string-append ,out-dir "/response")))
+ marionette))
+
+ (test-equal "can read ports over network"
+ '("out of office")
+ (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 "oci-container")))
+ (setuid (passwd:uid (getpw "oci-container")))
+
+ (let ((response (slurp
+ "/run/current-system/profile/bin/podman"
+ "exec" "second"
+ "/bin/guile" "-c" "'(begin (use-modules (web client))
+(define-values (response out)
+ (http-get \"http://first:8080\"))
+(display out))'")))
+ (call-with-output-file (string-append ,out-dir "/response")
+ (lambda (port)
+ (display (string-join response " ") port)))))
+ (lambda ()
+ (primitive-exit 127))))
+ (pid
+ (cdr (waitpid pid))))
+
+ (wait-for-file (string-append ,out-dir "/response"))
+ (slurp "cat" (string-append ,out-dir "/response")))
+ marionette))
+
+ (test-end))))
+
+ (gexp->derivation "rootless-podman-oci-service-test" test))
+
+(define %test-oci-service-rootless-podman
+ (system-test
+ (name "oci-service-rootless-podman")
+ (description "Test Rootless-Podman backed OCI provisioning service.")
+ (value (run-rootless-podman-oci-service-test))))
+
+(define %oci-docker-os
+ (simple-operating-system
+ (service dhcp-client-service-type)
+ (service dbus-root-service-type)
+ (service polkit-service-type)
+ (service elogind-service-type)
+ (service containerd-service-type)
+ (service docker-service-type)
+ (extra-special-file "/shared.txt"
+ (plain-file "shared.txt" "hello"))
+ (service oci-service-type
+ (oci-configuration
+ (verbose? #t)))
+ (simple-service 'oci-provisioning
+ oci-service-type
+ %oci-extension-test)))
+
+(define (run-docker-oci-service-test)
+ (define os
+ (marionette-operating-system
+ (operating-system-with-gc-roots
+ %oci-docker-os
+ (list))
+ #: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))
+ #~(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))
+
+ (test-runner-current (system-test-runner #$output))
+ (test-begin "docker-oci-service")
+
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (wait-for-service 'dockerd))
+ marionette)
+
+ (test-assert "docker-volumes running"
+ (begin
+ (define (run-test)
+ (marionette-eval
+ `(begin
+ (use-modules (ice-9 popen)
+ (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
+ (list "sh" "-l" "-c"
+ (string-join
+ args
+ " "))))
+ (output (read-lines port))
+ (status (close-pipe port)))
+ output)))
+
+ (stable-sort
+ (slurp
+ "/run/current-system/profile/bin/docker"
+ "volume" "ls" "--format" "\"{{.Name}}\"")
+ string<=?))
+
+ marionette))
+ ;; Allow services to come up on slower machines
+ (let loop ((attempts 0))
+ (if (= attempts 80)
+ (error "Service didn't come up after more than 80 seconds")
+ (if (equal? '("my-volume")
+ (run-test))
+ #t
+ (begin
+ (sleep 1)
+ (loop (+ 1 attempts))))))))
+
+ (test-assert "docker-networks running"
+ (begin
+ (define (run-test)
+ (marionette-eval
+ `(begin
+ (use-modules (ice-9 popen)
+ (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
+ (list "sh" "-l" "-c"
+ (string-join
+ args
+ " "))))
+ (output (read-lines port))
+ (status (close-pipe port)))
+ output)))
+
+ (stable-sort
+ (slurp
+ "/run/current-system/profile/bin/docker"
+ "network" "ls" "--format" "\"{{.Name}}\"")
+ string<=?))
+
+ marionette))
+ ;; Allow services to come up on slower machines
+ (let loop ((attempts 0))
+ (if (= attempts 80)
+ (error "Service didn't come up after more than 80 seconds")
+ (if (equal? '("bridge" "host" "my-network" "none")
+ (run-test))
+ #t
+ (begin
+ (sleep 1)
+ (loop (+ 1 attempts))))))))
+
+ (test-assert "first container running"
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (wait-for-service 'first #:timeout 120)
+ #t)
+ marionette))
+
+ (test-assert "second container running"
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (wait-for-service 'second #:timeout 120)
+ #t)
+ marionette))
+
+ (test-assert "passing host environment variables"
+ (begin
+ (define (run-test)
+ (marionette-eval
+ `(begin
+ (use-modules (ice-9 popen)
+ (ice-9 rdelim))
+
+ (define slurp
+ (lambda args
+ (let* ((port (apply open-pipe* OPEN_READ args))
+ (output (let ((line (read-line port)))
+ (if (eof-object? line)
+ ""
+ line)))
+ (status (close-pipe port)))
+ output)))
+
+ (slurp
+ "/run/current-system/profile/bin/docker"
+ "exec" "first"
+ "/bin/guile" "-c" "(display (getenv \"VARIABLE\"))"))
+ marionette))
+ ;; Allow image to be loaded on slower machines
+ (let loop ((attempts 0))
+ (if (= attempts 180)
+ (error "Service didn't come up after more than 180 seconds")
+ (if (equal? "value"
+ (run-test))
+ #t
+ (begin
+ (sleep 1)
+ (loop (+ 1 attempts))))))))
+
+ (test-equal "mounting host files"
+ "hello"
+ (marionette-eval
+ `(begin
+ (use-modules (ice-9 popen)
+ (ice-9 rdelim))
+
+ (define slurp
+ (lambda args
+ (let* ((port (apply open-pipe* OPEN_READ args))
+ (output (let ((line (read-line port)))
+ (if (eof-object? line)
+ ""
+ line)))
+ (status (close-pipe port)))
+ output)))
+
+ (slurp
+ "/run/current-system/profile/bin/docker"
+ "exec" "second"
+ "/bin/guile" "-c" "(begin (use-modules (ice-9 popen) (ice-9 rdelim))
+(display (call-with-input-file \"/shared.txt\" read-line)))"))
+ marionette))
+
+ (test-equal "write to volumes"
+ "world"
+ (marionette-eval
+ `(begin
+ (use-modules (ice-9 popen)
+ (ice-9 rdelim))
+
+ (define slurp
+ (lambda args
+ (let* ((port (apply open-pipe* OPEN_READ args))
+ (output (let ((line (read-line port)))
+ (if (eof-object? line)
+ ""
+ line)))
+ (status (close-pipe port)))
+ output)))
+
+ (slurp
+ "/run/current-system/profile/bin/docker"
+ "exec" "first"
+ "/bin/guile" "-c" "(begin (use-modules (ice-9 popen) (ice-9 rdelim))
+(call-with-output-file \"/my-volume/out.txt\" (lambda (p) (display \"world\" p))))")
+ (slurp
+ "/run/current-system/profile/bin/docker"
+ "exec" "second"
+ "/bin/guile" "-c" "(begin (use-modules (ice-9 popen) (ice-9 rdelim))
+(display (call-with-input-file \"/my-volume/out.txt\" read-line)))"))
+ marionette))
+
+ (test-equal "can read ports over network"
+ "out of office"
+ (marionette-eval
+ `(begin
+ (use-modules (ice-9 popen)
+ (ice-9 rdelim))
+
+ (define slurp
+ (lambda args
+ (let* ((port (apply open-pipe* OPEN_READ args))
+ (output (let ((line (read-line port)))
+ (if (eof-object? line)
+ ""
+ line)))
+ (status (close-pipe port)))
+ output)))
+
+ (slurp
+ "/run/current-system/profile/bin/docker"
+ "exec" "second"
+ "/bin/guile" "-c" "(begin (use-modules (web client))
+(define-values (response out)
+ (http-get \"http://first:8080\"))
+(display out))"))
+ marionette))
+
+ (test-end))))
+
+ (gexp->derivation "docker-oci-service-test" test))
+
+(define %test-oci-service-docker
+ (system-test
+ (name "oci-service-docker")
+ (description "Test Docker backed OCI provisioning service.")
+ (value (run-docker-oci-service-test))))
--
2.48.1
guix-patches <at> gnu.org:bug#76081; Package guix-patches.
(Wed, 05 Feb 2025 22:04:03 GMT) Full text and rfc822 format available.Message #17 received at 76081 <at> debbugs.gnu.org (full text, mbox):
From: Giacomo Leidi <goodoldpaul <at> autistici.org> To: 76081 <at> debbugs.gnu.org Cc: Giacomo Leidi <goodoldpaul <at> autistici.org> Subject: [PATCH 2/4] services: oci-container-configuration: Move to (gnu services containers). Date: Wed, 5 Feb 2025 23:02:29 +0100
This patch moves the oci-container-configuration and related
configuration records to (gnu services containers).
Public symbols are still exported for backwards
compatibility but since the oci-container-service-type will be
deprecated in favor of the more general oci-service-type, everything is
moved outside of the docker related module.
* gnu/services/docker.scm: Move everything related to oci-container-configuration
to...
* gnu/services/containers.scm: ...here.scm.
* gnu/tests/docker.scm: Simplify %test-oci-container test case.
Change-Id: Iae599dd5cc7442eb632f0c1b3b12f6b928397ae7
---
gnu/services/containers.scm | 549 +++++++++++++++++++++++++++++++++-
gnu/services/docker.scm | 577 +++---------------------------------
gnu/tests/docker.scm | 99 +++----
3 files changed, 625 insertions(+), 600 deletions(-)
diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm
index dc66ac4f967..50bf6c05549 100644
--- a/gnu/services/containers.scm
+++ b/gnu/services/containers.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2024 Giacomo Leidi <goodoldpaul <at> autistici.org>
+;;; Copyright © 2024, 2025 Giacomo Leidi <goodoldpaul <at> autistici.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -17,19 +17,31 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu services containers)
+ #:use-module (gnu image)
+ #:use-module (gnu packages admin)
#:use-module (gnu packages bash)
#:use-module (gnu packages containers)
+ #:use-module (gnu packages docker)
#: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)
#:use-module (gnu system accounts)
+ #:use-module (gnu system image)
#:use-module (gnu system shadow)
#:use-module (gnu system pam)
+ #:use-module (guix diagnostics)
#:use-module (guix gexp)
+ #:use-module (guix i18n)
+ #:use-module (guix monads)
#:use-module (guix packages)
+ #:use-module (guix profiles)
+ #:use-module ((guix scripts pack) #:prefix pack:)
+ #:use-module (guix store)
#:use-module (srfi srfi-1)
+ #:use-module (ice-9 match)
#:export (rootless-podman-configuration
rootless-podman-configuration?
rootless-podman-configuration-fields
@@ -48,7 +60,44 @@ (define-module (gnu services containers)
rootless-podman-shepherd-services
rootless-podman-service-etc
- rootless-podman-service-type))
+ rootless-podman-service-type
+
+ oci-image
+ oci-image?
+ oci-image-fields
+ oci-image-repository
+ oci-image-tag
+ oci-image-value
+ oci-image-pack-options
+ oci-image-target
+ oci-image-system
+ oci-image-grafts?
+
+ oci-container-configuration
+ oci-container-configuration?
+ oci-container-configuration-fields
+ oci-container-configuration-user
+ oci-container-configuration-group
+ oci-container-configuration-command
+ oci-container-configuration-entrypoint
+ oci-container-configuration-host-environment
+ oci-container-configuration-environment
+ oci-container-configuration-image
+ oci-container-configuration-provision
+ oci-container-configuration-requirement
+ oci-container-configuration-log-file
+ oci-container-configuration-auto-start?
+ oci-container-configuration-respawn?
+ oci-container-configuration-shepherd-actions
+ oci-container-configuration-network
+ oci-container-configuration-ports
+ oci-container-configuration-volumes
+ oci-container-configuration-container-user
+ oci-container-configuration-workdir
+ oci-container-configuration-extra-arguments
+
+ oci-container-shepherd-service
+ %oci-container-accounts))
(define (gexp-or-string? value)
(or (gexp? value)
@@ -188,7 +237,7 @@ (define (rootless-podman-cgroups-limits-service config)
rootless-podman-shared-root-fs))
(one-shot? #t)
(documentation
- "Allow setting cgroups limits: cpu, cpuset, memory and
+ "Allow setting cgroups limits: cpu, cpuset, io, memory and
pids.")
(start
#~(make-forkexec-constructor
@@ -242,3 +291,497 @@ (define rootless-podman-service-type
(default-value (rootless-podman-configuration))
(description
"This service configures rootless @code{podman} on the Guix System.")))
+
+
+;;;
+;;; OCI container.
+;;;
+
+(define (oci-sanitize-pair pair delimiter)
+ (define (valid? member)
+ (or (string? member)
+ (gexp? member)
+ (file-like? member)))
+ (match pair
+ (((? valid? key) . (? valid? value))
+ #~(string-append #$key #$delimiter #$value))
+ (_
+ (raise
+ (formatted-message
+ (G_ "pair members must contain only strings, gexps or file-like objects
+but ~a was found")
+ pair)))))
+
+(define (oci-sanitize-mixed-list name value delimiter)
+ (map
+ (lambda (el)
+ (cond ((string? el) el)
+ ((pair? el) (oci-sanitize-pair el delimiter))
+ (else
+ (raise
+ (formatted-message
+ (G_ "~a members must be either a string or a pair but ~a was
+found!")
+ name el)))))
+ value))
+
+(define (oci-sanitize-host-environment value)
+ ;; Expected spec format:
+ ;; '(("HOME" . "/home/nobody") "JAVA_HOME=/java")
+ (oci-sanitize-mixed-list "host-environment" value "="))
+
+(define (oci-sanitize-environment value)
+ ;; Expected spec format:
+ ;; '(("HOME" . "/home/nobody") "JAVA_HOME=/java")
+ (oci-sanitize-mixed-list "environment" value "="))
+
+(define (oci-sanitize-ports value)
+ ;; Expected spec format:
+ ;; '(("8088" . "80") "2022:22")
+ (oci-sanitize-mixed-list "ports" value ":"))
+
+(define (oci-sanitize-volumes value)
+ ;; Expected spec format:
+ ;; '(("/mnt/dir" . "/dir") "/run/current-system/profile:/java")
+ (oci-sanitize-mixed-list "volumes" value ":"))
+
+(define (oci-sanitize-shepherd-actions value)
+ (map
+ (lambda (el)
+ (if (shepherd-action? el)
+ el
+ (raise
+ (formatted-message
+ (G_ "shepherd-actions may only be shepherd-action records
+but ~a was found") el))))
+ value))
+
+(define (oci-sanitize-extra-arguments value)
+ (define (valid? member)
+ (or (string? member)
+ (gexp? member)
+ (file-like? member)))
+ (map
+ (lambda (el)
+ (if (valid? el)
+ el
+ (raise
+ (formatted-message
+ (G_ "extra arguments may only be strings, gexps or file-like objects
+but ~a was found") el))))
+ value))
+
+(define (oci-image-reference image)
+ (if (string? image)
+ image
+ (string-append (oci-image-repository image)
+ ":" (oci-image-tag image))))
+
+(define (oci-lowerable-image? image)
+ (or (manifest? image)
+ (operating-system? image)
+ (gexp? image)
+ (file-like? image)))
+
+(define (string-or-oci-image? image)
+ (or (string? image)
+ (oci-image? image)))
+
+(define list-of-symbols?
+ (list-of symbol?))
+
+(define-maybe/no-serialization string)
+
+(define-configuration/no-serialization oci-image
+ (repository
+ (string)
+ "A string like @code{myregistry.local:5000/testing/test-image} that names
+the OCI image.")
+ (tag
+ (string "latest")
+ "A string representing the OCI image tag. Defaults to @code{latest}.")
+ (value
+ (oci-lowerable-image)
+ "A @code{manifest} or @code{operating-system} record that will be lowered
+into an OCI compatible tarball. Otherwise this field's value can be a gexp
+or a file-like object that evaluates to an OCI compatible tarball.")
+ (pack-options
+ (list '())
+ "An optional set of keyword arguments that will be passed to the
+@code{docker-image} procedure from @code{guix scripts pack}. They can be used
+to replicate @command{guix pack} behavior:
+
+@lisp
+(oci-image
+ (repository \"guile\")
+ (tag \"3\")
+ (manifest (specifications->manifest '(\"guile\")))
+ (pack-options
+ '(#:symlinks ((\"/bin/guile\" -> \"bin/guile\"))
+ #:max-layers 2)))
+@end lisp
+
+If the @code{value} field is an @code{operating-system} record, this field's
+value will be ignored.")
+ (system
+ (maybe-string)
+ "Attempt to build for a given system, e.g. \"i686-linux\"")
+ (target
+ (maybe-string)
+ "Attempt to cross-build for a given triple, e.g. \"aarch64-linux-gnu\"")
+ (grafts?
+ (boolean #f)
+ "Whether to allow grafting or not in the pack build."))
+
+(define-configuration/no-serialization oci-container-configuration
+ (user
+ (string "oci-container")
+ "The user under whose authority docker commands will be run.")
+ (group
+ (string "docker")
+ "The group under whose authority docker commands will be run.")
+ (command
+ (list-of-strings '())
+ "Overwrite the default command (@code{CMD}) of the image.")
+ (entrypoint
+ (maybe-string)
+ "Overwrite the default entrypoint (@code{ENTRYPOINT}) of the image.")
+ (host-environment
+ (list '())
+ "Set environment variables in the host environment where @command{docker run}
+is invoked. This is especially useful to pass secrets from the host to the
+container without having them on the @command{docker run}'s command line: by
+setting the @code{MYSQL_PASSWORD} on the host and by passing
+@code{--env MYSQL_PASSWORD} through the @code{extra-arguments} field, it is
+possible to securely set values in the container environment. This field's
+value can be a list of pairs or strings, even mixed:
+
+@lisp
+(list '(\"LANGUAGE\" . \"eo:ca:eu\")
+ \"JAVA_HOME=/opt/java\")
+@end lisp
+
+Pair members can be strings, gexps or file-like objects. Strings are passed
+directly to @code{make-forkexec-constructor}."
+ (sanitizer oci-sanitize-host-environment))
+ (environment
+ (list '())
+ "Set environment variables inside the container. This can be a list of pairs
+or strings, even mixed:
+
+@lisp
+(list '(\"LANGUAGE\" . \"eo:ca:eu\")
+ \"JAVA_HOME=/opt/java\")
+@end lisp
+
+Pair members can be strings, gexps or file-like objects. Strings are passed
+directly to the Docker CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#env,upstream}
+documentation for semantics."
+ (sanitizer oci-sanitize-environment))
+ (image
+ (string-or-oci-image)
+ "The image used to build the container. It can be a string or an
+@code{oci-image} record. Strings are resolved by the Docker
+Engine, and follow the usual format
+@code{myregistry.local:5000/testing/test-image:tag}.")
+ (provision
+ (maybe-string)
+ "Set the name of the provisioned Shepherd service.")
+ (requirement
+ (list-of-symbols '())
+ "Set additional Shepherd services dependencies to the provisioned Shepherd
+service.")
+ (log-file
+ (maybe-string)
+ "When @code{log-file} is set, it names the file to which the service’s
+standard output and standard error are redirected. @code{log-file} is created
+if it does not exist, otherwise it is appended to.")
+ (auto-start?
+ (boolean #t)
+ "Whether this service should be started automatically by the Shepherd. If it
+is @code{#f} the service has to be started manually with @command{herd start}.")
+ (respawn?
+ (boolean #f)
+ "Whether to restart the service when it stops, for instance when the
+underlying process dies.")
+ (shepherd-actions
+ (list '())
+ "This is a list of @code{shepherd-action} records defining actions supported
+by the service."
+ (sanitizer oci-sanitize-shepherd-actions))
+ (network
+ (maybe-string)
+ "Set a Docker network for the spawned container.")
+ (ports
+ (list '())
+ "Set the port or port ranges to expose from the spawned container. This can
+be a list of pairs or strings, even mixed:
+
+@lisp
+(list '(\"8080\" . \"80\")
+ \"10443:443\")
+@end lisp
+
+Pair members can be strings, gexps or file-like objects. Strings are passed
+directly to the Docker CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#publish,upstream}
+documentation for semantics."
+ (sanitizer oci-sanitize-ports))
+ (volumes
+ (list '())
+ "Set volume mappings for the spawned container. This can be a
+list of pairs or strings, even mixed:
+
+@lisp
+(list '(\"/root/data/grafana\" . \"/var/lib/grafana\")
+ \"/gnu/store:/gnu/store\")
+@end lisp
+
+Pair members can be strings, gexps or file-like objects. Strings are passed
+directly to the Docker CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#volume,upstream}
+documentation for semantics."
+ (sanitizer oci-sanitize-volumes))
+ (container-user
+ (maybe-string)
+ "Set the current user inside the spawned container. You can refer to the
+@url{https://docs.docker.com/engine/reference/run/#user,upstream}
+documentation for semantics.")
+ (workdir
+ (maybe-string)
+ "Set the current working for the spawned Shepherd service.
+You can refer to the
+@url{https://docs.docker.com/engine/reference/run/#workdir,upstream}
+documentation for semantics.")
+ (extra-arguments
+ (list '())
+ "A list of strings, gexps or file-like objects that will be directly passed
+to the @command{docker run} invokation."
+ (sanitizer oci-sanitize-extra-arguments)))
+
+(define oci-container-configuration->options
+ (lambda (config)
+ (let ((entrypoint
+ (oci-container-configuration-entrypoint config))
+ (network
+ (oci-container-configuration-network config))
+ (user
+ (oci-container-configuration-container-user config))
+ (workdir
+ (oci-container-configuration-workdir config)))
+ (apply append
+ (filter (compose not unspecified?)
+ `(,(if (maybe-value-set? entrypoint)
+ `("--entrypoint" ,entrypoint)
+ '())
+ ,(append-map
+ (lambda (spec)
+ (list "--env" spec))
+ (oci-container-configuration-environment config))
+ ,(if (maybe-value-set? network)
+ `("--network" ,network)
+ '())
+ ,(if (maybe-value-set? user)
+ `("--user" ,user)
+ '())
+ ,(if (maybe-value-set? workdir)
+ `("--workdir" ,workdir)
+ '())
+ ,(append-map
+ (lambda (spec)
+ (list "-p" spec))
+ (oci-container-configuration-ports config))
+ ,(append-map
+ (lambda (spec)
+ (list "-v" spec))
+ (oci-container-configuration-volumes config))))))))
+
+(define* (get-keyword-value args keyword #:key (default #f))
+ (let ((kv (memq keyword args)))
+ (if (and kv (>= (length kv) 2))
+ (cadr kv)
+ default)))
+
+(define (lower-operating-system os target system)
+ (mlet* %store-monad
+ ((tarball
+ (lower-object
+ (system-image (os->image os #:type docker-image-type))
+ system
+ #:target target)))
+ (return tarball)))
+
+(define (lower-manifest name image target system)
+ (define value (oci-image-value image))
+ (define options (oci-image-pack-options image))
+ (define image-reference
+ (oci-image-reference image))
+ (define image-tag
+ (let* ((extra-options
+ (get-keyword-value options #:extra-options))
+ (image-tag-option
+ (and extra-options
+ (get-keyword-value extra-options #:image-tag))))
+ (if image-tag-option
+ '()
+ `(#:extra-options (#:image-tag ,image-reference)))))
+
+ (mlet* %store-monad
+ ((_ (set-grafting
+ (oci-image-grafts? image)))
+ (guile (set-guile-for-build (default-guile)))
+ (profile
+ (profile-derivation value
+ #:target target
+ #:system system
+ #:hooks '()
+ #:locales? #f))
+ (tarball (apply pack:docker-image
+ `(,name ,profile
+ ,@options
+ ,@image-tag
+ #:localstatedir? #t))))
+ (return tarball)))
+
+(define (lower-oci-image name image)
+ (define value (oci-image-value image))
+ (define image-target (oci-image-target image))
+ (define image-system (oci-image-system image))
+ (define target
+ (if (maybe-value-set? image-target)
+ image-target
+ (%current-target-system)))
+ (define system
+ (if (maybe-value-set? image-system)
+ image-system
+ (%current-system)))
+ (with-store store
+ (run-with-store store
+ (match value
+ ((? manifest? value)
+ (lower-manifest name image target system))
+ ((? operating-system? value)
+ (lower-operating-system value target system))
+ ((or (? gexp? value)
+ (? file-like? value))
+ value)
+ (_
+ (raise
+ (formatted-message
+ (G_ "oci-image value must contain only manifest,
+operating-system, gexp or file-like records but ~a was found")
+ value))))
+ #:target target
+ #:system system)))
+
+(define (%oci-image-loader name image tag)
+ (let ((docker (file-append docker-cli "/bin/docker"))
+ (tarball (lower-oci-image name image)))
+ (with-imported-modules '((guix build utils))
+ (program-file (format #f "~a-image-loader" name)
+ #~(begin
+ (use-modules (guix build utils)
+ (ice-9 popen)
+ (ice-9 rdelim))
+
+ (format #t "Loading image for ~a from ~a...~%" #$name #$tarball)
+ (define line
+ (read-line
+ (open-input-pipe
+ (string-append #$docker " load -i " #$tarball))))
+
+ (unless (or (eof-object? line)
+ (string-null? line))
+ (format #t "~a~%" line)
+ (let ((repository&tag
+ (string-drop line
+ (string-length
+ "Loaded image: "))))
+
+ (invoke #$docker "tag" repository&tag #$tag)
+ (format #t "Tagged ~a with ~a...~%" #$tarball #$tag))))))))
+
+(define (oci-container-shepherd-service config)
+ (define (guess-name name image)
+ (if (maybe-value-set? name)
+ name
+ (string-append "docker-"
+ (basename
+ (if (string? image)
+ (first (string-split image #\:))
+ (oci-image-repository image))))))
+
+ (let* ((docker (file-append docker-cli "/bin/docker"))
+ (actions (oci-container-configuration-shepherd-actions config))
+ (auto-start?
+ (oci-container-configuration-auto-start? config))
+ (user (oci-container-configuration-user config))
+ (group (oci-container-configuration-group config))
+ (host-environment
+ (oci-container-configuration-host-environment config))
+ (command (oci-container-configuration-command config))
+ (log-file (oci-container-configuration-log-file config))
+ (provision (oci-container-configuration-provision config))
+ (requirement (oci-container-configuration-requirement config))
+ (respawn?
+ (oci-container-configuration-respawn? config))
+ (image (oci-container-configuration-image config))
+ (image-reference (oci-image-reference image))
+ (options (oci-container-configuration->options config))
+ (name (guess-name provision image))
+ (extra-arguments
+ (oci-container-configuration-extra-arguments config)))
+
+ (shepherd-service (provision `(,(string->symbol name)))
+ (requirement `(dockerd user-processes ,@requirement))
+ (respawn? respawn?)
+ (auto-start? auto-start?)
+ (documentation
+ (string-append
+ "Docker backed Shepherd service for "
+ (if (oci-image? image) name image) "."))
+ (start
+ #~(lambda ()
+ #$@(if (oci-image? image)
+ #~((invoke #$(%oci-image-loader
+ name image image-reference)))
+ #~())
+ (fork+exec-command
+ ;; docker run [OPTIONS] IMAGE [COMMAND] [ARG...]
+ (list #$docker "run" "--rm" "--name" #$name
+ #$@options #$@extra-arguments
+ #$image-reference #$@command)
+ #:user #$user
+ #:group #$group
+ #$@(if (maybe-value-set? log-file)
+ (list #:log-file log-file)
+ '())
+ #:environment-variables
+ (list #$@host-environment))))
+ (stop
+ #~(lambda _
+ (invoke #$docker "rm" "-f" #$name)))
+ (actions
+ (if (oci-image? image)
+ '()
+ (append
+ (list
+ (shepherd-action
+ (name 'pull)
+ (documentation
+ (format #f "Pull ~a's image (~a)."
+ name image))
+ (procedure
+ #~(lambda _
+ (invoke #$docker "pull" #$image)))))
+ actions))))))
+
+(define %oci-container-accounts
+ (list (user-account
+ (name "oci-container")
+ (comment "OCI services account")
+ (group "docker")
+ (system? #t)
+ (home-directory "/var/empty")
+ (shell (file-append shadow "/sbin/nologin")))))
diff --git a/gnu/services/docker.scm b/gnu/services/docker.scm
index 3af0f792701..69ff9f1d9e4 100644
--- a/gnu/services/docker.scm
+++ b/gnu/services/docker.scm
@@ -5,7 +5,7 @@
;;; Copyright © 2020 Efraim Flashner <efraim <at> flashner.co.il>
;;; Copyright © 2020 Jesse Dowell <jessedowell <at> gmail.com>
;;; Copyright © 2021 Brice Waegeneire <brice <at> waegenei.re>
-;;; Copyright © 2023, 2024 Giacomo Leidi <goodoldpaul <at> autistici.org>
+;;; Copyright © 2023, 2024, 2025 Giacomo Leidi <goodoldpaul <at> autistici.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -23,72 +23,60 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu services docker)
- #:use-module (gnu image)
#:use-module (gnu services)
#:use-module (gnu services configuration)
- #:use-module (gnu services base)
- #:use-module (gnu services dbus)
+ #:use-module (gnu services containers)
#:use-module (gnu services shepherd)
- #:use-module (gnu system)
- #:use-module (gnu system image)
#:use-module (gnu system privilege)
#:use-module (gnu system shadow)
- #:use-module (gnu packages admin) ;shadow
#:use-module (gnu packages docker)
#:use-module (gnu packages linux) ;singularity
- #:use-module (guix records)
- #:use-module (guix diagnostics)
#:use-module (guix gexp)
- #:use-module (guix i18n)
- #:use-module (guix monads)
- #:use-module (guix packages)
- #:use-module (guix profiles)
- #:use-module ((guix scripts pack) #:prefix pack:)
- #:use-module (guix store)
+ #:use-module (guix records)
#:use-module (srfi srfi-1)
#:use-module (ice-9 format)
#:use-module (ice-9 match)
+ #:re-export (oci-image ;for backwards compatibility, until the
+ oci-image? ;oci-container-service-type is fully deprecated
+ oci-image-fields
+ oci-image-repository
+ oci-image-tag
+ oci-image-value
+ oci-image-pack-options
+ oci-image-target
+ oci-image-system
+ oci-image-grafts?
+ oci-container-configuration
+ oci-container-configuration?
+ oci-container-configuration-fields
+ oci-container-configuration-user
+ oci-container-configuration-group
+ oci-container-configuration-command
+ oci-container-configuration-entrypoint
+ oci-container-configuration-host-environment
+ oci-container-configuration-environment
+ oci-container-configuration-image
+ oci-container-configuration-provision
+ oci-container-configuration-requirement
+ oci-container-configuration-log-file
+ oci-container-configuration-auto-start?
+ oci-container-configuration-respawn?
+ oci-container-configuration-shepherd-actions
+ oci-container-configuration-network
+ oci-container-configuration-ports
+ oci-container-configuration-volumes
+ oci-container-configuration-container-user
+ oci-container-configuration-workdir
+ oci-container-configuration-extra-arguments
+ oci-container-shepherd-service
+ %oci-container-accounts)
#:export (containerd-configuration
containerd-service-type
docker-configuration
docker-service-type
singularity-service-type
- oci-image
- oci-image?
- oci-image-fields
- oci-image-repository
- oci-image-tag
- oci-image-value
- oci-image-pack-options
- oci-image-target
- oci-image-system
- oci-image-grafts?
- oci-container-configuration
- oci-container-configuration?
- oci-container-configuration-fields
- oci-container-configuration-user
- oci-container-configuration-group
- oci-container-configuration-command
- oci-container-configuration-entrypoint
- oci-container-configuration-host-environment
- oci-container-configuration-environment
- oci-container-configuration-image
- oci-container-configuration-provision
- oci-container-configuration-requirement
- oci-container-configuration-log-file
- oci-container-configuration-auto-start?
- oci-container-configuration-respawn?
- oci-container-configuration-shepherd-actions
- oci-container-configuration-network
- oci-container-configuration-ports
- oci-container-configuration-volumes
- oci-container-configuration-container-user
- oci-container-configuration-workdir
- oci-container-configuration-extra-arguments
- oci-container-service-type
- oci-container-shepherd-service
- %oci-container-accounts))
+ oci-container-service-type))
(define-maybe file-like)
@@ -307,495 +295,6 @@ (define singularity-service-type
;;; OCI container.
;;;
-(define (oci-sanitize-pair pair delimiter)
- (define (valid? member)
- (or (string? member)
- (gexp? member)
- (file-like? member)))
- (match pair
- (((? valid? key) . (? valid? value))
- #~(string-append #$key #$delimiter #$value))
- (_
- (raise
- (formatted-message
- (G_ "pair members must contain only strings, gexps or file-like objects
-but ~a was found")
- pair)))))
-
-(define (oci-sanitize-mixed-list name value delimiter)
- (map
- (lambda (el)
- (cond ((string? el) el)
- ((pair? el) (oci-sanitize-pair el delimiter))
- (else
- (raise
- (formatted-message
- (G_ "~a members must be either a string or a pair but ~a was
-found!")
- name el)))))
- value))
-
-(define (oci-sanitize-host-environment value)
- ;; Expected spec format:
- ;; '(("HOME" . "/home/nobody") "JAVA_HOME=/java")
- (oci-sanitize-mixed-list "host-environment" value "="))
-
-(define (oci-sanitize-environment value)
- ;; Expected spec format:
- ;; '(("HOME" . "/home/nobody") "JAVA_HOME=/java")
- (oci-sanitize-mixed-list "environment" value "="))
-
-(define (oci-sanitize-ports value)
- ;; Expected spec format:
- ;; '(("8088" . "80") "2022:22")
- (oci-sanitize-mixed-list "ports" value ":"))
-
-(define (oci-sanitize-volumes value)
- ;; Expected spec format:
- ;; '(("/mnt/dir" . "/dir") "/run/current-system/profile:/java")
- (oci-sanitize-mixed-list "volumes" value ":"))
-
-(define (oci-sanitize-shepherd-actions value)
- (map
- (lambda (el)
- (if (shepherd-action? el)
- el
- (raise
- (formatted-message
- (G_ "shepherd-actions may only be shepherd-action records
-but ~a was found") el))))
- value))
-
-(define (oci-sanitize-extra-arguments value)
- (define (valid? member)
- (or (string? member)
- (gexp? member)
- (file-like? member)))
- (map
- (lambda (el)
- (if (valid? el)
- el
- (raise
- (formatted-message
- (G_ "extra arguments may only be strings, gexps or file-like objects
-but ~a was found") el))))
- value))
-
-(define (oci-image-reference image)
- (if (string? image)
- image
- (string-append (oci-image-repository image)
- ":" (oci-image-tag image))))
-
-(define (oci-lowerable-image? image)
- (or (manifest? image)
- (operating-system? image)
- (gexp? image)
- (file-like? image)))
-
-(define (string-or-oci-image? image)
- (or (string? image)
- (oci-image? image)))
-
-(define list-of-symbols?
- (list-of symbol?))
-
-(define-maybe/no-serialization string)
-
-(define-configuration/no-serialization oci-image
- (repository
- (string)
- "A string like @code{myregistry.local:5000/testing/test-image} that names
-the OCI image.")
- (tag
- (string "latest")
- "A string representing the OCI image tag. Defaults to @code{latest}.")
- (value
- (oci-lowerable-image)
- "A @code{manifest} or @code{operating-system} record that will be lowered
-into an OCI compatible tarball. Otherwise this field's value can be a gexp
-or a file-like object that evaluates to an OCI compatible tarball.")
- (pack-options
- (list '())
- "An optional set of keyword arguments that will be passed to the
-@code{docker-image} procedure from @code{guix scripts pack}. They can be used
-to replicate @command{guix pack} behavior:
-
-@lisp
-(oci-image
- (repository \"guile\")
- (tag \"3\")
- (manifest (specifications->manifest '(\"guile\")))
- (pack-options
- '(#:symlinks ((\"/bin/guile\" -> \"bin/guile\"))
- #:max-layers 2)))
-@end lisp
-
-If the @code{value} field is an @code{operating-system} record, this field's
-value will be ignored.")
- (system
- (maybe-string)
- "Attempt to build for a given system, e.g. \"i686-linux\"")
- (target
- (maybe-string)
- "Attempt to cross-build for a given triple, e.g. \"aarch64-linux-gnu\"")
- (grafts?
- (boolean #f)
- "Whether to allow grafting or not in the pack build."))
-
-(define-configuration/no-serialization oci-container-configuration
- (user
- (string "oci-container")
- "The user under whose authority docker commands will be run.")
- (group
- (string "docker")
- "The group under whose authority docker commands will be run.")
- (command
- (list-of-strings '())
- "Overwrite the default command (@code{CMD}) of the image.")
- (entrypoint
- (maybe-string)
- "Overwrite the default entrypoint (@code{ENTRYPOINT}) of the image.")
- (host-environment
- (list '())
- "Set environment variables in the host environment where @command{docker run}
-is invoked. This is especially useful to pass secrets from the host to the
-container without having them on the @command{docker run}'s command line: by
-setting the @code{MYSQL_PASSWORD} on the host and by passing
-@code{--env MYSQL_PASSWORD} through the @code{extra-arguments} field, it is
-possible to securely set values in the container environment. This field's
-value can be a list of pairs or strings, even mixed:
-
-@lisp
-(list '(\"LANGUAGE\" . \"eo:ca:eu\")
- \"JAVA_HOME=/opt/java\")
-@end lisp
-
-Pair members can be strings, gexps or file-like objects. Strings are passed
-directly to @code{make-forkexec-constructor}."
- (sanitizer oci-sanitize-host-environment))
- (environment
- (list '())
- "Set environment variables inside the container. This can be a list of pairs
-or strings, even mixed:
-
-@lisp
-(list '(\"LANGUAGE\" . \"eo:ca:eu\")
- \"JAVA_HOME=/opt/java\")
-@end lisp
-
-Pair members can be strings, gexps or file-like objects. Strings are passed
-directly to the Docker CLI. You can refer to the
-@url{https://docs.docker.com/engine/reference/commandline/run/#env,upstream}
-documentation for semantics."
- (sanitizer oci-sanitize-environment))
- (image
- (string-or-oci-image)
- "The image used to build the container. It can be a string or an
-@code{oci-image} record. Strings are resolved by the Docker
-Engine, and follow the usual format
-@code{myregistry.local:5000/testing/test-image:tag}.")
- (provision
- (maybe-string)
- "Set the name of the provisioned Shepherd service.")
- (requirement
- (list-of-symbols '())
- "Set additional Shepherd services dependencies to the provisioned Shepherd
-service.")
- (log-file
- (maybe-string)
- "When @code{log-file} is set, it names the file to which the service’s
-standard output and standard error are redirected. @code{log-file} is created
-if it does not exist, otherwise it is appended to.")
- (auto-start?
- (boolean #t)
- "Whether this service should be started automatically by the Shepherd. If it
-is @code{#f} the service has to be started manually with @command{herd start}.")
- (respawn?
- (boolean #f)
- "Whether to restart the service when it stops, for instance when the
-underlying process dies.")
- (shepherd-actions
- (list '())
- "This is a list of @code{shepherd-action} records defining actions supported
-by the service."
- (sanitizer oci-sanitize-shepherd-actions))
- (network
- (maybe-string)
- "Set a Docker network for the spawned container.")
- (ports
- (list '())
- "Set the port or port ranges to expose from the spawned container. This can
-be a list of pairs or strings, even mixed:
-
-@lisp
-(list '(\"8080\" . \"80\")
- \"10443:443\")
-@end lisp
-
-Pair members can be strings, gexps or file-like objects. Strings are passed
-directly to the Docker CLI. You can refer to the
-@url{https://docs.docker.com/engine/reference/commandline/run/#publish,upstream}
-documentation for semantics."
- (sanitizer oci-sanitize-ports))
- (volumes
- (list '())
- "Set volume mappings for the spawned container. This can be a
-list of pairs or strings, even mixed:
-
-@lisp
-(list '(\"/root/data/grafana\" . \"/var/lib/grafana\")
- \"/gnu/store:/gnu/store\")
-@end lisp
-
-Pair members can be strings, gexps or file-like objects. Strings are passed
-directly to the Docker CLI. You can refer to the
-@url{https://docs.docker.com/engine/reference/commandline/run/#volume,upstream}
-documentation for semantics."
- (sanitizer oci-sanitize-volumes))
- (container-user
- (maybe-string)
- "Set the current user inside the spawned container. You can refer to the
-@url{https://docs.docker.com/engine/reference/run/#user,upstream}
-documentation for semantics.")
- (workdir
- (maybe-string)
- "Set the current working for the spawned Shepherd service.
-You can refer to the
-@url{https://docs.docker.com/engine/reference/run/#workdir,upstream}
-documentation for semantics.")
- (extra-arguments
- (list '())
- "A list of strings, gexps or file-like objects that will be directly passed
-to the @command{docker run} invokation."
- (sanitizer oci-sanitize-extra-arguments)))
-
-(define oci-container-configuration->options
- (lambda (config)
- (let ((entrypoint
- (oci-container-configuration-entrypoint config))
- (network
- (oci-container-configuration-network config))
- (user
- (oci-container-configuration-container-user config))
- (workdir
- (oci-container-configuration-workdir config)))
- (apply append
- (filter (compose not unspecified?)
- `(,(if (maybe-value-set? entrypoint)
- `("--entrypoint" ,entrypoint)
- '())
- ,(append-map
- (lambda (spec)
- (list "--env" spec))
- (oci-container-configuration-environment config))
- ,(if (maybe-value-set? network)
- `("--network" ,network)
- '())
- ,(if (maybe-value-set? user)
- `("--user" ,user)
- '())
- ,(if (maybe-value-set? workdir)
- `("--workdir" ,workdir)
- '())
- ,(append-map
- (lambda (spec)
- (list "-p" spec))
- (oci-container-configuration-ports config))
- ,(append-map
- (lambda (spec)
- (list "-v" spec))
- (oci-container-configuration-volumes config))))))))
-
-(define* (get-keyword-value args keyword #:key (default #f))
- (let ((kv (memq keyword args)))
- (if (and kv (>= (length kv) 2))
- (cadr kv)
- default)))
-
-(define (lower-operating-system os target system)
- (mlet* %store-monad
- ((tarball
- (lower-object
- (system-image (os->image os #:type docker-image-type))
- system
- #:target target)))
- (return tarball)))
-
-(define (lower-manifest name image target system)
- (define value (oci-image-value image))
- (define options (oci-image-pack-options image))
- (define image-reference
- (oci-image-reference image))
- (define image-tag
- (let* ((extra-options
- (get-keyword-value options #:extra-options))
- (image-tag-option
- (and extra-options
- (get-keyword-value extra-options #:image-tag))))
- (if image-tag-option
- '()
- `(#:extra-options (#:image-tag ,image-reference)))))
-
- (mlet* %store-monad
- ((_ (set-grafting
- (oci-image-grafts? image)))
- (guile (set-guile-for-build (default-guile)))
- (profile
- (profile-derivation value
- #:target target
- #:system system
- #:hooks '()
- #:locales? #f))
- (tarball (apply pack:docker-image
- `(,name ,profile
- ,@options
- ,@image-tag
- #:localstatedir? #t))))
- (return tarball)))
-
-(define (lower-oci-image name image)
- (define value (oci-image-value image))
- (define image-target (oci-image-target image))
- (define image-system (oci-image-system image))
- (define target
- (if (maybe-value-set? image-target)
- image-target
- (%current-target-system)))
- (define system
- (if (maybe-value-set? image-system)
- image-system
- (%current-system)))
- (with-store store
- (run-with-store store
- (match value
- ((? manifest? value)
- (lower-manifest name image target system))
- ((? operating-system? value)
- (lower-operating-system value target system))
- ((or (? gexp? value)
- (? file-like? value))
- value)
- (_
- (raise
- (formatted-message
- (G_ "oci-image value must contain only manifest,
-operating-system, gexp or file-like records but ~a was found")
- value))))
- #:target target
- #:system system)))
-
-(define (%oci-image-loader name image tag)
- (let ((docker (file-append docker-cli "/bin/docker"))
- (tarball (lower-oci-image name image)))
- (with-imported-modules '((guix build utils))
- (program-file (format #f "~a-image-loader" name)
- #~(begin
- (use-modules (guix build utils)
- (ice-9 popen)
- (ice-9 rdelim))
-
- (format #t "Loading image for ~a from ~a...~%" #$name #$tarball)
- (define line
- (read-line
- (open-input-pipe
- (string-append #$docker " load -i " #$tarball))))
-
- (unless (or (eof-object? line)
- (string-null? line))
- (format #t "~a~%" line)
- (let ((repository&tag
- (string-drop line
- (string-length
- "Loaded image: "))))
-
- (invoke #$docker "tag" repository&tag #$tag)
- (format #t "Tagged ~a with ~a...~%" #$tarball #$tag))))))))
-
-(define (oci-container-shepherd-service config)
- (define (guess-name name image)
- (if (maybe-value-set? name)
- name
- (string-append "docker-"
- (basename
- (if (string? image)
- (first (string-split image #\:))
- (oci-image-repository image))))))
-
- (let* ((docker (file-append docker-cli "/bin/docker"))
- (actions (oci-container-configuration-shepherd-actions config))
- (auto-start?
- (oci-container-configuration-auto-start? config))
- (user (oci-container-configuration-user config))
- (group (oci-container-configuration-group config))
- (host-environment
- (oci-container-configuration-host-environment config))
- (command (oci-container-configuration-command config))
- (log-file (oci-container-configuration-log-file config))
- (provision (oci-container-configuration-provision config))
- (requirement (oci-container-configuration-requirement config))
- (respawn?
- (oci-container-configuration-respawn? config))
- (image (oci-container-configuration-image config))
- (image-reference (oci-image-reference image))
- (options (oci-container-configuration->options config))
- (name (guess-name provision image))
- (extra-arguments
- (oci-container-configuration-extra-arguments config)))
-
- (shepherd-service (provision `(,(string->symbol name)))
- (requirement `(dockerd user-processes ,@requirement))
- (respawn? respawn?)
- (auto-start? auto-start?)
- (documentation
- (string-append
- "Docker backed Shepherd service for "
- (if (oci-image? image) name image) "."))
- (start
- #~(lambda ()
- #$@(if (oci-image? image)
- #~((invoke #$(%oci-image-loader
- name image image-reference)))
- #~())
- (fork+exec-command
- ;; docker run [OPTIONS] IMAGE [COMMAND] [ARG...]
- (list #$docker "run" "--rm" "--name" #$name
- #$@options #$@extra-arguments
- #$image-reference #$@command)
- #:user #$user
- #:group #$group
- #$@(if (maybe-value-set? log-file)
- (list #:log-file log-file)
- '())
- #:environment-variables
- (list #$@host-environment))))
- (stop
- #~(lambda _
- (invoke #$docker "rm" "-f" #$name)))
- (actions
- (if (oci-image? image)
- '()
- (append
- (list
- (shepherd-action
- (name 'pull)
- (documentation
- (format #f "Pull ~a's image (~a)."
- name image))
- (procedure
- #~(lambda _
- (invoke #$docker "pull" #$image)))))
- actions))))))
-
-(define %oci-container-accounts
- (list (user-account
- (name "oci-container")
- (comment "OCI services account")
- (group "docker")
- (system? #t)
- (home-directory "/var/empty")
- (shell (file-append shadow "/sbin/nologin")))))
-
(define (configs->shepherd-services configs)
(map oci-container-shepherd-service configs))
diff --git a/gnu/tests/docker.scm b/gnu/tests/docker.scm
index 90c8d0f8508..5dcf05a17e3 100644
--- a/gnu/tests/docker.scm
+++ b/gnu/tests/docker.scm
@@ -1,7 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019 Danny Milosavljevic <dannym <at> scratchpost.org>
;;; Copyright © 2019-2023 Ludovic Courtès <ludo <at> gnu.org>
-;;; Copyright © 2024 Giacomo Leidi <goodoldpaul <at> autistici.org>
+;;; Copyright © 2024, 2025 Giacomo Leidi <goodoldpaul <at> autistici.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -414,71 +414,54 @@ (define (run-oci-container-test)
(test-runner-current (system-test-runner #$output))
(test-begin "oci-container")
- (test-assert "containerd service running"
- (marionette-eval
- '(begin
- (use-modules (gnu services herd))
- (match (start-service 'containerd)
- (#f #f)
- (('service response-parts ...)
- (match (assq-ref response-parts 'running)
- ((pid) pid)))))
- marionette))
-
- (test-assert "containerd PID file present"
- (wait-for-file "/run/containerd/containerd.pid" marionette))
-
- (test-assert "dockerd running"
- (marionette-eval
- '(begin
- (use-modules (gnu services herd))
- (match (start-service 'dockerd)
- (#f #f)
- (('service response-parts ...)
- (match (assq-ref response-parts 'running)
- ((pid) pid)))))
- marionette))
-
- (sleep 10) ; let service start
+ (wait-for-file "/run/containerd/containerd.pid" marionette)
(test-assert "docker-guile running"
(marionette-eval
'(begin
(use-modules (gnu services herd))
- (match (start-service 'docker-guile)
- (#f #f)
- (('service response-parts ...)
- (match (assq-ref response-parts 'running)
- ((pid) pid)))))
+ (wait-for-service 'docker-guile #:timeout 120)
+ #t)
marionette))
- (test-equal "passing host environment variables and volumes"
- '("value" "hello")
- (marionette-eval
- `(begin
- (use-modules (ice-9 popen)
- (ice-9 rdelim))
-
- (define slurp
- (lambda args
- (let* ((port (apply open-pipe* OPEN_READ args))
- (output (let ((line (read-line port)))
- (if (eof-object? line)
- ""
- line)))
- (status (close-pipe port)))
- output)))
- (let* ((response1 (slurp
- ,(string-append #$docker-cli "/bin/docker")
- "exec" "docker-guile"
- "/bin/guile" "-c" "(display (getenv \"VARIABLE\"))"))
- (response2 (slurp
- ,(string-append #$docker-cli "/bin/docker")
- "exec" "docker-guile"
- "/bin/guile" "-c" "(begin (use-modules (ice-9 popen) (ice-9 rdelim))
+ (test-assert "passing host environment variables and volumes"
+ (begin
+ (define (run-test)
+ (marionette-eval
+ `(begin
+ (use-modules (ice-9 popen)
+ (ice-9 rdelim))
+
+ (define slurp
+ (lambda args
+ (let* ((port (apply open-pipe* OPEN_READ args))
+ (output (let ((line (read-line port)))
+ (if (eof-object? line)
+ ""
+ line)))
+ (status (close-pipe port)))
+ output)))
+ (let* ((response1 (slurp
+ ,(string-append #$docker-cli "/bin/docker")
+ "exec" "docker-guile"
+ "/bin/guile" "-c" "(display (getenv \"VARIABLE\"))"))
+ (response2 (slurp
+ ,(string-append #$docker-cli "/bin/docker")
+ "exec" "docker-guile"
+ "/bin/guile" "-c" "(begin (use-modules (ice-9 popen) (ice-9 rdelim))
(display (call-with-input-file \"/shared.txt\" read-line)))")))
- (list response1 response2)))
- marionette))
+ (list response1 response2)))
+ marionette))
+ ;; Allow services to come up on slower machines
+ (let loop ((attempts 0))
+ (if (= attempts 60)
+ (error "Service didn't come up after more than 60 seconds")
+ (if (equal? '("value" "hello")
+ (run-test))
+ #t
+ (begin
+ (sleep 1)
+ (loop (+ 1 attempts))))))))
(test-end))))
--
2.48.1
guix-patches <at> gnu.org:bug#76081; Package guix-patches.
(Sun, 09 Feb 2025 19:15:02 GMT) Full text and rfc822 format available.Message #20 received at 76081 <at> debbugs.gnu.org (full text, mbox):
From: paul <goodoldpaul <at> autistici.org> To: 76081 <at> debbugs.gnu.org Subject: Re: OCI provisioning service Date: Sun, 9 Feb 2025 20:14:33 +0100
Hi, I'm about to send a v2. v2 compared to the first revision features: - it actually compiles all the times :) (rev 1 referenced oci-image too early for it to be working and generated a compile time error, if you recompiled it sometimes went away so I thought it was a problem of my setup. CI caught this) - it allows more values to be overridden by eventual users of the Scheme API - it allows passing extra arguments directly after each podman or docker invokation, allowing for example for overriding podman --root and similar options. All of these tests should pass: guix shell -D guix -CPW -- make check-system TESTS="oci-container oci-service-rootless-podman docker docker-system rootless-podman oci-service-docker" Thank you for your work, giacomo
guix-patches <at> gnu.org:bug#76081; Package guix-patches.
(Sun, 09 Feb 2025 19:16:01 GMT) Full text and rfc822 format available.Message #23 received at 76081 <at> debbugs.gnu.org (full text, mbox):
From: Giacomo Leidi <goodoldpaul <at> autistici.org> To: 76081 <at> debbugs.gnu.org Cc: Giacomo Leidi <goodoldpaul <at> autistici.org> Subject: [PATCH v2 1/4] services: rootless-podman: Use login shell. Date: Sun, 9 Feb 2025 20:15:01 +0100
This commit allows for having PATH set when changing the owner of
/sys/fs/group.
* gnu/services/containers.scm (crgroups-fs-owner): Use login shell.
Change-Id: I9510c637a5332325e05ca5ebc9dfd4de32685c50
---
gnu/services/containers.scm | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm
index 19d35ccbcb6..dc66ac4f967 100644
--- a/gnu/services/containers.scm
+++ b/gnu/services/containers.scm
@@ -140,7 +140,7 @@ (define (cgroups-fs-owner-entrypoint config)
(rootless-podman-configuration-group-name config))
(program-file "cgroups2-fs-owner-entrypoint"
#~(system*
- (string-append #+bash-minimal "/bin/bash") "-c"
+ (string-append #+bash-minimal "/bin/bash") "-l" "-c"
(string-append "echo Setting /sys/fs/cgroup "
"group ownership to " #$group " && chown -v "
"root:" #$group " /sys/fs/cgroup && "
base-commit: 5a897c5c95a81278b044c18d962d3bd83131ba06
--
2.48.1
ludo <at> gnu.org, maxim.cournoyer <at> gmail.com, guix-patches <at> gnu.org:bug#76081; Package guix-patches.
(Sun, 09 Feb 2025 19:16:02 GMT) Full text and rfc822 format available.Message #26 received at 76081 <at> debbugs.gnu.org (full text, mbox):
From: Giacomo Leidi <goodoldpaul <at> autistici.org> To: 76081 <at> debbugs.gnu.org Cc: Giacomo Leidi <goodoldpaul <at> autistici.org> Subject: [PATCH v2 3/4] services: Add oci-service-type. Date: Sun, 9 Feb 2025 20:15:03 +0100
This patch implements a generalization of the
oci-container-service-type, which consequently is made deprecated. The
oci-service-type, in addition to all the features from the
oci-container-service-type, can now provision OCI networks and volumes.
It only handles OCI objects creation, the user is supposed to handle
state once the objects are provsioned.
It currently supports two different OCI runtimes: Docker and rootless
Podman. Both runtimes are tested to make sure provisioned containers
can connect to each other through provisioned networks and can
read/write data with provisioned volumes.
At last the Scheme API is thought to facilitate the implementation of a
Guix Home service in the future.
* gnu/services/containers.scm (%oci-supported-runtimes): New variable;
(oci-runtime-cli): new variable;
(oci-runtime-name): new variable;
(oci-network-configuration): new variable;
(oci-volume-configuration): new variable;
(oci-configuration): new variable;
(oci-extension): new variable;
(oci-networks-shepherd-name): new variable;
(oci-service-type): new variable;
(oci-state->shepherd-services): new variable.
* doc/guix.texi: Document it.
* gnu/tests/containers.scm: Test it.
* gnu/services/docker.scm: Deprecate the oci-container-service-type.
Change-Id: I656b3db85832e42d53072fcbfb91d1226f39ef38
---
doc/guix.texi | 299 ++++++++--
gnu/services/containers.scm | 1086 +++++++++++++++++++++++++++++++----
gnu/services/docker.scm | 37 +-
gnu/tests/containers.scm | 999 +++++++++++++++++++++++++++++++-
4 files changed, 2225 insertions(+), 196 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index bb5f29277fb..8f66b35297b 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -41778,59 +41778,159 @@ Miscellaneous Services
@cindex OCI-backed, Shepherd services
@subsubheading OCI backed services
-Should you wish to manage your Docker containers with the same consistent
-interface you use for your other Shepherd services,
-@var{oci-container-service-type} is the tool to use: given an
-@acronym{Open Container Initiative, OCI} container image, it will run it in a
+Should you wish to manage your @acronym{Open Container Initiative, OCI} containers
+with the same consistent interface you use for your other Shepherd services,
+@var{oci-service-type} is the tool to use: given an
+OCI container image, it will run it in a
Shepherd service. One example where this is useful: it lets you run services
-that are available as Docker/OCI images but not yet packaged for Guix.
+that are available as OCI images but not yet packaged for Guix.
-@defvar oci-container-service-type
+@defvar oci-service-type
-This is a thin wrapper around Docker's CLI that executes OCI images backed
+This is a thin wrapper around Docker's or Podman's CLI that executes OCI images backed
processes as Shepherd Services.
@lisp
-(service oci-container-service-type
- (list
- (oci-container-configuration
- (network "host")
- (image
- (oci-image
- (repository "guile")
- (tag "3")
- (value (specifications->manifest '("guile")))
- (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile"))
- #:max-layers 2))))
- (entrypoint "/bin/guile")
- (command
- '("-c" "(display \"hello!\n\")")))
- (oci-container-configuration
- (image "prom/prometheus")
- (ports
- '(("9000" . "9000")
- ("9090" . "9090"))))
- (oci-container-configuration
- (image "grafana/grafana:10.0.1")
- (network "host")
- (volumes
- '("/var/lib/grafana:/var/lib/grafana")))))
+(simple-service 'oci-provisioning
+ oci-service-type
+ (oci-extension
+ (networks
+ (list
+ (oci-network-configuration (name "monitoring"))))
+ (containers
+ (list
+ (oci-container-configuration
+ (network "monitoring")
+ (image
+ (oci-image
+ (repository "guile")
+ (tag "3")
+ (value (specifications->manifest '("guile")))
+ (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile"))
+ #:max-layers 2))))
+ (entrypoint "/bin/guile")
+ (command
+ '("-c" "(display \"hello!\n\")")))
+ (oci-container-configuration
+ (image "prom/prometheus")
+ (network "host")
+ (ports
+ '(("9000" . "9000")
+ ("9090" . "9090"))))
+ (oci-container-configuration
+ (image "grafana/grafana:10.0.1")
+ (network "host")
+ (volumes
+ '("/var/lib/grafana:/var/lib/grafana")))))))
@end lisp
In this example three different Shepherd services are going to be added to the
system. Each @code{oci-container-configuration} record translates to a
-@code{docker run} invocation and its fields directly map to options. You can
-refer to the
-@url{https://docs.docker.com/engine/reference/commandline/run,upstream}
-documentation for the semantics of each value. If the images are not found,
-they will be
-@url{https://docs.docker.com/engine/reference/commandline/pull/,pulled}. The
+@command{docker run} or @command{podman run} invocation and its fields directly
+map to options. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html,Podman}
+upstream documentation for semantics of each value. If the images are not found,
+they will be pulled. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/pull/,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-pull.1.html,Podman}
+upstream documentation for semantics. The
services with @code{(network "host")} are going to be attached to the
host network and are supposed to behave like native processes with regard to
networking.
@end defvar
+@c %start of fragment
+
+@deftp {Data Type} oci-configuration
+Available @code{oci-configuration} fields are:
+
+@table @asis
+@item @code{runtime} (default: @code{'docker}) (type: symbol)
+The OCI runtime to use to run commands. It can be either @code{'docker} or
+@code{'podman}.
+
+@item @code{runtime-cli} (type: maybe-package)
+The OCI runtime command line to be installed in the system profile and used
+to provision OCI resources. When unset it will default to @code{docker-cli}
+package for the @code{'docker} runtime or to @code{podman} package for the
+@code{'podman} runtime.
+
+@item @code{runtime-extra-arguments} (default: @code{'()}) (type: list)
+A list of strings, gexps or file-like objects that will be placed
+after each @command{docker} or @command{podman} invokation.
+
+@item @code{user} (default: @code{"oci-container"}) (type: string)
+The user name under whose authority OCI commands will be run.
+
+@item @code{group} (default: @code{"docker"}) (type: string)
+The group name under whose authority OCI commands will be run. When
+using the @code{'podman} OCI runtime, this field will be ignored and the
+default group of the user configured in the @code{user} field will be used.
+
+@item @code{subuids-range} (type: maybe-subid-range)
+An optional @code{subid-range} record allocating subuids for the user from
+the @code{user} field. When unset, with the rootless Podman OCI runtime, it
+defaults to @code{(subid-range (name "oci-container"))}.
+
+@item @code{subgids-range} (type: maybe-subid-range)
+An optional @code{subid-range} record allocating subgids for the user from
+the @code{user} field. When unset, with the rootless Podman OCI runtime, it
+defaults to @code{(subid-range (name "oci-container"))}.
+
+@item @code{containers} (default: @code{'()}) (type: list-of-oci-containers)
+The list of @code{oci-container-configuration} records representing the
+containers to provision. Most users are supposed not to use this field and use
+the @code{oci-extension} record instead.
+
+@item @code{networks} (default: @code{'()}) (type: list-of-oci-networks)
+The list of @code{oci-network-configuration} records representing the
+containers to provision. Most users are supposed not to use this field and use
+the @code{oci-extension} record instead.
+
+@item @code{volumes} (default: @code{'()}) (type: list-of-oci-volumes)
+The list of @code{oci-volumes-configuration} records representing the
+containers to provision. Most users are supposed not to use this field and use
+the @code{oci-extension} record instead.
+
+@item @code{verbose?} (default: @code{#f}) (type: boolean)
+When true, additional output will be printed, allowing to better follow the
+flow of execution.
+
+@end table
+
+@end deftp
+
+
+@c %end of fragment
+
+@c %start of fragment
+
+@deftp {Data Type} oci-extension
+Available @code{oci-extension} fields are:
+
+@table @asis
+@item @code{containers} (default: @code{'()}) (type: list-of-oci-containers)
+The list of @code{oci-container-configuration} records representing the
+containers to provision.
+
+@item @code{networks} (default: @code{'()}) (type: list-of-oci-networks)
+The list of @code{oci-network-configuration} records representing the
+containers to provision.
+
+@item @code{volumes} (default: @code{'()}) (type: list-of-oci-volumes)
+The list of @code{oci-volumes-configuration} records representing the
+containers to provision.
+
+@end table
+
+@end deftp
+
+
+@c %end of fragment
+
+
@c %start of fragment
@deftp {Data Type} oci-container-configuration
@@ -41850,16 +41950,16 @@ Miscellaneous Services
Overwrite the default entrypoint (@code{ENTRYPOINT}) of the image.
@item @code{host-environment} (default: @code{'()}) (type: list)
-Set environment variables in the host environment where @command{docker
-run} is invoked. This is especially useful to pass secrets from the
-host to the container without having them on the @command{docker run}'s
-command line: by setting the @code{MYSQL_PASSWORD} on the host and by passing
+Set environment variables in the host environment where @command{docker run}
+or @command{podman run} are invoked. This is especially useful to pass secrets
+from the host to the container without having them on the OCI runtime command line,
+for example: by setting the @code{MYSQL_PASSWORD} on the host and by passing
@code{--env MYSQL_PASSWORD} through the @code{extra-arguments} field, it is
possible to securely set values in the container environment. This field's
value can be a list of pairs or strings, even mixed:
@lisp
-(list '("LANGUAGE\" . "eo:ca:eu")
+(list '("LANGUAGE" . "eo:ca:eu")
"JAVA_HOME=/opt/java")
@end lisp
@@ -41867,22 +41967,24 @@ Miscellaneous Services
directly to @code{make-forkexec-constructor}.
@item @code{environment} (default: @code{'()}) (type: list)
-Set environment variables. This can be a list of pairs or strings, even mixed:
+Set environment variables inside the container. This can be a list of pairs
+or strings, even mixed:
@lisp
(list '("LANGUAGE" . "eo:ca:eu")
"JAVA_HOME=/opt/java")
@end lisp
-Pair members can be strings, gexps or file-like objects.
-Strings are passed directly to the Docker CLI. You can refer to the
-@uref{https://docs.docker.com/engine/reference/commandline/run/#env,upstream}
-documentation for semantics.
+Pair members can be strings, gexps or file-like objects. Strings are passed
+directly to the OCI runtime CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#env,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#env-e-env,Podman}
+upstream documentation for semantics.
@item @code{image} (type: string-or-oci-image)
The image used to build the container. It can be a string or an
-@code{oci-image} record. Strings are resolved by the Docker Engine, and
-follow the usual format
+@code{oci-image} record. Strings are resolved by the OCI runtime,
+and follow the usual format
@code{myregistry.local:5000/testing/test-image:tag}.
@item @code{provision} (default: @code{""}) (type: string)
@@ -41910,7 +42012,7 @@ Miscellaneous Services
by the service.
@item @code{network} (default: @code{""}) (type: string)
-Set a Docker network for the spawned container.
+Set an OCI network for the spawned container.
@item @code{ports} (default: @code{'()}) (type: list)
Set the port or port ranges to expose from the spawned container. This can be a
@@ -41921,10 +42023,11 @@ Miscellaneous Services
"10443:443")
@end lisp
-Pair members can be strings, gexps or file-like objects.
-Strings are passed directly to the Docker CLI. You can refer to the
-@uref{https://docs.docker.com/engine/reference/commandline/run/#publish,upstream}
-documentation for semantics.
+Pair members can be strings, gexps or file-like objects. Strings are passed
+directly to the OCI runtime CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#publish,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#publish-p-ip-hostport-containerport-protocol,Podman}
+upstream documentation for semantics.
@item @code{volumes} (default: @code{'()}) (type: list)
Set volume mappings for the spawned container. This can be a
@@ -41935,25 +42038,95 @@ Miscellaneous Services
"/gnu/store:/gnu/store")
@end lisp
-Pair members can be strings, gexps or file-like objects.
-Strings are passed directly to the Docker CLI. You can refer to the
-@uref{https://docs.docker.com/engine/reference/commandline/run/#volume,upstream}
-documentation for semantics.
+Pair members can be strings, gexps or file-like objects. Strings are passed
+directly to the OCI runtime CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#volume,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#volume-v-source-volume-host-dir-container-dir-options,Podman}
+upstream documentation for semantics.
@item @code{container-user} (default: @code{""}) (type: string)
Set the current user inside the spawned container. You can refer to the
-@url{https://docs.docker.com/engine/reference/run/#user,upstream}
-documentation for semantics.
+@url{https://docs.docker.com/engine/reference/run/#user,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#user-u-user-group,Podman}
+upstream documentation for semantics.
@item @code{workdir} (default: @code{""}) (type: string)
Set the current working directory for the spawned Shepherd service.
You can refer to the
-@url{https://docs.docker.com/engine/reference/run/#workdir,upstream}
-documentation for semantics.
+@url{https://docs.docker.com/engine/reference/run/#workdir,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#workdir-w-dir,Podman}
+upstream documentation for semantics.
+
+@item @code{extra-arguments} (default: @code{'()}) (type: list)
+A list of strings, gexps or file-like objects that will be directly passed
+to the @command{docker run} or @command{podman run} invokation.
+
+@end table
+
+@end deftp
+
+
+@c %end of fragment
+
+@c %start of fragment
+
+@deftp {Data Type} oci-network-configuration
+Available @code{oci-network-configuration} fields are:
+
+@table @asis
+@item @code{name} (type: string)
+The name of the OCI network to provision.
+
+@item @code{driver} (type: maybe-string)
+The driver to manage the network.
+
+@item @code{gateway} (type: maybe-string)
+IPv4 or IPv6 gateway for the subnet.
+
+@item @code{internal?} (default: @code{#f}) (type: boolean)
+Restrict external access to the network
+
+@item @code{ip-range} (type: maybe-string)
+Allocate container ip from a sub-range in CIDR format.
+
+@item @code{ipam-driver} (type: maybe-string)
+IP Address Management Driver.
+
+@item @code{ipv6?} (default: @code{#f}) (type: boolean)
+Enable IPv6 networking.
+
+@item @code{subnet} (type: maybe-string)
+Subnet in CIDR format that represents a network segment.
+
+@item @code{labels} (default: @code{'()}) (type: list)
+The list of labels that will be used to tag the current volume.
+
+@item @code{extra-arguments} (default: @code{'()}) (type: list)
+A list of strings, gexps or file-like objects that will be directly
+passed to the runtime invokation.
+
+@end table
+
+@end deftp
+
+
+@c %end of fragment
+
+@c %start of fragment
+
+@deftp {Data Type} oci-volume-configuration
+Available @code{oci-volume-configuration} fields are:
+
+@table @asis
+@item @code{name} (type: string)
+The name of the OCI volume to provision.
+
+@item @code{labels} (default: @code{'()}) (type: list)
+The list of labels that will be used to tag the current volume.
@item @code{extra-arguments} (default: @code{'()}) (type: list)
A list of strings, gexps or file-like objects that will be directly
-passed to the @command{docker run} invocation.
+passed to the runtime invokation.
@end table
diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm
index 50bf6c05549..5c50c99eaf6 100644
--- a/gnu/services/containers.scm
+++ b/gnu/services/containers.scm
@@ -41,6 +41,7 @@ (define-module (gnu services containers)
#:use-module ((guix scripts pack) #:prefix pack:)
#:use-module (guix store)
#:use-module (srfi srfi-1)
+ #:use-module (ice-9 format)
#:use-module (ice-9 match)
#:export (rootless-podman-configuration
rootless-podman-configuration?
@@ -96,8 +97,72 @@ (define-module (gnu services containers)
oci-container-configuration-workdir
oci-container-configuration-extra-arguments
+ list-of-oci-containers?
+ list-of-oci-networks?
+ list-of-oci-volumes?
+
+ %oci-supported-runtimes
+ oci-sanitize-runtime
+ oci-runtime-system-environment
+ oci-runtime-system-extra-arguments
+ oci-runtime-system-group
+ oci-runtime-system-requirement
+ oci-runtime-cli
+ oci-runtime-system-cli
+ oci-runtime-name
+ oci-runtime-group
+
+ oci-network-configuration
+ oci-network-configuration?
+ oci-network-configuration-fields
+ oci-network-configuration-name
+ oci-network-configuration-driver
+ oci-network-configuration-gateway
+ oci-network-configuration-internal?
+ oci-network-configuration-ip-range
+ oci-network-configuration-ipam-driver
+ oci-network-configuration-ipv6?
+ oci-network-configuration-subnet
+ oci-network-configuration-labels
+ oci-network-configuration-extra-arguments
+
+ oci-volume-configuration
+ oci-volume-configuration?
+ oci-volume-configuration-fields
+ oci-volume-configuration-name
+ oci-volume-configuration-labels
+ oci-volume-configuration-extra-arguments
+
+ oci-configuration
+ oci-configuration?
+ oci-configuration-fields
+ oci-configuration-runtime
+ oci-configuration-runtime-cli
+ oci-configuration-runtime-extra-arguments
+ oci-configuration-user
+ oci-configuration-group
+ oci-configuration-containers
+ oci-configuration-networks
+ oci-configuration-volumes
+ oci-configuration-verbose?
+
+ oci-extension
+ oci-extension?
+ oci-extension-fields
+ oci-extension-containers
+ oci-extension-networks
+ oci-extension-volumes
+
+ oci-networks-shepherd-name
+ oci-volumes-shepherd-name
+
oci-container-shepherd-service
- %oci-container-accounts))
+ oci-service-type
+ oci-service-accounts
+ oci-service-profile
+ oci-service-subids
+ oci-state->shepherd-services
+ oci-configuration->shepherd-services))
(define (gexp-or-string? value)
(or (gexp? value)
@@ -294,9 +359,42 @@ (define rootless-podman-service-type
;;;
-;;; OCI container.
+;;; OCI provisioning service.
;;;
+(define %oci-supported-runtimes
+ '(docker podman))
+
+(define (oci-runtime-system-requirement runtime)
+ "Return a list of Shepherd service names required by a given OCI runtime,
+before it is able to run containers."
+ (if (eq? 'podman runtime)
+ '(cgroups2-fs-owner cgroups2-limits
+ rootless-podman-shared-root-fs user-processes)
+ '(dockerd user-processes)))
+
+(define (oci-runtime-name runtime)
+ "Return a human readable name for a given OCI runtime."
+ (if (eq? 'podman runtime)
+ "Podman" "Docker"))
+
+(define (oci-runtime-group runtime maybe-group)
+ "Implement the logic behind selection of the group that is to be used by
+Shepherd to execute OCI commands."
+ (if (maybe-value-set? maybe-group)
+ maybe-group
+ (if (eq? 'podman runtime)
+ "cgroup"
+ "docker")))
+
+(define (oci-sanitize-runtime value)
+ (unless (member value %oci-supported-runtimes)
+ (raise
+ (formatted-message
+ (G_ "OCI runtime must be a symbol and one of ~a,
+but ~a was found") %oci-supported-runtimes value)))
+ value)
+
(define (oci-sanitize-pair pair delimiter)
(define (valid? member)
(or (string? member)
@@ -345,6 +443,11 @@ (define (oci-sanitize-volumes value)
;; '(("/mnt/dir" . "/dir") "/run/current-system/profile:/java")
(oci-sanitize-mixed-list "volumes" value ":"))
+(define (oci-sanitize-labels value)
+ ;; Expected spec format:
+ ;; '(("foo" . "bar") "foo=bar")
+ (oci-sanitize-mixed-list "labels" value "="))
+
(define (oci-sanitize-shepherd-actions value)
(map
(lambda (el)
@@ -372,6 +475,7 @@ (define (oci-sanitize-extra-arguments value)
value))
(define (oci-image-reference image)
+ "Return a string OCI image reference representing IMAGE."
(if (string? image)
image
(string-append (oci-image-repository image)
@@ -390,7 +494,19 @@ (define (string-or-oci-image? image)
(define list-of-symbols?
(list-of symbol?))
+(define (list-of-oci-records? name predicate value)
+ (map
+ (lambda (el)
+ (if (predicate el)
+ el
+ (raise
+ (formatted-message
+ (G_ "~a contains an illegal value: ~a") name el))))
+ value))
+
(define-maybe/no-serialization string)
+(define-maybe/no-serialization package)
+(define-maybe/no-serialization subid-range)
(define-configuration/no-serialization oci-image
(repository
@@ -436,10 +552,12 @@ (define-configuration/no-serialization oci-image
(define-configuration/no-serialization oci-container-configuration
(user
(string "oci-container")
- "The user under whose authority docker commands will be run.")
+ "The user name under whose authority OCI commands will be run.")
(group
(string "docker")
- "The group under whose authority docker commands will be run.")
+ "The group name under whose authority OCI commands will be run. When
+using the @code{'podman} OCI runtime, this field will be ignored and the
+default group of the user configured in the @code{user} field will be used.")
(command
(list-of-strings '())
"Overwrite the default command (@code{CMD}) of the image.")
@@ -449,9 +567,9 @@ (define-configuration/no-serialization oci-container-configuration
(host-environment
(list '())
"Set environment variables in the host environment where @command{docker run}
-is invoked. This is especially useful to pass secrets from the host to the
-container without having them on the @command{docker run}'s command line: by
-setting the @code{MYSQL_PASSWORD} on the host and by passing
+or @command{podman run} are invoked. This is especially useful to pass secrets
+from the host to the container without having them on the OCI runtime command line,
+for example: by setting the @code{MYSQL_PASSWORD} on the host and by passing
@code{--env MYSQL_PASSWORD} through the @code{extra-arguments} field, it is
possible to securely set values in the container environment. This field's
value can be a list of pairs or strings, even mixed:
@@ -475,15 +593,16 @@ (define-configuration/no-serialization oci-container-configuration
@end lisp
Pair members can be strings, gexps or file-like objects. Strings are passed
-directly to the Docker CLI. You can refer to the
-@url{https://docs.docker.com/engine/reference/commandline/run/#env,upstream}
-documentation for semantics."
+directly to the OCI runtime CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#env,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#env-e-env,Podman}
+upstream documentation for semantics."
(sanitizer oci-sanitize-environment))
(image
(string-or-oci-image)
"The image used to build the container. It can be a string or an
-@code{oci-image} record. Strings are resolved by the Docker
-Engine, and follow the usual format
+@code{oci-image} record. Strings are resolved by the OCI runtime,
+and follow the usual format
@code{myregistry.local:5000/testing/test-image:tag}.")
(provision
(maybe-string)
@@ -512,7 +631,7 @@ (define-configuration/no-serialization oci-container-configuration
(sanitizer oci-sanitize-shepherd-actions))
(network
(maybe-string)
- "Set a Docker network for the spawned container.")
+ "Set an OCI network for the spawned container.")
(ports
(list '())
"Set the port or port ranges to expose from the spawned container. This can
@@ -524,9 +643,10 @@ (define-configuration/no-serialization oci-container-configuration
@end lisp
Pair members can be strings, gexps or file-like objects. Strings are passed
-directly to the Docker CLI. You can refer to the
-@url{https://docs.docker.com/engine/reference/commandline/run/#publish,upstream}
-documentation for semantics."
+directly to the OCI runtime CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#publish,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#publish-p-ip-hostport-containerport-protocol,Podman}
+upstream documentation for semantics."
(sanitizer oci-sanitize-ports))
(volumes
(list '())
@@ -539,63 +659,326 @@ (define-configuration/no-serialization oci-container-configuration
@end lisp
Pair members can be strings, gexps or file-like objects. Strings are passed
-directly to the Docker CLI. You can refer to the
-@url{https://docs.docker.com/engine/reference/commandline/run/#volume,upstream}
-documentation for semantics."
+directly to the OCI runtime CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#volume,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#volume-v-source-volume-host-dir-container-dir-options,Podman}
+upstream documentation for semantics."
(sanitizer oci-sanitize-volumes))
(container-user
(maybe-string)
"Set the current user inside the spawned container. You can refer to the
-@url{https://docs.docker.com/engine/reference/run/#user,upstream}
-documentation for semantics.")
+@url{https://docs.docker.com/engine/reference/run/#user,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#user-u-user-group,Podman}
+upstream documentation for semantics.")
(workdir
(maybe-string)
- "Set the current working for the spawned Shepherd service.
+ "Set the current working directory for the spawned Shepherd service.
You can refer to the
-@url{https://docs.docker.com/engine/reference/run/#workdir,upstream}
-documentation for semantics.")
+@url{https://docs.docker.com/engine/reference/run/#workdir,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#workdir-w-dir,Podman}
+upstream documentation for semantics.")
(extra-arguments
(list '())
"A list of strings, gexps or file-like objects that will be directly passed
-to the @command{docker run} invokation."
+to the @command{docker run} or @command{podman run} invokation."
(sanitizer oci-sanitize-extra-arguments)))
-(define oci-container-configuration->options
- (lambda (config)
- (let ((entrypoint
- (oci-container-configuration-entrypoint config))
- (network
- (oci-container-configuration-network config))
- (user
- (oci-container-configuration-container-user config))
- (workdir
- (oci-container-configuration-workdir config)))
- (apply append
- (filter (compose not unspecified?)
- `(,(if (maybe-value-set? entrypoint)
- `("--entrypoint" ,entrypoint)
- '())
- ,(append-map
- (lambda (spec)
- (list "--env" spec))
- (oci-container-configuration-environment config))
- ,(if (maybe-value-set? network)
- `("--network" ,network)
- '())
- ,(if (maybe-value-set? user)
- `("--user" ,user)
- '())
- ,(if (maybe-value-set? workdir)
- `("--workdir" ,workdir)
- '())
- ,(append-map
- (lambda (spec)
- (list "-p" spec))
- (oci-container-configuration-ports config))
- ,(append-map
- (lambda (spec)
- (list "-v" spec))
- (oci-container-configuration-volumes config))))))))
+(define (list-of-oci-containers? value)
+ (list-of-oci-records? "containers" oci-container-configuration? value))
+
+(define-configuration/no-serialization oci-volume-configuration
+ (name
+ (string)
+ "The name of the OCI volume to provision.")
+ (labels
+ (list '())
+ "The list of labels that will be used to tag the current volume."
+ (sanitizer oci-sanitize-labels))
+ (extra-arguments
+ (list '())
+ "A list of strings, gexps or file-like objects that will be directly passed
+to the runtime invokation."
+ (sanitizer oci-sanitize-extra-arguments)))
+
+(define (list-of-oci-volumes? value)
+ (list-of-oci-records? "volumes" oci-volume-configuration? value))
+
+(define-configuration/no-serialization oci-network-configuration
+ (name
+ (string)
+ "The name of the OCI network to provision.")
+ (driver
+ (maybe-string)
+ "The driver to manage the network.")
+ (gateway
+ (maybe-string)
+ "IPv4 or IPv6 gateway for the subnet.")
+ (internal?
+ (boolean #f)
+ "Restrict external access to the network")
+ (ip-range
+ (maybe-string)
+ "Allocate container ip from a sub-range in CIDR format.")
+ (ipam-driver
+ (maybe-string)
+ "IP Address Management Driver.")
+ (ipv6?
+ (boolean #f)
+ "Enable IPv6 networking.")
+ (subnet
+ (maybe-string)
+ "Subnet in CIDR format that represents a network segment.")
+ (labels
+ (list '())
+ "The list of labels that will be used to tag the current volume."
+ (sanitizer oci-sanitize-labels))
+ (extra-arguments
+ (list '())
+ "A list of strings, gexps or file-like objects that will be directly passed
+to the runtime invokation."
+ (sanitizer oci-sanitize-extra-arguments)))
+
+(define (list-of-oci-networks? value)
+ (list-of-oci-records? "networks" oci-network-configuration? value))
+
+(define-configuration/no-serialization oci-configuration
+ (runtime
+ (symbol 'docker)
+ "The OCI runtime to use to run commands. It can be either @code{'docker} or
+@code{'podman}."
+ (sanitizer oci-sanitize-runtime))
+ (runtime-cli
+ (maybe-package)
+ "The OCI runtime command line to be installed in the system profile and used
+to provision OCI resources. When unset it will default to @code{docker-cli}
+package for the @code{'docker} runtime or to @code{podman} package for the
+@code{'podman} runtime.")
+ (runtime-extra-arguments
+ (list '())
+ "A list of strings, gexps or file-like objects that will be placed
+after each @command{docker} or @command{podman} invokation.")
+ (user
+ (string "oci-container")
+ "The user name under whose authority OCI runtime commands will be run.")
+ (group
+ (maybe-string)
+ "The group name under whose authority OCI commands will be run. When
+using the @code{'podman} OCI runtime, this field will be ignored and the
+default group of the user configured in the @code{user} field will be used.")
+ (subuids-range
+ (maybe-subid-range)
+ "An optional @code{subid-range} record allocating subuids for the user from
+the @code{user} field. When unset, with the rootless Podman OCI runtime, it
+defaults to @code{(subid-range (name \"oci-container\"))}.")
+ (subgids-range
+ (maybe-subid-range)
+ "An optional @code{subid-range} record allocating subgids for the user from
+the @code{user} field. When unset, with the rootless Podman OCI runtime, it
+defaults to @code{(subid-range (name \"oci-container\"))}.")
+ (containers
+ (list-of-oci-containers '())
+ "The list of @code{oci-container-configuration} records representing the
+containers to provision. Most users are supposed not to use this field and use
+the @code{oci-extension} record instead.")
+ (networks
+ (list-of-oci-networks '())
+ "The list of @code{oci-network-configuration} records representing the
+networks to provision. Most users are supposed not to use this field and use
+the @code{oci-extension} record instead.")
+ (volumes
+ (list-of-oci-volumes '())
+ "The list of @code{oci-volume-configuration} records representing the
+volumes to provision. Most users are supposed not to use this field and use
+the @code{oci-extension} record instead.")
+ (verbose?
+ (boolean #f)
+ "When true, additional output will be printed, allowing to better follow the
+flow of execution."))
+
+(define (oci-runtime-system-environment runtime user)
+ (if (eq? runtime 'podman)
+ (list
+ #~(string-append
+ "HOME=" (passwd:dir (getpwnam #$user))))
+ #~()))
+
+(define (oci-runtime-system-group runtime user group)
+ (if (eq? runtime 'podman)
+ #~(group:name
+ (getgrgid
+ (passwd:gid
+ (getpwnam #$user))))
+ group))
+
+(define (oci-runtime-cli runtime runtime-cli path)
+ "Return a gexp that, when lowered, evaluates to the file system path of the OCI
+runtime command requested by the user."
+ (if (string? runtime-cli)
+ ;; It is a user defined absolute path
+ runtime-cli
+ #~(string-append
+ #$(if (maybe-value-set? runtime-cli)
+ runtime-cli
+ path)
+ #$(if (eq? 'podman runtime)
+ "/bin/podman"
+ "/bin/docker"))))
+
+(define* (oci-runtime-system-cli config #:key (path "/run/current-system/profile"))
+ (let ((runtime-cli
+ (oci-configuration-runtime-cli config))
+ (runtime
+ (oci-configuration-runtime config)))
+ (oci-runtime-cli runtime runtime-cli path)))
+
+(define-configuration/no-serialization oci-extension
+ (containers
+ (list-of-oci-containers '())
+ "The list of @code{oci-container-configuration} records representing the
+containers to add.")
+ (networks
+ (list-of-oci-networks '())
+ "The list of @code{oci-network-configuration} records representing the
+networks to add.")
+ (volumes
+ (list-of-oci-volumes '())
+ "The list of @code{oci-volume-configuration} records representing the
+volumes to add."))
+
+(define (oci-image->container-name image)
+ "Infer the name of an OCI backed Shepherd service from its OCI image."
+ (basename
+ (if (string? image)
+ (first (string-split image #\:))
+ (oci-image-repository image))))
+
+(define (oci-object-command-shepherd-action object-name invokation)
+ "Return a Shepherd action printing a given INVOKATION of an OCI command for the
+given OBJECT-NAME."
+ (shepherd-action
+ (name 'command-line)
+ (documentation
+ (format #f "Prints ~a's OCI runtime command line invokation."
+ object-name))
+ (procedure
+ #~(lambda _
+ (format #t "~a~%" #$invokation)))))
+
+(define (oci-container-shepherd-name runtime config)
+ "Return the name of an OCI backed Shepherd service based on CONFIG.
+The name configured in the configuration record is returned when
+CONFIG's name field has a value, otherwise a name is inferred from CONFIG's
+image field."
+ (define name (oci-container-configuration-provision config))
+ (define image (oci-container-configuration-image config))
+
+ (if (maybe-value-set? name)
+ name
+ (string-append (symbol->string runtime) "-"
+ (oci-image->container-name image))))
+
+(define (oci-networks-shepherd-name runtime)
+ "Return the name of the OCI networks provisioning Shepherd service based on
+RUNTIME."
+ (string-append (symbol->string runtime) "-networks"))
+
+(define (oci-volumes-shepherd-name runtime)
+ "Return the name of the OCI volumes provisioning Shepherd service based on
+RUNTIME."
+ (string-append (symbol->string runtime) "-volumes"))
+
+(define (oci-container-configuration->options config)
+ "Map CONFIG, an oci-container-configuration record, to a gexp that, upon
+lowering, will be evaluated to a list of strings containing command line options
+for the OCI runtime run command."
+ (let ((entrypoint
+ (oci-container-configuration-entrypoint config))
+ (network
+ (oci-container-configuration-network config))
+ (user
+ (oci-container-configuration-container-user config))
+ (workdir
+ (oci-container-configuration-workdir config)))
+ (apply append
+ (filter (compose not unspecified?)
+ `(,(if (maybe-value-set? entrypoint)
+ `("--entrypoint" ,entrypoint)
+ '())
+ ,(append-map
+ (lambda (spec)
+ (list "--env" spec))
+ (oci-container-configuration-environment config))
+ ,(if (maybe-value-set? network)
+ `("--network" ,network)
+ '())
+ ,(if (maybe-value-set? user)
+ `("--user" ,user)
+ '())
+ ,(if (maybe-value-set? workdir)
+ `("--workdir" ,workdir)
+ '())
+ ,(append-map
+ (lambda (spec)
+ (list "-p" spec))
+ (oci-container-configuration-ports config))
+ ,(append-map
+ (lambda (spec)
+ (list "-v" spec))
+ (oci-container-configuration-volumes config)))))))
+
+(define (oci-network-configuration->options config)
+ "Map CONFIG, an oci-network-configuration record, to a gexp that, upon
+lowering, will be evaluated to a list of strings containing command line options
+for the OCI runtime network create command."
+ (let ((driver (oci-network-configuration-driver config))
+ (gateway
+ (oci-network-configuration-gateway config))
+ (internal?
+ (oci-network-configuration-internal? config))
+ (ip-range
+ (oci-network-configuration-ip-range config))
+ (ipam-driver
+ (oci-network-configuration-ipam-driver config))
+ (ipv6?
+ (oci-network-configuration-ipv6? config))
+ (subnet
+ (oci-network-configuration-subnet config)))
+ (apply append
+ (filter (compose not unspecified?)
+ `(,(if (maybe-value-set? driver)
+ `("--driver" ,driver)
+ '())
+ ,(if (maybe-value-set? gateway)
+ `("--gateway" ,gateway)
+ '())
+ ,(if internal?
+ `("--internal")
+ '())
+ ,(if (maybe-value-set? ip-range)
+ `("--ip-range" ,ip-range)
+ '())
+ ,(if (maybe-value-set? ipam-driver)
+ `("--ipam-driver" ,ipam-driver)
+ '())
+ ,(if ipv6?
+ `("--ipv6")
+ '())
+ ,(if (maybe-value-set? subnet)
+ `("--subnet" ,subnet)
+ '())
+ ,(append-map
+ (lambda (spec)
+ (list "--label" spec))
+ (oci-network-configuration-labels config)))))))
+
+(define (oci-volume-configuration->options config)
+ "Map CONFIG, an oci-volume-configuration record, to a gexp that, upon
+lowering, will be evaluated to a list of strings containing command line options
+for the OCI runtime volume create command."
+ (append-map
+ (lambda (spec)
+ (list "--label" spec))
+ (oci-volume-configuration-labels config)))
(define* (get-keyword-value args keyword #:key (default #f))
(let ((kv (memq keyword args)))
@@ -604,6 +987,7 @@ (define* (get-keyword-value args keyword #:key (default #f))
default)))
(define (lower-operating-system os target system)
+ "Lower OS, an operating-system record, into a tarball containing an OCI image."
(mlet* %store-monad
((tarball
(lower-object
@@ -613,6 +997,7 @@ (define (lower-operating-system os target system)
(return tarball)))
(define (lower-manifest name image target system)
+ "Lower IMAGE, a manifest record, into a tarball containing an OCI image."
(define value (oci-image-value image))
(define options (oci-image-pack-options image))
(define image-reference
@@ -645,6 +1030,7 @@ (define (lower-manifest name image target system)
(return tarball)))
(define (lower-oci-image name image)
+ "Lower IMAGE, a oci-image record, into a tarball containing an OCI image."
(define value (oci-image-value image))
(define image-target (oci-image-target image))
(define image-system (oci-image-system image))
@@ -675,9 +1061,10 @@ (define (lower-oci-image name image)
#:target target
#:system system)))
-(define (%oci-image-loader name image tag)
- (let ((docker (file-append docker-cli "/bin/docker"))
- (tarball (lower-oci-image name image)))
+(define* (oci-image-loader runtime-cli name image tag #:key (verbose? #f))
+ "Return a file-like object that, once lowered, will evaluate to a program able
+to load IMAGE through RUNTIME-CLI and to tag it with TAG afterwards."
+ (let ((tarball (lower-oci-image name image)))
(with-imported-modules '((guix build utils))
(program-file (format #f "~a-image-loader" name)
#~(begin
@@ -686,102 +1073,561 @@ (define (%oci-image-loader name image tag)
(ice-9 rdelim))
(format #t "Loading image for ~a from ~a...~%" #$name #$tarball)
+ (define load-command
+ (string-append #$runtime-cli
+ " load -i " #$tarball))
+ (when #$verbose?
+ (format #t "Running ~a~%" load-command))
(define line
(read-line
- (open-input-pipe
- (string-append #$docker " load -i " #$tarball))))
+ (open-input-pipe load-command)))
(unless (or (eof-object? line)
(string-null? line))
(format #t "~a~%" line)
- (let ((repository&tag
- (string-drop line
- (string-length
- "Loaded image: "))))
+ (let* ((repository&tag
+ (string-drop line
+ (string-length
+ "Loaded image: ")))
+ (tag-command
+ (list #$runtime-cli "tag" repository&tag #$tag)))
+
+ (when #$verbose?
+ (format #t "Running~{ ~a~}~%" tag-command))
- (invoke #$docker "tag" repository&tag #$tag)
+ (apply invoke tag-command)
(format #t "Tagged ~a with ~a...~%" #$tarball #$tag))))))))
-(define (oci-container-shepherd-service config)
- (define (guess-name name image)
- (if (maybe-value-set? name)
- name
- (string-append "docker-"
- (basename
- (if (string? image)
- (first (string-split image #\:))
- (oci-image-repository image))))))
-
- (let* ((docker (file-append docker-cli "/bin/docker"))
- (actions (oci-container-configuration-shepherd-actions config))
+(define (oci-container-run-invokation runtime-cli name command image-reference
+ options runtime-extra-arguments run-extra-arguments)
+ "Return a list representing the OCI runtime
+invokation for running containers."
+ ;; run [OPTIONS] IMAGE [COMMAND] [ARG...]
+ `(,runtime-cli ,@runtime-extra-arguments "run"
+ "--rm" "--name" ,name
+ ,@options ,@run-extra-arguments
+ ,image-reference ,@command))
+
+(define* (oci-container-entrypoint runtime-cli name image image-reference
+ invokation #:key (verbose? #f))
+ "Return a file-like object that, once lowered, will evaluate to the entrypoint
+for the Shepherd service that will run IMAGE through RUNTIME-CLI."
+ (program-file
+ (string-append "oci-entrypoint-" name)
+ #~(begin
+ (use-modules (ice-9 format)
+ (srfi srfi-1))
+ (when #$verbose?
+ (format #t "Running in verbose mode...~%"))
+ (define invokation (list #$@invokation))
+ #$@(if (oci-image? image)
+ #~((system*
+ #$(oci-image-loader
+ runtime-cli name image
+ image-reference #:verbose? verbose?)))
+ #~())
+ (when #$verbose?
+ (format #t "Running~{ ~a~}~%" invokation))
+ (apply execlp `(,(first invokation) ,@invokation)))))
+
+(define* (oci-container-shepherd-service runtime runtime-cli config
+ #:key
+ (runtime-environment #~())
+ (runtime-extra-arguments '())
+ (oci-requirement '())
+ (user #f)
+ (group #f)
+ (verbose? #f))
+ "Return a Shepherd service object that will run the OCI container represented
+by CONFIG through RUNTIME-CLI."
+ (let* ((actions (oci-container-configuration-shepherd-actions config))
(auto-start?
(oci-container-configuration-auto-start? config))
- (user (oci-container-configuration-user config))
- (group (oci-container-configuration-group config))
+ (user (or user (oci-container-configuration-user config)))
+ (group (if (and group (maybe-value-set? group))
+ group
+ (oci-container-configuration-group config)))
(host-environment
(oci-container-configuration-host-environment config))
(command (oci-container-configuration-command config))
(log-file (oci-container-configuration-log-file config))
- (provision (oci-container-configuration-provision config))
(requirement (oci-container-configuration-requirement config))
(respawn?
(oci-container-configuration-respawn? config))
(image (oci-container-configuration-image config))
(image-reference (oci-image-reference image))
(options (oci-container-configuration->options config))
- (name (guess-name provision image))
+ (name
+ (oci-container-shepherd-name runtime config))
(extra-arguments
- (oci-container-configuration-extra-arguments config)))
+ (oci-container-configuration-extra-arguments config))
+ (invokation
+ (oci-container-run-invokation
+ runtime-cli name command image-reference
+ options runtime-extra-arguments extra-arguments)))
(shepherd-service (provision `(,(string->symbol name)))
- (requirement `(dockerd user-processes ,@requirement))
+ (requirement `(,@oci-requirement
+ ,@requirement))
(respawn? respawn?)
(auto-start? auto-start?)
(documentation
(string-append
- "Docker backed Shepherd service for "
+ (oci-runtime-name runtime) " backed Shepherd service for "
(if (oci-image? image) name image) "."))
(start
#~(lambda ()
- #$@(if (oci-image? image)
- #~((invoke #$(%oci-image-loader
- name image image-reference)))
- #~())
(fork+exec-command
- ;; docker run [OPTIONS] IMAGE [COMMAND] [ARG...]
- (list #$docker "run" "--rm" "--name" #$name
- #$@options #$@extra-arguments
- #$image-reference #$@command)
- #:user #$user
- #:group #$group
+ (list
+ #$(oci-container-entrypoint
+ runtime-cli name image image-reference
+ invokation #:verbose? verbose?))
+ #$@(if user (list #:user user) '())
+ #$@(if group (list #:group group) '())
#$@(if (maybe-value-set? log-file)
(list #:log-file log-file)
'())
+ #$@(if (eq? runtime 'podman)
+ (list #:directory
+ #~(passwd:dir (getpwnam #$user)))
+ '())
#:environment-variables
- (list #$@host-environment))))
+ (append
+ (list #$@host-environment)
+ (list #$@runtime-environment)))))
(stop
#~(lambda _
- (invoke #$docker "rm" "-f" #$name)))
+ (invoke #$runtime-cli "rm" "-f" #$name)))
(actions
- (if (oci-image? image)
- '()
- (append
+ (append
+ (list
+ (oci-object-command-shepherd-action
+ name #~(string-join (list #$@invokation) " ")))
+ (if (oci-image? image)
+ '()
(list
- (shepherd-action
- (name 'pull)
- (documentation
- (format #f "Pull ~a's image (~a)."
- name image))
- (procedure
- #~(lambda _
- (invoke #$docker "pull" #$image)))))
- actions))))))
-
-(define %oci-container-accounts
+ (let ((service-name name))
+ (shepherd-action
+ (name 'pull)
+ (documentation
+ (format #f "Pull ~a's image (~a)."
+ service-name image))
+ (procedure
+ #~(lambda _
+ (invoke #$runtime-cli "pull" #$image)))))))
+ actions)))))
+
+(define (oci-object-create-invokation object runtime-cli name options
+ runtime-extra-arguments
+ create-extra-arguments)
+ "Return a gexp that, upon lowering, will evaluate to the OCI runtime
+invokation for creating networks and volumes."
+ ;; network|volume create [options] [NAME]
+ #~(list #$runtime-cli #$@runtime-extra-arguments #$object "create"
+ #$@options #$@create-extra-arguments #$name))
+
+(define (format-oci-invokations invokations)
+ "Return a gexp that, upon lowering, will evaluate to a formatted message
+containing the INVOKATIONS that the OCI runtime will execute to provision
+networks or volumes."
+ #~(string-join (map (lambda (i) (string-join i " "))
+ (list #$@invokations))
+ "\n"))
+
+(define* (oci-object-create-script object runtime runtime-cli invokations
+ #:key (verbose? #f))
+ "Return a file-like object that, once lowered, will evaluate to a program able
+to create OCI networks and volumes through RUNTIME-CLI."
+ (define runtime-string (symbol->string runtime))
+ (program-file
+ (string-append runtime-string "-" object "s-create.scm")
+ #~(begin
+ (use-modules (ice-9 format)
+ (ice-9 match)
+ (ice-9 popen)
+ (ice-9 rdelim)
+ (srfi srfi-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 (object-exists? name)
+ #$(if (eq? runtime 'podman)
+ #~(let ((command
+ (list #$runtime-cli
+ #$object "exists" name)))
+ (when #$verbose?
+ (format #t "Running~{ ~a~}~%" command))
+ (define exit-code (status:exit-val (apply system* command)))
+ (when #$verbose?
+ (format #t "Exit code: ~a~%" exit-code))
+ (equal? EXIT_SUCCESS exit-code))
+ #~(let ((command
+ (string-append #$runtime-cli
+ " " #$object " ls --format "
+ "\"{{.Name}}\"")))
+ (when #$verbose?
+ (format #t "Running ~a~%" command))
+ (member name (read-lines (open-input-pipe command))))))
+
+ (for-each
+ (lambda (invokation)
+ (define name (last invokation))
+ (if (object-exists? name)
+ (format #t "~a ~a ~a already exists, skipping creation.~%"
+ #$(oci-runtime-name runtime) name #$object)
+ (begin
+ (when #$verbose?
+ (format #t "Running~{ ~a~}~%" invokation))
+ (let ((exit-code (status:exit-val (apply system* invokation))))
+ (when #$verbose?
+ (format #t "Exit code: ~a~%" exit-code))))))
+ (list #$@invokations)))))
+
+(define* (oci-object-shepherd-service object runtime runtime-cli name requirement invokations
+ #:key
+ (runtime-environment #~())
+ (user #f)
+ (group #f)
+ (verbose? #f))
+ "Return a Shepherd service object that will create the OBJECTs represented
+by INVOKATIONS through RUNTIME-CLI."
+ (shepherd-service (provision `(,(string->symbol name)))
+ (requirement requirement)
+ (one-shot? #t)
+ (documentation
+ (string-append
+ (oci-runtime-name runtime) " " object
+ " provisioning service"))
+ (start
+ #~(lambda _
+ (fork+exec-command
+ (list
+ #$(oci-object-create-script
+ object runtime runtime-cli
+ invokations
+ #:verbose? verbose?))
+ #$@(if user (list #:user user) '())
+ #$@(if group (list #:group group) '())
+ #:environment-variables
+ (list #$@runtime-environment))))
+ (actions
+ (list
+ (oci-object-command-shepherd-action
+ name (format-oci-invokations invokations))))))
+
+(define* (oci-networks-shepherd-service runtime runtime-cli name networks
+ #:key (user #f) (group #f) (verbose? #f)
+ (runtime-extra-arguments '())
+ (runtime-environment #~())
+ (runtime-requirement '()))
+ "Return a Shepherd service object that will create the networks represented
+in CONFIG."
+ (let ((invokations
+ (map
+ (lambda (network)
+ (oci-object-create-invokation
+ "network" runtime-cli
+ (oci-network-configuration-name network)
+ (oci-network-configuration->options network)
+ runtime-extra-arguments
+ (oci-network-configuration-extra-arguments network)))
+ networks)))
+
+ (oci-object-shepherd-service
+ "network" runtime runtime-cli name
+ runtime-requirement invokations
+ #:user user #:group group #:runtime-environment runtime-environment
+ #:verbose? verbose?)))
+
+(define* (oci-volumes-shepherd-service runtime runtime-cli name volumes
+ #:key (user #f) (group #f) (verbose? #f)
+ (runtime-extra-arguments '())
+ (runtime-environment #~())
+ (runtime-requirement '()))
+ "Return a Shepherd service object that will create the volumes represented
+in CONFIG."
+ (let ((invokations
+ (map
+ (lambda (volume)
+ (oci-object-create-invokation
+ "volume" runtime-cli
+ (oci-volume-configuration-name volume)
+ (oci-volume-configuration->options volume)
+ runtime-extra-arguments
+ (oci-volume-configuration-extra-arguments volume)))
+ volumes)))
+
+ (oci-object-shepherd-service
+ "volume" runtime runtime-cli name runtime-requirement invokations
+ #:user user #:group group #:runtime-environment runtime-environment
+ #:verbose? verbose?)))
+
+(define (oci-service-accounts config)
+ (define user (oci-configuration-user config))
+ (define maybe-group (oci-configuration-group config))
+ (define runtime (oci-configuration-runtime config))
(list (user-account
- (name "oci-container")
+ (name user)
(comment "OCI services account")
- (group "docker")
- (system? #t)
- (home-directory "/var/empty")
+ (group "users")
+ (supplementary-groups
+ (list (oci-runtime-group runtime maybe-group)))
+ (system? (eq? 'docker runtime))
+ (home-directory (if (eq? 'podman runtime)
+ (string-append "/home/" user)
+ "/var/empty"))
+ (create-home-directory? (eq? 'podman runtime))
(shell (file-append shadow "/sbin/nologin")))))
+
+(define* (oci-state->shepherd-services runtime runtime-cli containers networks volumes
+ #:key (user #f) (group #f) (verbose? #f)
+ (networks-name #f) (volumes-name #f)
+ (runtime-extra-arguments '())
+ (runtime-environment #~())
+ (runtime-requirement '())
+ (containers-requirement '())
+ (networks-requirement '())
+ (volumes-requirement '()))
+ (let* ((networks?
+ (> (length networks) 0))
+ (networks-service
+ (if networks?
+ (list
+ (string->symbol
+ (oci-networks-shepherd-name runtime)))
+ '()))
+ (volumes?
+ (> (length volumes) 0))
+ (volumes-service
+ (if volumes?
+ (list
+ (string->symbol
+ (oci-volumes-shepherd-name runtime)))
+ '())))
+ (append
+ (map
+ (lambda (c)
+ (oci-container-shepherd-service
+ runtime runtime-cli c
+ #:user user
+ #:group group
+ #:runtime-environment runtime-environment
+ #:runtime-extra-arguments runtime-extra-arguments
+ #:oci-requirement
+ (append containers-requirement
+ runtime-requirement
+ networks-service
+ volumes-service)
+ #:verbose? verbose?))
+ containers)
+ (if networks?
+ (list
+ (oci-networks-shepherd-service
+ runtime runtime-cli
+ (if (string? networks-name)
+ networks-name
+ (oci-networks-shepherd-name runtime))
+ networks
+ #:user user #:group group
+ #:runtime-extra-arguments runtime-extra-arguments
+ #:runtime-environment runtime-environment
+ #:runtime-requirement (append networks-requirement
+ runtime-requirement)
+ #:verbose? verbose?))
+ '())
+ (if volumes?
+ (list
+ (oci-volumes-shepherd-service
+ runtime runtime-cli
+ (if (string? volumes-name)
+ volumes-name
+ (oci-volumes-shepherd-name runtime))
+ volumes
+ #:user user #:group group
+ #:runtime-extra-arguments runtime-extra-arguments
+ #:runtime-environment runtime-environment
+ #:runtime-requirement (append runtime-requirement
+ volumes-requirement)
+ #:verbose? verbose?))
+ '()))))
+
+(define (oci-configuration->shepherd-services config)
+ (let* ((runtime (oci-configuration-runtime config))
+ (runtime-cli
+ (oci-runtime-system-cli config))
+ (runtime-extra-arguments
+ (oci-configuration-runtime-extra-arguments config))
+ (containers (oci-configuration-containers config))
+ (networks (oci-configuration-networks config))
+ (volumes (oci-configuration-volumes config))
+ (user (oci-configuration-user config))
+ (group (oci-runtime-group
+ runtime (oci-configuration-group config)))
+ (verbose? (oci-configuration-verbose? config)))
+ (oci-state->shepherd-services runtime runtime-cli containers networks volumes
+ #:user user
+ #:group
+ (oci-runtime-system-group runtime user group)
+ #:verbose? verbose?
+ #:runtime-extra-arguments
+ runtime-extra-arguments
+ #:runtime-environment
+ (oci-runtime-system-environment runtime user)
+ #:runtime-requirement
+ (oci-runtime-system-requirement runtime)
+ #:networks-requirement '(networking))))
+
+(define (oci-service-subids config)
+ "Return a subids-extension record representing subuids and subgids required by
+the rootless Podman backend."
+ (define (delete-duplicate-ranges ranges)
+ (delete-duplicates ranges
+ (lambda args
+ (apply string=? (map subid-range-name ranges)))))
+ (define runtime
+ (oci-configuration-runtime config))
+ (define user
+ (oci-configuration-user config))
+ (define subgids (oci-configuration-subgids-range config))
+ (define subuids (oci-configuration-subuids-range config))
+ (define container-users
+ (filter (lambda (range) (not (string=? (subid-range-name range) user)))
+ (map (lambda (container)
+ (subid-range
+ (name
+ (oci-container-configuration-user container))))
+ (oci-configuration-containers config))))
+ (define subgid-ranges
+ (delete-duplicate-ranges
+ (cons
+ (if (maybe-value-set? subgids)
+ subgids
+ (subid-range (name user)))
+ container-users)))
+ (define subuid-ranges
+ (delete-duplicate-ranges
+ (cons
+ (if (maybe-value-set? subuids)
+ subuids
+ (subid-range (name user)))
+ container-users)))
+
+ (if (eq? 'podman runtime)
+ (subids-extension
+ (subgids
+ subgid-ranges)
+ (subuids
+ subuid-ranges))
+ (subids-extension)))
+
+(define (oci-objects-merge-lst a b object get-name)
+ (define (contains? value lst)
+ (member value (map get-name lst)))
+ (let loop ((merged '())
+ (lst (append a b)))
+ (if (null? lst)
+ merged
+ (loop
+ (let ((element (car lst)))
+ (when (contains? element merged)
+ (raise
+ (formatted-message
+ (G_ "Duplicated ~a: ~a. ~as names should be unique, please
+remove the duplicate.") object (get-name element) object)))
+ (cons element merged))
+ (cdr lst)))))
+
+(define (oci-extension-merge a b)
+ (oci-extension
+ (containers (oci-objects-merge-lst
+ (oci-extension-containers a)
+ (oci-extension-containers b)
+ "container"
+ (lambda (config)
+ (define maybe-name (oci-container-configuration-provision config))
+ (if (maybe-value-set? maybe-name)
+ maybe-name
+ (oci-image->container-name
+ (oci-container-configuration-image config))))))
+ (networks (oci-objects-merge-lst
+ (oci-extension-networks a)
+ (oci-extension-networks b)
+ "network"
+ oci-networks-shepherd-name))
+ (volumes (oci-objects-merge-lst
+ (oci-extension-volumes a)
+ (oci-extension-volumes b)
+ "volume"
+ oci-volumes-shepherd-name))))
+
+(define (oci-service-profile runtime runtime-cli)
+ (list bash-minimal
+ (cond
+ ((maybe-value-set? runtime-cli)
+ runtime-cli)
+ ((eq? 'podman runtime)
+ podman)
+ (else
+ docker-cli))))
+
+(define oci-service-type
+ (service-type (name 'oci)
+ (extensions
+ (list
+ (service-extension profile-service-type
+ (lambda (config)
+ (let ((runtime-cli
+ (oci-configuration-runtime-cli config))
+ (runtime
+ (oci-configuration-runtime config)))
+ (oci-service-profile runtime runtime-cli))))
+ (service-extension subids-service-type
+ oci-service-subids)
+ (service-extension account-service-type
+ oci-service-accounts)
+ (service-extension shepherd-root-service-type
+ oci-configuration->shepherd-services)))
+ ;; Concatenate OCI object lists.
+ (compose (lambda (args)
+ (fold oci-extension-merge
+ (oci-extension)
+ args)))
+ (extend
+ (lambda (config extension)
+ (oci-configuration
+ (inherit config)
+ (containers
+ (oci-objects-merge-lst
+ (oci-configuration-containers config)
+ (oci-extension-containers extension)
+ "container"
+ (lambda (oci-config)
+ (define runtime
+ (oci-configuration-runtime config))
+ (oci-container-shepherd-name runtime oci-config))))
+ (networks (oci-objects-merge-lst
+ (oci-configuration-networks config)
+ (oci-extension-networks extension)
+ "network"
+ oci-networks-shepherd-name))
+ (volumes (oci-objects-merge-lst
+ (oci-configuration-volumes config)
+ (oci-extension-volumes extension)
+ "volume"
+ oci-volumes-shepherd-name)))))
+ (default-value (oci-configuration))
+ (description
+ "This service implements the provisioning of OCI object such
+as containers, networks and volumes.")))
diff --git a/gnu/services/docker.scm b/gnu/services/docker.scm
index 69ff9f1d9e4..98ee175873d 100644
--- a/gnu/services/docker.scm
+++ b/gnu/services/docker.scm
@@ -31,7 +31,10 @@ (define-module (gnu services docker)
#:use-module (gnu system shadow)
#:use-module (gnu packages docker)
#:use-module (gnu packages linux) ;singularity
+ #:use-module (guix deprecation)
+ #:use-module (guix diagnostics)
#:use-module (guix gexp)
+ #:use-module (guix i18n)
#:use-module (guix records)
#:use-module (srfi srfi-1)
#:use-module (ice-9 format)
@@ -67,16 +70,18 @@ (define-module (gnu services docker)
oci-container-configuration-volumes
oci-container-configuration-container-user
oci-container-configuration-workdir
- oci-container-configuration-extra-arguments
- oci-container-shepherd-service
- %oci-container-accounts)
+ oci-container-configuration-extra-arguments)
#:export (containerd-configuration
containerd-service-type
docker-configuration
docker-service-type
singularity-service-type
- oci-container-service-type))
+ ;; for backwards compatibility, until the
+ ;; oci-container-service-type is fully deprecated
+ oci-container-shepherd-service
+ oci-container-service-type
+ %oci-container-accounts))
(define-maybe file-like)
@@ -295,17 +300,25 @@ (define singularity-service-type
;;; OCI container.
;;;
-(define (configs->shepherd-services configs)
- (map oci-container-shepherd-service configs))
+;; for backwards compatibility, until the
+;; oci-container-service-type is fully deprecated
+(define-deprecated (oci-container-shepherd-service config)
+ oci-service-type
+ ((@ (gnu services containers) oci-container-shepherd-service)
+ 'docker config))
+(define %oci-container-accounts
+ (filter user-account? (oci-service-accounts (oci-configuration))))
(define oci-container-service-type
(service-type (name 'oci-container)
- (extensions (list (service-extension profile-service-type
- (lambda _ (list docker-cli)))
- (service-extension account-service-type
- (const %oci-container-accounts))
- (service-extension shepherd-root-service-type
- configs->shepherd-services)))
+ (extensions
+ (list (service-extension oci-service-type
+ (lambda (containers)
+ (warning
+ (G_
+ "'oci-container-service-type' is deprecated, use 'oci-service-type' instead~%"))
+ (oci-extension
+ (containers containers))))))
(default-value '())
(extend append)
(compose concatenate)
diff --git a/gnu/tests/containers.scm b/gnu/tests/containers.scm
index 0ecc8ddb126..bac1f47bd34 100644
--- a/gnu/tests/containers.scm
+++ b/gnu/tests/containers.scm
@@ -27,6 +27,9 @@ (define-module (gnu tests containers)
#:use-module (gnu services)
#:use-module (gnu services containers)
#:use-module (gnu services desktop)
+ #:use-module ((gnu services docker)
+ #:select (containerd-service-type
+ docker-service-type))
#:use-module (gnu services dbus)
#:use-module (gnu services networking)
#:use-module (gnu system)
@@ -39,7 +42,9 @@ (define-module (gnu tests containers)
#:use-module (guix profiles)
#:use-module ((guix scripts pack) #:prefix pack:)
#:use-module (guix store)
- #:export (%test-rootless-podman))
+ #:export (%test-rootless-podman
+ %test-oci-service-rootless-podman
+ %test-oci-service-docker))
(define %rootless-podman-os
@@ -345,3 +350,995 @@ (define %test-rootless-podman
(name "rootless-podman")
(description "Test rootless Podman service.")
(value (build-tarball&run-rootless-podman-test))))
+
+
+(define %oci-rootless-podman-os
+ (simple-operating-system
+ (service dhcp-client-service-type)
+ (service dbus-root-service-type)
+ (service polkit-service-type)
+ (service elogind-service-type)
+ (service iptables-service-type)
+ (service rootless-podman-service-type)
+ (extra-special-file "/shared.txt"
+ (plain-file "shared.txt" "hello"))
+ (service oci-service-type
+ (oci-configuration
+ (runtime 'podman)
+ (verbose? #t)))
+ (simple-service 'oci-provisioning
+ oci-service-type
+ (oci-extension
+ (networks
+ (list (oci-network-configuration (name "my-network"))))
+ (volumes
+ (list (oci-volume-configuration (name "my-volume"))))
+ (containers
+ (list
+ (oci-container-configuration
+ (provision "first")
+ (image
+ (oci-image
+ (repository "guile")
+ (value
+ (specifications->manifest '("guile")))
+ (pack-options
+ '(#:symlinks (("/bin" -> "bin"))))))
+ (entrypoint "/bin/guile")
+ (network "my-network")
+ (command
+ '("-c" "(use-modules (web server))
+(define (handler request request-body)
+ (values '((content-type . (text/plain))) \"out of office\"))
+(run-server handler 'http `(#:addr ,(inet-pton AF_INET \"0.0.0.0\")))"))
+ (host-environment
+ '(("VARIABLE" . "value")))
+ (volumes
+ '(("my-volume" . "/my-volume")))
+ (extra-arguments
+ '("--env" "VARIABLE")))
+ (oci-container-configuration
+ (provision "second")
+ (image
+ (oci-image
+ (repository "guile")
+ (value
+ (specifications->manifest '("guile")))
+ (pack-options
+ '(#:symlinks (("/bin" -> "bin"))))))
+ (entrypoint "/bin/guile")
+ (network "my-network")
+ (command
+ '("-c" "(let l ((c 300))(display c)(sleep 1)(when(positive? c)(l (- c 1))))"))
+ (volumes
+ '(("my-volume" . "/my-volume")
+ ("/shared.txt" . "/shared.txt:ro"))))))))))
+
+(define (run-rootless-podman-oci-service-test)
+ (define os
+ (marionette-operating-system
+ (operating-system-with-gc-roots
+ %oci-rootless-podman-os
+ (list))
+ #: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))
+ #~(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-oci-service")
+
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (wait-for-service 'user-processes))
+ marionette)
+
+ (test-assert "rootless-podman services started successfully"
+ (begin
+ (define (run-test)
+ (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))
+ ;; Allow services to come up on slower machines
+ (let loop ((attempts 0))
+ (if (= attempts 60)
+ (error "Services didn't come up after more than 60 seconds")
+ (if (equal? '("cgroup" "cgroup")
+ (run-test))
+ #t
+ (begin
+ (sleep 1)
+ (format #t "Services didn't come up yet, retrying with attempt ~a~%"
+ (+ 1 attempts))
+ (loop (+ 1 attempts))))))))
+
+ (test-assert "podman-volumes running"
+ (begin
+ (define (run-test)
+ (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 6))
+ (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 "oci-container")))
+ (setuid (passwd:uid (getpw "oci-container")))
+
+ (let ((response (slurp
+ "/run/current-system/profile/bin/podman"
+ "volume" "ls" "-n" "--format" "\"{{.Name}}\""
+ "|" "tr" "' '" "'\n'")))
+
+ (call-with-output-file (string-append ,out-dir "/response")
+ (lambda (port)
+ (display (string-join response "\n") port)))))
+ (lambda ()
+ (primitive-exit 127))))
+ (pid
+ (cdr (waitpid pid))))
+
+ (wait-for-file (string-append ,out-dir "/response"))
+
+ (stable-sort
+ (slurp "cat" (string-append ,out-dir "/response"))
+ string<=?))
+ marionette))
+ ;; Allow services to come up on slower machines
+ (let loop ((attempts 0))
+ (if (= attempts 80)
+ (error "Service didn't come up after more than 80 seconds")
+ (if (equal? '("my-volume")
+ (run-test))
+ #t
+ (begin
+ (sleep 1)
+ (loop (+ 1 attempts))))))))
+
+ (test-assert "podman-networks running"
+ (begin
+ (define (run-test)
+ (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 6))
+ (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 "oci-container")))
+ (setuid (passwd:uid (getpw "oci-container")))
+
+ (let ((response (slurp
+ "/run/current-system/profile/bin/podman"
+ "network" "ls" "-n" "--format" "\"{{.Name}}\""
+ "|" "tr" "' '" "'\n'")))
+
+ (call-with-output-file (string-append ,out-dir "/response")
+ (lambda (port)
+ (display (string-join response "\n") port)))))
+ (lambda ()
+ (primitive-exit 127))))
+ (pid
+ (cdr (waitpid pid))))
+
+ (wait-for-file (string-append ,out-dir "/response"))
+
+ (stable-sort
+ (slurp "cat" (string-append ,out-dir "/response"))
+ string<=?))
+ marionette))
+ ;; Allow services to come up on slower machines
+ (let loop ((attempts 0))
+ (if (= attempts 80)
+ (error "Service didn't come up after more than 80 seconds")
+ (if (equal? '("my-network" "podman")
+ (run-test))
+ #t
+ (begin
+ (sleep 1)
+ (loop (+ 1 attempts))))))))
+
+ (test-assert "first container running"
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (wait-for-service 'first #:timeout 120)
+ #t)
+ marionette))
+
+ (test-assert "second container running"
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (wait-for-service 'second #:timeout 120)
+ #t)
+ marionette))
+
+ (test-assert "passing host environment variables"
+ (begin
+ (define (run-test)
+ (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 "oci-container")))
+ (setuid (passwd:uid (getpw "oci-container")))
+
+ (let ((response (slurp
+ "/run/current-system/profile/bin/podman"
+ "exec" "first"
+ "/bin/guile" "-c" "'(display (getenv \"VARIABLE\"))'")))
+ (call-with-output-file (string-append ,out-dir "/response")
+ (lambda (port)
+ (display (string-join response "\n") port)))))
+ (lambda ()
+ (primitive-exit 127))))
+ (pid
+ (cdr (waitpid pid))))
+
+ (wait-for-file (string-append ,out-dir "/response"))
+ (slurp "cat" (string-append ,out-dir "/response")))
+ marionette))
+ ;; Allow image to be loaded on slower machines
+ (let loop ((attempts 0))
+ (if (= attempts 180)
+ (error "Service didn't come up after more than 180 seconds")
+ (if (equal? (list "value")
+ (run-test))
+ #t
+ (begin
+ (sleep 1)
+ (loop (+ 1 attempts))))))))
+
+ (test-equal "mounting host files"
+ '("hello")
+ (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 "oci-container")))
+ (setuid (passwd:uid (getpw "oci-container")))
+
+ (let ((response (slurp
+ "/run/current-system/profile/bin/podman"
+ "exec" "second"
+ "/bin/guile" "-c" "'(begin (use-modules (ice-9 popen) (ice-9 rdelim))
+(display (call-with-input-file \"/shared.txt\" read-line)))'")))
+ (call-with-output-file (string-append ,out-dir "/response")
+ (lambda (port)
+ (display (string-join response " ") port)))))
+ (lambda ()
+ (primitive-exit 127))))
+ (pid
+ (cdr (waitpid pid))))
+
+ (wait-for-file (string-append ,out-dir "/response"))
+ (slurp "cat" (string-append ,out-dir "/response")))
+ marionette))
+
+ (test-equal "write to volumes"
+ '("world")
+ (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 "oci-container")))
+ (setuid (passwd:uid (getpw "oci-container")))
+
+ (slurp
+ "/run/current-system/profile/bin/podman"
+ "exec" "first"
+ "/bin/guile" "-c" "'(begin (use-modules (ice-9 popen) (ice-9 rdelim))
+(call-with-output-file \"/my-volume/out.txt\" (lambda (p) (display \"world\" p))))'")
+
+ (let ((response (slurp
+ "/run/current-system/profile/bin/podman"
+ "exec" "second"
+ "/bin/guile" "-c" "'(begin (use-modules (ice-9 popen) (ice-9 rdelim))
+(display (call-with-input-file \"/my-volume/out.txt\" read-line)))'")))
+ (call-with-output-file (string-append ,out-dir "/response")
+ (lambda (port)
+ (display (string-join response " ") port)))))
+ (lambda ()
+ (primitive-exit 127))))
+ (pid
+ (cdr (waitpid pid))))
+
+ (wait-for-file (string-append ,out-dir "/response"))
+ (slurp "cat" (string-append ,out-dir "/response")))
+ marionette))
+
+ (test-equal "can read ports over network"
+ '("out of office")
+ (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 "oci-container")))
+ (setuid (passwd:uid (getpw "oci-container")))
+
+ (let ((response (slurp
+ "/run/current-system/profile/bin/podman"
+ "exec" "second"
+ "/bin/guile" "-c" "'(begin (use-modules (web client))
+(define-values (response out)
+ (http-get \"http://first:8080\"))
+(display out))'")))
+ (call-with-output-file (string-append ,out-dir "/response")
+ (lambda (port)
+ (display (string-join response " ") port)))))
+ (lambda ()
+ (primitive-exit 127))))
+ (pid
+ (cdr (waitpid pid))))
+
+ (wait-for-file (string-append ,out-dir "/response"))
+ (slurp "cat" (string-append ,out-dir "/response")))
+ marionette))
+
+ (test-end))))
+
+ (gexp->derivation "rootless-podman-oci-service-test" test))
+
+(define %test-oci-service-rootless-podman
+ (system-test
+ (name "oci-service-rootless-podman")
+ (description "Test Rootless-Podman backed OCI provisioning service.")
+ (value (run-rootless-podman-oci-service-test))))
+
+(define %oci-docker-os
+ (simple-operating-system
+ (service dhcp-client-service-type)
+ (service dbus-root-service-type)
+ (service polkit-service-type)
+ (service elogind-service-type)
+ (service containerd-service-type)
+ (service docker-service-type)
+ (extra-special-file "/shared.txt"
+ (plain-file "shared.txt" "hello"))
+ (service oci-service-type
+ (oci-configuration
+ (verbose? #t)))
+ (simple-service 'oci-provisioning
+ oci-service-type
+ (oci-extension
+ (networks
+ (list (oci-network-configuration (name "my-network"))))
+ (volumes
+ (list (oci-volume-configuration (name "my-volume"))))
+ (containers
+ (list
+ (oci-container-configuration
+ (provision "first")
+ (image
+ (oci-image
+ (repository "guile")
+ (value
+ (specifications->manifest '("guile")))
+ (pack-options
+ '(#:symlinks (("/bin" -> "bin"))))))
+ (entrypoint "/bin/guile")
+ (network "my-network")
+ (command
+ '("-c" "(use-modules (web server))
+(define (handler request request-body)
+ (values '((content-type . (text/plain))) \"out of office\"))
+(run-server handler 'http `(#:addr ,(inet-pton AF_INET \"0.0.0.0\")))"))
+ (host-environment
+ '(("VARIABLE" . "value")))
+ (volumes
+ '(("my-volume" . "/my-volume")))
+ (extra-arguments
+ '("--env" "VARIABLE")))
+ (oci-container-configuration
+ (provision "second")
+ (image
+ (oci-image
+ (repository "guile")
+ (value
+ (specifications->manifest '("guile")))
+ (pack-options
+ '(#:symlinks (("/bin" -> "bin"))))))
+ (entrypoint "/bin/guile")
+ (network "my-network")
+ (command
+ '("-c" "(let l ((c 300))(display c)(sleep 1)(when(positive? c)(l (- c 1))))"))
+ (volumes
+ '(("my-volume" . "/my-volume")
+ ("/shared.txt" . "/shared.txt:ro"))))))))))
+
+(define (run-docker-oci-service-test)
+ (define os
+ (marionette-operating-system
+ (operating-system-with-gc-roots
+ %oci-docker-os
+ (list))
+ #: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))
+ #~(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))
+
+ (test-runner-current (system-test-runner #$output))
+ (test-begin "docker-oci-service")
+
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (wait-for-service 'dockerd))
+ marionette)
+
+ (test-assert "docker-volumes running"
+ (begin
+ (define (run-test)
+ (marionette-eval
+ `(begin
+ (use-modules (ice-9 popen)
+ (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
+ (list "sh" "-l" "-c"
+ (string-join
+ args
+ " "))))
+ (output (read-lines port))
+ (status (close-pipe port)))
+ output)))
+
+ (stable-sort
+ (slurp
+ "/run/current-system/profile/bin/docker"
+ "volume" "ls" "--format" "\"{{.Name}}\"")
+ string<=?))
+
+ marionette))
+ ;; Allow services to come up on slower machines
+ (let loop ((attempts 0))
+ (if (= attempts 80)
+ (error "Service didn't come up after more than 80 seconds")
+ (if (equal? '("my-volume")
+ (run-test))
+ #t
+ (begin
+ (sleep 1)
+ (loop (+ 1 attempts))))))))
+
+ (test-assert "docker-networks running"
+ (begin
+ (define (run-test)
+ (marionette-eval
+ `(begin
+ (use-modules (ice-9 popen)
+ (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
+ (list "sh" "-l" "-c"
+ (string-join
+ args
+ " "))))
+ (output (read-lines port))
+ (status (close-pipe port)))
+ output)))
+
+ (stable-sort
+ (slurp
+ "/run/current-system/profile/bin/docker"
+ "network" "ls" "--format" "\"{{.Name}}\"")
+ string<=?))
+
+ marionette))
+ ;; Allow services to come up on slower machines
+ (let loop ((attempts 0))
+ (if (= attempts 80)
+ (error "Service didn't come up after more than 80 seconds")
+ (if (equal? '("bridge" "host" "my-network" "none")
+ (run-test))
+ #t
+ (begin
+ (sleep 1)
+ (loop (+ 1 attempts))))))))
+
+ (test-assert "first container running"
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (wait-for-service 'first #:timeout 120)
+ #t)
+ marionette))
+
+ (test-assert "second container running"
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (wait-for-service 'second #:timeout 120)
+ #t)
+ marionette))
+
+ (test-assert "passing host environment variables"
+ (begin
+ (define (run-test)
+ (marionette-eval
+ `(begin
+ (use-modules (ice-9 popen)
+ (ice-9 rdelim))
+
+ (define slurp
+ (lambda args
+ (let* ((port (apply open-pipe* OPEN_READ args))
+ (output (let ((line (read-line port)))
+ (if (eof-object? line)
+ ""
+ line)))
+ (status (close-pipe port)))
+ output)))
+
+ (slurp
+ "/run/current-system/profile/bin/docker"
+ "exec" "first"
+ "/bin/guile" "-c" "(display (getenv \"VARIABLE\"))"))
+ marionette))
+ ;; Allow image to be loaded on slower machines
+ (let loop ((attempts 0))
+ (if (= attempts 180)
+ (error "Service didn't come up after more than 180 seconds")
+ (if (equal? "value"
+ (run-test))
+ #t
+ (begin
+ (sleep 1)
+ (loop (+ 1 attempts))))))))
+
+ (test-equal "mounting host files"
+ "hello"
+ (marionette-eval
+ `(begin
+ (use-modules (ice-9 popen)
+ (ice-9 rdelim))
+
+ (define slurp
+ (lambda args
+ (let* ((port (apply open-pipe* OPEN_READ args))
+ (output (let ((line (read-line port)))
+ (if (eof-object? line)
+ ""
+ line)))
+ (status (close-pipe port)))
+ output)))
+
+ (slurp
+ "/run/current-system/profile/bin/docker"
+ "exec" "second"
+ "/bin/guile" "-c" "(begin (use-modules (ice-9 popen) (ice-9 rdelim))
+(display (call-with-input-file \"/shared.txt\" read-line)))"))
+ marionette))
+
+ (test-equal "write to volumes"
+ "world"
+ (marionette-eval
+ `(begin
+ (use-modules (ice-9 popen)
+ (ice-9 rdelim))
+
+ (define slurp
+ (lambda args
+ (let* ((port (apply open-pipe* OPEN_READ args))
+ (output (let ((line (read-line port)))
+ (if (eof-object? line)
+ ""
+ line)))
+ (status (close-pipe port)))
+ output)))
+
+ (slurp
+ "/run/current-system/profile/bin/docker"
+ "exec" "first"
+ "/bin/guile" "-c" "(begin (use-modules (ice-9 popen) (ice-9 rdelim))
+(call-with-output-file \"/my-volume/out.txt\" (lambda (p) (display \"world\" p))))")
+ (slurp
+ "/run/current-system/profile/bin/docker"
+ "exec" "second"
+ "/bin/guile" "-c" "(begin (use-modules (ice-9 popen) (ice-9 rdelim))
+(display (call-with-input-file \"/my-volume/out.txt\" read-line)))"))
+ marionette))
+
+ (test-equal "can read ports over network"
+ "out of office"
+ (marionette-eval
+ `(begin
+ (use-modules (ice-9 popen)
+ (ice-9 rdelim))
+
+ (define slurp
+ (lambda args
+ (let* ((port (apply open-pipe* OPEN_READ args))
+ (output (let ((line (read-line port)))
+ (if (eof-object? line)
+ ""
+ line)))
+ (status (close-pipe port)))
+ output)))
+
+ (slurp
+ "/run/current-system/profile/bin/docker"
+ "exec" "second"
+ "/bin/guile" "-c" "(begin (use-modules (web client))
+(define-values (response out)
+ (http-get \"http://first:8080\"))
+(display out))"))
+ marionette))
+
+ (test-end))))
+
+ (gexp->derivation "docker-oci-service-test" test))
+
+(define %test-oci-service-docker
+ (system-test
+ (name "oci-service-docker")
+ (description "Test Docker backed OCI provisioning service.")
+ (value (run-docker-oci-service-test))))
--
2.48.1
guix-patches <at> gnu.org:bug#76081; Package guix-patches.
(Sun, 09 Feb 2025 19:16:02 GMT) Full text and rfc822 format available.Message #29 received at 76081 <at> debbugs.gnu.org (full text, mbox):
From: Giacomo Leidi <goodoldpaul <at> autistici.org> To: 76081 <at> debbugs.gnu.org Cc: Giacomo Leidi <goodoldpaul <at> autistici.org> Subject: [PATCH v2 4/4] tests: Use lower-oci-image-state in container tests. Date: Sun, 9 Feb 2025 20:15:04 +0100
This patch replaces boilerplate in container related tests with
oci-image plumbing from (gnu services containers).
* gnu/services/containers.scm: Export lower-oci-image-state.
* gnu/tests/containers.scm (%oci-tarball): New variable;
(run-rootless-podman-test): use %oci-tarball;
(build-tarball&run-rootless-podman-test): drop procedure.
* gnu/tests/docker.scm (%docker-tarball): New variable;
(build-tarball&run-docker-test): use %docker-tarball;
(%docker-system-tarball): New variable;
(build-tarball&run-docker-system-test): new procedure.
Change-Id: Iad6f0704aee188d89464c83722dea0bb7adb084a
---
gnu/services/containers.scm | 35 ++++++++-----
gnu/tests/containers.scm | 80 ++++++++++++++---------------
gnu/tests/docker.scm | 100 ++++++++++++++++++++----------------
3 files changed, 114 insertions(+), 101 deletions(-)
diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm
index 5c50c99eaf6..2808afe7f08 100644
--- a/gnu/services/containers.scm
+++ b/gnu/services/containers.scm
@@ -74,6 +74,8 @@ (define-module (gnu services containers)
oci-image-system
oci-image-grafts?
+ lower-oci-image-state
+
oci-container-configuration
oci-container-configuration?
oci-container-configuration-fields
@@ -996,12 +998,9 @@ (define (lower-operating-system os target system)
#:target target)))
(return tarball)))
-(define (lower-manifest name image target system)
- "Lower IMAGE, a manifest record, into a tarball containing an OCI image."
- (define value (oci-image-value image))
- (define options (oci-image-pack-options image))
- (define image-reference
- (oci-image-reference image))
+(define (lower-manifest name value options image-reference
+ target system grafts?)
+ "Lower VALUE, a manifest record, into a tarball containing an OCI image."
(define image-tag
(let* ((extra-options
(get-keyword-value options #:extra-options))
@@ -1013,8 +1012,7 @@ (define (lower-manifest name image target system)
`(#:extra-options (#:image-tag ,image-reference)))))
(mlet* %store-monad
- ((_ (set-grafting
- (oci-image-grafts? image)))
+ ((_ (set-grafting grafts?))
(guile (set-guile-for-build (default-guile)))
(profile
(profile-derivation value
@@ -1029,11 +1027,8 @@ (define (lower-manifest name image target system)
#:localstatedir? #t))))
(return tarball)))
-(define (lower-oci-image name image)
- "Lower IMAGE, a oci-image record, into a tarball containing an OCI image."
- (define value (oci-image-value image))
- (define image-target (oci-image-target image))
- (define image-system (oci-image-system image))
+(define (lower-oci-image-state name value options reference
+ image-target image-system grafts?)
(define target
(if (maybe-value-set? image-target)
image-target
@@ -1046,7 +1041,8 @@ (define (lower-oci-image name image)
(run-with-store store
(match value
((? manifest? value)
- (lower-manifest name image target system))
+ (lower-manifest name value options reference
+ target system grafts?))
((? operating-system? value)
(lower-operating-system value target system))
((or (? gexp? value)
@@ -1061,6 +1057,17 @@ (define (lower-oci-image name image)
#:target target
#:system system)))
+(define (lower-oci-image name image)
+ "Lower IMAGE, a oci-image record, into a tarball containing an OCI image."
+ (lower-oci-image-state
+ name
+ (oci-image-value image)
+ (oci-image-pack-options image)
+ (oci-image-reference image)
+ (oci-image-target image)
+ (oci-image-system image)
+ (oci-image-grafts? image)))
+
(define* (oci-image-loader runtime-cli name image tag #:key (verbose? #f))
"Return a file-like object that, once lowered, will evaluate to a program able
to load IMAGE through RUNTIME-CLI and to tag it with TAG afterwards."
diff --git a/gnu/tests/containers.scm b/gnu/tests/containers.scm
index bac1f47bd34..1fcf6be7ace 100644
--- a/gnu/tests/containers.scm
+++ b/gnu/tests/containers.scm
@@ -69,13 +69,47 @@ (define %rootless-podman-os
(supplementary-groups '("wheel" "netdev" "cgroup"
"audio" "video")))))))
-(define (run-rootless-podman-test oci-tarball)
+(define %oci-tarball
+ (lower-oci-image-state
+ "guile-guest"
+ (packages->manifest
+ (list
+ guile-3.0 guile-json-3
+ (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))))
+ '(#:entry-point "bin/guile"
+ #:localstatedir? #t
+ #:extra-options (#:image-tag "guile-guest")
+ #:symlinks (("/bin/Guile" -> "bin/guile")
+ ("aa.scm" -> "a.scm")))
+ "guile-guest"
+ (%current-target-system)
+ (%current-system)
+ #f))
+
+(define (run-rootless-podman-test)
(define os
(marionette-operating-system
(operating-system-with-gc-roots
%rootless-podman-os
- (list oci-tarball))
+ (list %oci-tarball))
#:imported-modules '((gnu services herd)
(guix combinators))))
@@ -254,7 +288,7 @@ (define (run-rootless-podman-test oci-tarball)
(let* ((loaded (slurp ,(string-append #$podman
"/bin/podman")
"load" "-i"
- ,#$oci-tarball))
+ ,#$%oci-tarball))
(repository&tag "localhost/guile-guest:latest")
(response1 (slurp
,(string-append #$podman "/bin/podman")
@@ -307,49 +341,11 @@ (define (run-rootless-podman-test oci-tarball)
(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))))
+ (value (run-rootless-podman-test))))
(define %oci-rootless-podman-os
diff --git a/gnu/tests/docker.scm b/gnu/tests/docker.scm
index 5dcf05a17e3..07edd9d5341 100644
--- a/gnu/tests/docker.scm
+++ b/gnu/tests/docker.scm
@@ -26,6 +26,7 @@ (define-module (gnu tests docker)
#:use-module (gnu system image)
#:use-module (gnu system vm)
#:use-module (gnu services)
+ #:use-module (gnu services containers)
#:use-module (gnu services dbus)
#:use-module (gnu services networking)
#:use-module (gnu services docker)
@@ -57,6 +58,40 @@ (define %docker-os
(service containerd-service-type)
(service docker-service-type)))
+(define %docker-tarball
+ (lower-oci-image-state
+ "guile-guest"
+ (packages->manifest
+ (list
+ guile-3.0 guile-json-3
+ (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))))
+ '(#:entry-point "bin/guile"
+ #:localstatedir? #t
+ #:extra-options (#:image-tag "guile-guest")
+ #:symlinks (("/bin/Guile" -> "bin/guile")
+ ("aa.scm" -> "a.scm")))
+ "guile-guest"
+ (%current-target-system)
+ (%current-system)
+ #f))
+
(define (run-docker-test docker-tarball)
"Load DOCKER-TARBALL as Docker image and run it in a Docker container,
inside %DOCKER-OS."
@@ -173,40 +208,7 @@ (define (run-docker-test docker-tarball)
(gexp->derivation "docker-test" test))
(define (build-tarball&run-docker-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"))
- #:entry-point "bin/guile"
- #:localstatedir? #t)))
- (run-docker-test tarball)))
+ (run-docker-test %docker-tarball))
(define %test-docker
(system-test
@@ -215,8 +217,22 @@ (define %test-docker
(value (build-tarball&run-docker-test))))
+(define %docker-system-tarball
+ (lower-oci-image-state
+ "guix-system-guest"
+ (operating-system
+ (inherit (simple-operating-system))
+ ;; Use locales for a single libc to
+ ;; reduce space requirements.
+ (locale-libcs (list glibc)))
+ '()
+ "guix-system-guest"
+ (%current-target-system)
+ (%current-system)
+ #f))
+
(define (run-docker-system-test tarball)
- "Load DOCKER-TARBALL as Docker image and run it in a Docker container,
+ "Load TARBALL as Docker image and run it in a Docker container,
inside %DOCKER-OS."
(define os
(marionette-operating-system
@@ -333,21 +349,15 @@ (define (run-docker-system-test tarball)
(gexp->derivation "docker-system-test" test))
+(define (build-tarball&run-docker-system-test)
+ (run-docker-system-test %docker-system-tarball))
+
(define %test-docker-system
(system-test
(name "docker-system")
(description "Run a system image as produced by @command{guix system
docker-image} inside Docker.")
- (value (with-monad %store-monad
- (>>= (lower-object
- (system-image (os->image
- (operating-system
- (inherit (simple-operating-system))
- ;; Use locales for a single libc to
- ;; reduce space requirements.
- (locale-libcs (list glibc)))
- #:type docker-image-type)))
- run-docker-system-test)))))
+ (value (build-tarball&run-docker-system-test))))
(define %oci-os
--
2.48.1
guix-patches <at> gnu.org:bug#76081; Package guix-patches.
(Sun, 09 Feb 2025 19:16:03 GMT) Full text and rfc822 format available.Message #32 received at 76081 <at> debbugs.gnu.org (full text, mbox):
From: Giacomo Leidi <goodoldpaul <at> autistici.org> To: 76081 <at> debbugs.gnu.org Cc: Giacomo Leidi <goodoldpaul <at> autistici.org> Subject: [PATCH v2 2/4] services: oci-container-configuration: Move to (gnu services containers). Date: Sun, 9 Feb 2025 20:15:02 +0100
This patch moves the oci-container-configuration and related
configuration records to (gnu services containers).
Public symbols are still exported for backwards
compatibility but since the oci-container-service-type will be
deprecated in favor of the more general oci-service-type, everything is
moved outside of the docker related module.
* gnu/services/docker.scm: Move everything related to oci-container-configuration
to...
* gnu/services/containers.scm: ...here.scm.
* gnu/tests/docker.scm: Simplify %test-oci-container test case.
Change-Id: Iae599dd5cc7442eb632f0c1b3b12f6b928397ae7
---
gnu/services/containers.scm | 549 +++++++++++++++++++++++++++++++++-
gnu/services/docker.scm | 577 +++---------------------------------
gnu/tests/docker.scm | 99 +++----
3 files changed, 625 insertions(+), 600 deletions(-)
diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm
index dc66ac4f967..50bf6c05549 100644
--- a/gnu/services/containers.scm
+++ b/gnu/services/containers.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2024 Giacomo Leidi <goodoldpaul <at> autistici.org>
+;;; Copyright © 2024, 2025 Giacomo Leidi <goodoldpaul <at> autistici.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -17,19 +17,31 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu services containers)
+ #:use-module (gnu image)
+ #:use-module (gnu packages admin)
#:use-module (gnu packages bash)
#:use-module (gnu packages containers)
+ #:use-module (gnu packages docker)
#: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)
#:use-module (gnu system accounts)
+ #:use-module (gnu system image)
#:use-module (gnu system shadow)
#:use-module (gnu system pam)
+ #:use-module (guix diagnostics)
#:use-module (guix gexp)
+ #:use-module (guix i18n)
+ #:use-module (guix monads)
#:use-module (guix packages)
+ #:use-module (guix profiles)
+ #:use-module ((guix scripts pack) #:prefix pack:)
+ #:use-module (guix store)
#:use-module (srfi srfi-1)
+ #:use-module (ice-9 match)
#:export (rootless-podman-configuration
rootless-podman-configuration?
rootless-podman-configuration-fields
@@ -48,7 +60,44 @@ (define-module (gnu services containers)
rootless-podman-shepherd-services
rootless-podman-service-etc
- rootless-podman-service-type))
+ rootless-podman-service-type
+
+ oci-image
+ oci-image?
+ oci-image-fields
+ oci-image-repository
+ oci-image-tag
+ oci-image-value
+ oci-image-pack-options
+ oci-image-target
+ oci-image-system
+ oci-image-grafts?
+
+ oci-container-configuration
+ oci-container-configuration?
+ oci-container-configuration-fields
+ oci-container-configuration-user
+ oci-container-configuration-group
+ oci-container-configuration-command
+ oci-container-configuration-entrypoint
+ oci-container-configuration-host-environment
+ oci-container-configuration-environment
+ oci-container-configuration-image
+ oci-container-configuration-provision
+ oci-container-configuration-requirement
+ oci-container-configuration-log-file
+ oci-container-configuration-auto-start?
+ oci-container-configuration-respawn?
+ oci-container-configuration-shepherd-actions
+ oci-container-configuration-network
+ oci-container-configuration-ports
+ oci-container-configuration-volumes
+ oci-container-configuration-container-user
+ oci-container-configuration-workdir
+ oci-container-configuration-extra-arguments
+
+ oci-container-shepherd-service
+ %oci-container-accounts))
(define (gexp-or-string? value)
(or (gexp? value)
@@ -188,7 +237,7 @@ (define (rootless-podman-cgroups-limits-service config)
rootless-podman-shared-root-fs))
(one-shot? #t)
(documentation
- "Allow setting cgroups limits: cpu, cpuset, memory and
+ "Allow setting cgroups limits: cpu, cpuset, io, memory and
pids.")
(start
#~(make-forkexec-constructor
@@ -242,3 +291,497 @@ (define rootless-podman-service-type
(default-value (rootless-podman-configuration))
(description
"This service configures rootless @code{podman} on the Guix System.")))
+
+
+;;;
+;;; OCI container.
+;;;
+
+(define (oci-sanitize-pair pair delimiter)
+ (define (valid? member)
+ (or (string? member)
+ (gexp? member)
+ (file-like? member)))
+ (match pair
+ (((? valid? key) . (? valid? value))
+ #~(string-append #$key #$delimiter #$value))
+ (_
+ (raise
+ (formatted-message
+ (G_ "pair members must contain only strings, gexps or file-like objects
+but ~a was found")
+ pair)))))
+
+(define (oci-sanitize-mixed-list name value delimiter)
+ (map
+ (lambda (el)
+ (cond ((string? el) el)
+ ((pair? el) (oci-sanitize-pair el delimiter))
+ (else
+ (raise
+ (formatted-message
+ (G_ "~a members must be either a string or a pair but ~a was
+found!")
+ name el)))))
+ value))
+
+(define (oci-sanitize-host-environment value)
+ ;; Expected spec format:
+ ;; '(("HOME" . "/home/nobody") "JAVA_HOME=/java")
+ (oci-sanitize-mixed-list "host-environment" value "="))
+
+(define (oci-sanitize-environment value)
+ ;; Expected spec format:
+ ;; '(("HOME" . "/home/nobody") "JAVA_HOME=/java")
+ (oci-sanitize-mixed-list "environment" value "="))
+
+(define (oci-sanitize-ports value)
+ ;; Expected spec format:
+ ;; '(("8088" . "80") "2022:22")
+ (oci-sanitize-mixed-list "ports" value ":"))
+
+(define (oci-sanitize-volumes value)
+ ;; Expected spec format:
+ ;; '(("/mnt/dir" . "/dir") "/run/current-system/profile:/java")
+ (oci-sanitize-mixed-list "volumes" value ":"))
+
+(define (oci-sanitize-shepherd-actions value)
+ (map
+ (lambda (el)
+ (if (shepherd-action? el)
+ el
+ (raise
+ (formatted-message
+ (G_ "shepherd-actions may only be shepherd-action records
+but ~a was found") el))))
+ value))
+
+(define (oci-sanitize-extra-arguments value)
+ (define (valid? member)
+ (or (string? member)
+ (gexp? member)
+ (file-like? member)))
+ (map
+ (lambda (el)
+ (if (valid? el)
+ el
+ (raise
+ (formatted-message
+ (G_ "extra arguments may only be strings, gexps or file-like objects
+but ~a was found") el))))
+ value))
+
+(define (oci-image-reference image)
+ (if (string? image)
+ image
+ (string-append (oci-image-repository image)
+ ":" (oci-image-tag image))))
+
+(define (oci-lowerable-image? image)
+ (or (manifest? image)
+ (operating-system? image)
+ (gexp? image)
+ (file-like? image)))
+
+(define (string-or-oci-image? image)
+ (or (string? image)
+ (oci-image? image)))
+
+(define list-of-symbols?
+ (list-of symbol?))
+
+(define-maybe/no-serialization string)
+
+(define-configuration/no-serialization oci-image
+ (repository
+ (string)
+ "A string like @code{myregistry.local:5000/testing/test-image} that names
+the OCI image.")
+ (tag
+ (string "latest")
+ "A string representing the OCI image tag. Defaults to @code{latest}.")
+ (value
+ (oci-lowerable-image)
+ "A @code{manifest} or @code{operating-system} record that will be lowered
+into an OCI compatible tarball. Otherwise this field's value can be a gexp
+or a file-like object that evaluates to an OCI compatible tarball.")
+ (pack-options
+ (list '())
+ "An optional set of keyword arguments that will be passed to the
+@code{docker-image} procedure from @code{guix scripts pack}. They can be used
+to replicate @command{guix pack} behavior:
+
+@lisp
+(oci-image
+ (repository \"guile\")
+ (tag \"3\")
+ (manifest (specifications->manifest '(\"guile\")))
+ (pack-options
+ '(#:symlinks ((\"/bin/guile\" -> \"bin/guile\"))
+ #:max-layers 2)))
+@end lisp
+
+If the @code{value} field is an @code{operating-system} record, this field's
+value will be ignored.")
+ (system
+ (maybe-string)
+ "Attempt to build for a given system, e.g. \"i686-linux\"")
+ (target
+ (maybe-string)
+ "Attempt to cross-build for a given triple, e.g. \"aarch64-linux-gnu\"")
+ (grafts?
+ (boolean #f)
+ "Whether to allow grafting or not in the pack build."))
+
+(define-configuration/no-serialization oci-container-configuration
+ (user
+ (string "oci-container")
+ "The user under whose authority docker commands will be run.")
+ (group
+ (string "docker")
+ "The group under whose authority docker commands will be run.")
+ (command
+ (list-of-strings '())
+ "Overwrite the default command (@code{CMD}) of the image.")
+ (entrypoint
+ (maybe-string)
+ "Overwrite the default entrypoint (@code{ENTRYPOINT}) of the image.")
+ (host-environment
+ (list '())
+ "Set environment variables in the host environment where @command{docker run}
+is invoked. This is especially useful to pass secrets from the host to the
+container without having them on the @command{docker run}'s command line: by
+setting the @code{MYSQL_PASSWORD} on the host and by passing
+@code{--env MYSQL_PASSWORD} through the @code{extra-arguments} field, it is
+possible to securely set values in the container environment. This field's
+value can be a list of pairs or strings, even mixed:
+
+@lisp
+(list '(\"LANGUAGE\" . \"eo:ca:eu\")
+ \"JAVA_HOME=/opt/java\")
+@end lisp
+
+Pair members can be strings, gexps or file-like objects. Strings are passed
+directly to @code{make-forkexec-constructor}."
+ (sanitizer oci-sanitize-host-environment))
+ (environment
+ (list '())
+ "Set environment variables inside the container. This can be a list of pairs
+or strings, even mixed:
+
+@lisp
+(list '(\"LANGUAGE\" . \"eo:ca:eu\")
+ \"JAVA_HOME=/opt/java\")
+@end lisp
+
+Pair members can be strings, gexps or file-like objects. Strings are passed
+directly to the Docker CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#env,upstream}
+documentation for semantics."
+ (sanitizer oci-sanitize-environment))
+ (image
+ (string-or-oci-image)
+ "The image used to build the container. It can be a string or an
+@code{oci-image} record. Strings are resolved by the Docker
+Engine, and follow the usual format
+@code{myregistry.local:5000/testing/test-image:tag}.")
+ (provision
+ (maybe-string)
+ "Set the name of the provisioned Shepherd service.")
+ (requirement
+ (list-of-symbols '())
+ "Set additional Shepherd services dependencies to the provisioned Shepherd
+service.")
+ (log-file
+ (maybe-string)
+ "When @code{log-file} is set, it names the file to which the service’s
+standard output and standard error are redirected. @code{log-file} is created
+if it does not exist, otherwise it is appended to.")
+ (auto-start?
+ (boolean #t)
+ "Whether this service should be started automatically by the Shepherd. If it
+is @code{#f} the service has to be started manually with @command{herd start}.")
+ (respawn?
+ (boolean #f)
+ "Whether to restart the service when it stops, for instance when the
+underlying process dies.")
+ (shepherd-actions
+ (list '())
+ "This is a list of @code{shepherd-action} records defining actions supported
+by the service."
+ (sanitizer oci-sanitize-shepherd-actions))
+ (network
+ (maybe-string)
+ "Set a Docker network for the spawned container.")
+ (ports
+ (list '())
+ "Set the port or port ranges to expose from the spawned container. This can
+be a list of pairs or strings, even mixed:
+
+@lisp
+(list '(\"8080\" . \"80\")
+ \"10443:443\")
+@end lisp
+
+Pair members can be strings, gexps or file-like objects. Strings are passed
+directly to the Docker CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#publish,upstream}
+documentation for semantics."
+ (sanitizer oci-sanitize-ports))
+ (volumes
+ (list '())
+ "Set volume mappings for the spawned container. This can be a
+list of pairs or strings, even mixed:
+
+@lisp
+(list '(\"/root/data/grafana\" . \"/var/lib/grafana\")
+ \"/gnu/store:/gnu/store\")
+@end lisp
+
+Pair members can be strings, gexps or file-like objects. Strings are passed
+directly to the Docker CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#volume,upstream}
+documentation for semantics."
+ (sanitizer oci-sanitize-volumes))
+ (container-user
+ (maybe-string)
+ "Set the current user inside the spawned container. You can refer to the
+@url{https://docs.docker.com/engine/reference/run/#user,upstream}
+documentation for semantics.")
+ (workdir
+ (maybe-string)
+ "Set the current working for the spawned Shepherd service.
+You can refer to the
+@url{https://docs.docker.com/engine/reference/run/#workdir,upstream}
+documentation for semantics.")
+ (extra-arguments
+ (list '())
+ "A list of strings, gexps or file-like objects that will be directly passed
+to the @command{docker run} invokation."
+ (sanitizer oci-sanitize-extra-arguments)))
+
+(define oci-container-configuration->options
+ (lambda (config)
+ (let ((entrypoint
+ (oci-container-configuration-entrypoint config))
+ (network
+ (oci-container-configuration-network config))
+ (user
+ (oci-container-configuration-container-user config))
+ (workdir
+ (oci-container-configuration-workdir config)))
+ (apply append
+ (filter (compose not unspecified?)
+ `(,(if (maybe-value-set? entrypoint)
+ `("--entrypoint" ,entrypoint)
+ '())
+ ,(append-map
+ (lambda (spec)
+ (list "--env" spec))
+ (oci-container-configuration-environment config))
+ ,(if (maybe-value-set? network)
+ `("--network" ,network)
+ '())
+ ,(if (maybe-value-set? user)
+ `("--user" ,user)
+ '())
+ ,(if (maybe-value-set? workdir)
+ `("--workdir" ,workdir)
+ '())
+ ,(append-map
+ (lambda (spec)
+ (list "-p" spec))
+ (oci-container-configuration-ports config))
+ ,(append-map
+ (lambda (spec)
+ (list "-v" spec))
+ (oci-container-configuration-volumes config))))))))
+
+(define* (get-keyword-value args keyword #:key (default #f))
+ (let ((kv (memq keyword args)))
+ (if (and kv (>= (length kv) 2))
+ (cadr kv)
+ default)))
+
+(define (lower-operating-system os target system)
+ (mlet* %store-monad
+ ((tarball
+ (lower-object
+ (system-image (os->image os #:type docker-image-type))
+ system
+ #:target target)))
+ (return tarball)))
+
+(define (lower-manifest name image target system)
+ (define value (oci-image-value image))
+ (define options (oci-image-pack-options image))
+ (define image-reference
+ (oci-image-reference image))
+ (define image-tag
+ (let* ((extra-options
+ (get-keyword-value options #:extra-options))
+ (image-tag-option
+ (and extra-options
+ (get-keyword-value extra-options #:image-tag))))
+ (if image-tag-option
+ '()
+ `(#:extra-options (#:image-tag ,image-reference)))))
+
+ (mlet* %store-monad
+ ((_ (set-grafting
+ (oci-image-grafts? image)))
+ (guile (set-guile-for-build (default-guile)))
+ (profile
+ (profile-derivation value
+ #:target target
+ #:system system
+ #:hooks '()
+ #:locales? #f))
+ (tarball (apply pack:docker-image
+ `(,name ,profile
+ ,@options
+ ,@image-tag
+ #:localstatedir? #t))))
+ (return tarball)))
+
+(define (lower-oci-image name image)
+ (define value (oci-image-value image))
+ (define image-target (oci-image-target image))
+ (define image-system (oci-image-system image))
+ (define target
+ (if (maybe-value-set? image-target)
+ image-target
+ (%current-target-system)))
+ (define system
+ (if (maybe-value-set? image-system)
+ image-system
+ (%current-system)))
+ (with-store store
+ (run-with-store store
+ (match value
+ ((? manifest? value)
+ (lower-manifest name image target system))
+ ((? operating-system? value)
+ (lower-operating-system value target system))
+ ((or (? gexp? value)
+ (? file-like? value))
+ value)
+ (_
+ (raise
+ (formatted-message
+ (G_ "oci-image value must contain only manifest,
+operating-system, gexp or file-like records but ~a was found")
+ value))))
+ #:target target
+ #:system system)))
+
+(define (%oci-image-loader name image tag)
+ (let ((docker (file-append docker-cli "/bin/docker"))
+ (tarball (lower-oci-image name image)))
+ (with-imported-modules '((guix build utils))
+ (program-file (format #f "~a-image-loader" name)
+ #~(begin
+ (use-modules (guix build utils)
+ (ice-9 popen)
+ (ice-9 rdelim))
+
+ (format #t "Loading image for ~a from ~a...~%" #$name #$tarball)
+ (define line
+ (read-line
+ (open-input-pipe
+ (string-append #$docker " load -i " #$tarball))))
+
+ (unless (or (eof-object? line)
+ (string-null? line))
+ (format #t "~a~%" line)
+ (let ((repository&tag
+ (string-drop line
+ (string-length
+ "Loaded image: "))))
+
+ (invoke #$docker "tag" repository&tag #$tag)
+ (format #t "Tagged ~a with ~a...~%" #$tarball #$tag))))))))
+
+(define (oci-container-shepherd-service config)
+ (define (guess-name name image)
+ (if (maybe-value-set? name)
+ name
+ (string-append "docker-"
+ (basename
+ (if (string? image)
+ (first (string-split image #\:))
+ (oci-image-repository image))))))
+
+ (let* ((docker (file-append docker-cli "/bin/docker"))
+ (actions (oci-container-configuration-shepherd-actions config))
+ (auto-start?
+ (oci-container-configuration-auto-start? config))
+ (user (oci-container-configuration-user config))
+ (group (oci-container-configuration-group config))
+ (host-environment
+ (oci-container-configuration-host-environment config))
+ (command (oci-container-configuration-command config))
+ (log-file (oci-container-configuration-log-file config))
+ (provision (oci-container-configuration-provision config))
+ (requirement (oci-container-configuration-requirement config))
+ (respawn?
+ (oci-container-configuration-respawn? config))
+ (image (oci-container-configuration-image config))
+ (image-reference (oci-image-reference image))
+ (options (oci-container-configuration->options config))
+ (name (guess-name provision image))
+ (extra-arguments
+ (oci-container-configuration-extra-arguments config)))
+
+ (shepherd-service (provision `(,(string->symbol name)))
+ (requirement `(dockerd user-processes ,@requirement))
+ (respawn? respawn?)
+ (auto-start? auto-start?)
+ (documentation
+ (string-append
+ "Docker backed Shepherd service for "
+ (if (oci-image? image) name image) "."))
+ (start
+ #~(lambda ()
+ #$@(if (oci-image? image)
+ #~((invoke #$(%oci-image-loader
+ name image image-reference)))
+ #~())
+ (fork+exec-command
+ ;; docker run [OPTIONS] IMAGE [COMMAND] [ARG...]
+ (list #$docker "run" "--rm" "--name" #$name
+ #$@options #$@extra-arguments
+ #$image-reference #$@command)
+ #:user #$user
+ #:group #$group
+ #$@(if (maybe-value-set? log-file)
+ (list #:log-file log-file)
+ '())
+ #:environment-variables
+ (list #$@host-environment))))
+ (stop
+ #~(lambda _
+ (invoke #$docker "rm" "-f" #$name)))
+ (actions
+ (if (oci-image? image)
+ '()
+ (append
+ (list
+ (shepherd-action
+ (name 'pull)
+ (documentation
+ (format #f "Pull ~a's image (~a)."
+ name image))
+ (procedure
+ #~(lambda _
+ (invoke #$docker "pull" #$image)))))
+ actions))))))
+
+(define %oci-container-accounts
+ (list (user-account
+ (name "oci-container")
+ (comment "OCI services account")
+ (group "docker")
+ (system? #t)
+ (home-directory "/var/empty")
+ (shell (file-append shadow "/sbin/nologin")))))
diff --git a/gnu/services/docker.scm b/gnu/services/docker.scm
index 3af0f792701..69ff9f1d9e4 100644
--- a/gnu/services/docker.scm
+++ b/gnu/services/docker.scm
@@ -5,7 +5,7 @@
;;; Copyright © 2020 Efraim Flashner <efraim <at> flashner.co.il>
;;; Copyright © 2020 Jesse Dowell <jessedowell <at> gmail.com>
;;; Copyright © 2021 Brice Waegeneire <brice <at> waegenei.re>
-;;; Copyright © 2023, 2024 Giacomo Leidi <goodoldpaul <at> autistici.org>
+;;; Copyright © 2023, 2024, 2025 Giacomo Leidi <goodoldpaul <at> autistici.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -23,72 +23,60 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu services docker)
- #:use-module (gnu image)
#:use-module (gnu services)
#:use-module (gnu services configuration)
- #:use-module (gnu services base)
- #:use-module (gnu services dbus)
+ #:use-module (gnu services containers)
#:use-module (gnu services shepherd)
- #:use-module (gnu system)
- #:use-module (gnu system image)
#:use-module (gnu system privilege)
#:use-module (gnu system shadow)
- #:use-module (gnu packages admin) ;shadow
#:use-module (gnu packages docker)
#:use-module (gnu packages linux) ;singularity
- #:use-module (guix records)
- #:use-module (guix diagnostics)
#:use-module (guix gexp)
- #:use-module (guix i18n)
- #:use-module (guix monads)
- #:use-module (guix packages)
- #:use-module (guix profiles)
- #:use-module ((guix scripts pack) #:prefix pack:)
- #:use-module (guix store)
+ #:use-module (guix records)
#:use-module (srfi srfi-1)
#:use-module (ice-9 format)
#:use-module (ice-9 match)
+ #:re-export (oci-image ;for backwards compatibility, until the
+ oci-image? ;oci-container-service-type is fully deprecated
+ oci-image-fields
+ oci-image-repository
+ oci-image-tag
+ oci-image-value
+ oci-image-pack-options
+ oci-image-target
+ oci-image-system
+ oci-image-grafts?
+ oci-container-configuration
+ oci-container-configuration?
+ oci-container-configuration-fields
+ oci-container-configuration-user
+ oci-container-configuration-group
+ oci-container-configuration-command
+ oci-container-configuration-entrypoint
+ oci-container-configuration-host-environment
+ oci-container-configuration-environment
+ oci-container-configuration-image
+ oci-container-configuration-provision
+ oci-container-configuration-requirement
+ oci-container-configuration-log-file
+ oci-container-configuration-auto-start?
+ oci-container-configuration-respawn?
+ oci-container-configuration-shepherd-actions
+ oci-container-configuration-network
+ oci-container-configuration-ports
+ oci-container-configuration-volumes
+ oci-container-configuration-container-user
+ oci-container-configuration-workdir
+ oci-container-configuration-extra-arguments
+ oci-container-shepherd-service
+ %oci-container-accounts)
#:export (containerd-configuration
containerd-service-type
docker-configuration
docker-service-type
singularity-service-type
- oci-image
- oci-image?
- oci-image-fields
- oci-image-repository
- oci-image-tag
- oci-image-value
- oci-image-pack-options
- oci-image-target
- oci-image-system
- oci-image-grafts?
- oci-container-configuration
- oci-container-configuration?
- oci-container-configuration-fields
- oci-container-configuration-user
- oci-container-configuration-group
- oci-container-configuration-command
- oci-container-configuration-entrypoint
- oci-container-configuration-host-environment
- oci-container-configuration-environment
- oci-container-configuration-image
- oci-container-configuration-provision
- oci-container-configuration-requirement
- oci-container-configuration-log-file
- oci-container-configuration-auto-start?
- oci-container-configuration-respawn?
- oci-container-configuration-shepherd-actions
- oci-container-configuration-network
- oci-container-configuration-ports
- oci-container-configuration-volumes
- oci-container-configuration-container-user
- oci-container-configuration-workdir
- oci-container-configuration-extra-arguments
- oci-container-service-type
- oci-container-shepherd-service
- %oci-container-accounts))
+ oci-container-service-type))
(define-maybe file-like)
@@ -307,495 +295,6 @@ (define singularity-service-type
;;; OCI container.
;;;
-(define (oci-sanitize-pair pair delimiter)
- (define (valid? member)
- (or (string? member)
- (gexp? member)
- (file-like? member)))
- (match pair
- (((? valid? key) . (? valid? value))
- #~(string-append #$key #$delimiter #$value))
- (_
- (raise
- (formatted-message
- (G_ "pair members must contain only strings, gexps or file-like objects
-but ~a was found")
- pair)))))
-
-(define (oci-sanitize-mixed-list name value delimiter)
- (map
- (lambda (el)
- (cond ((string? el) el)
- ((pair? el) (oci-sanitize-pair el delimiter))
- (else
- (raise
- (formatted-message
- (G_ "~a members must be either a string or a pair but ~a was
-found!")
- name el)))))
- value))
-
-(define (oci-sanitize-host-environment value)
- ;; Expected spec format:
- ;; '(("HOME" . "/home/nobody") "JAVA_HOME=/java")
- (oci-sanitize-mixed-list "host-environment" value "="))
-
-(define (oci-sanitize-environment value)
- ;; Expected spec format:
- ;; '(("HOME" . "/home/nobody") "JAVA_HOME=/java")
- (oci-sanitize-mixed-list "environment" value "="))
-
-(define (oci-sanitize-ports value)
- ;; Expected spec format:
- ;; '(("8088" . "80") "2022:22")
- (oci-sanitize-mixed-list "ports" value ":"))
-
-(define (oci-sanitize-volumes value)
- ;; Expected spec format:
- ;; '(("/mnt/dir" . "/dir") "/run/current-system/profile:/java")
- (oci-sanitize-mixed-list "volumes" value ":"))
-
-(define (oci-sanitize-shepherd-actions value)
- (map
- (lambda (el)
- (if (shepherd-action? el)
- el
- (raise
- (formatted-message
- (G_ "shepherd-actions may only be shepherd-action records
-but ~a was found") el))))
- value))
-
-(define (oci-sanitize-extra-arguments value)
- (define (valid? member)
- (or (string? member)
- (gexp? member)
- (file-like? member)))
- (map
- (lambda (el)
- (if (valid? el)
- el
- (raise
- (formatted-message
- (G_ "extra arguments may only be strings, gexps or file-like objects
-but ~a was found") el))))
- value))
-
-(define (oci-image-reference image)
- (if (string? image)
- image
- (string-append (oci-image-repository image)
- ":" (oci-image-tag image))))
-
-(define (oci-lowerable-image? image)
- (or (manifest? image)
- (operating-system? image)
- (gexp? image)
- (file-like? image)))
-
-(define (string-or-oci-image? image)
- (or (string? image)
- (oci-image? image)))
-
-(define list-of-symbols?
- (list-of symbol?))
-
-(define-maybe/no-serialization string)
-
-(define-configuration/no-serialization oci-image
- (repository
- (string)
- "A string like @code{myregistry.local:5000/testing/test-image} that names
-the OCI image.")
- (tag
- (string "latest")
- "A string representing the OCI image tag. Defaults to @code{latest}.")
- (value
- (oci-lowerable-image)
- "A @code{manifest} or @code{operating-system} record that will be lowered
-into an OCI compatible tarball. Otherwise this field's value can be a gexp
-or a file-like object that evaluates to an OCI compatible tarball.")
- (pack-options
- (list '())
- "An optional set of keyword arguments that will be passed to the
-@code{docker-image} procedure from @code{guix scripts pack}. They can be used
-to replicate @command{guix pack} behavior:
-
-@lisp
-(oci-image
- (repository \"guile\")
- (tag \"3\")
- (manifest (specifications->manifest '(\"guile\")))
- (pack-options
- '(#:symlinks ((\"/bin/guile\" -> \"bin/guile\"))
- #:max-layers 2)))
-@end lisp
-
-If the @code{value} field is an @code{operating-system} record, this field's
-value will be ignored.")
- (system
- (maybe-string)
- "Attempt to build for a given system, e.g. \"i686-linux\"")
- (target
- (maybe-string)
- "Attempt to cross-build for a given triple, e.g. \"aarch64-linux-gnu\"")
- (grafts?
- (boolean #f)
- "Whether to allow grafting or not in the pack build."))
-
-(define-configuration/no-serialization oci-container-configuration
- (user
- (string "oci-container")
- "The user under whose authority docker commands will be run.")
- (group
- (string "docker")
- "The group under whose authority docker commands will be run.")
- (command
- (list-of-strings '())
- "Overwrite the default command (@code{CMD}) of the image.")
- (entrypoint
- (maybe-string)
- "Overwrite the default entrypoint (@code{ENTRYPOINT}) of the image.")
- (host-environment
- (list '())
- "Set environment variables in the host environment where @command{docker run}
-is invoked. This is especially useful to pass secrets from the host to the
-container without having them on the @command{docker run}'s command line: by
-setting the @code{MYSQL_PASSWORD} on the host and by passing
-@code{--env MYSQL_PASSWORD} through the @code{extra-arguments} field, it is
-possible to securely set values in the container environment. This field's
-value can be a list of pairs or strings, even mixed:
-
-@lisp
-(list '(\"LANGUAGE\" . \"eo:ca:eu\")
- \"JAVA_HOME=/opt/java\")
-@end lisp
-
-Pair members can be strings, gexps or file-like objects. Strings are passed
-directly to @code{make-forkexec-constructor}."
- (sanitizer oci-sanitize-host-environment))
- (environment
- (list '())
- "Set environment variables inside the container. This can be a list of pairs
-or strings, even mixed:
-
-@lisp
-(list '(\"LANGUAGE\" . \"eo:ca:eu\")
- \"JAVA_HOME=/opt/java\")
-@end lisp
-
-Pair members can be strings, gexps or file-like objects. Strings are passed
-directly to the Docker CLI. You can refer to the
-@url{https://docs.docker.com/engine/reference/commandline/run/#env,upstream}
-documentation for semantics."
- (sanitizer oci-sanitize-environment))
- (image
- (string-or-oci-image)
- "The image used to build the container. It can be a string or an
-@code{oci-image} record. Strings are resolved by the Docker
-Engine, and follow the usual format
-@code{myregistry.local:5000/testing/test-image:tag}.")
- (provision
- (maybe-string)
- "Set the name of the provisioned Shepherd service.")
- (requirement
- (list-of-symbols '())
- "Set additional Shepherd services dependencies to the provisioned Shepherd
-service.")
- (log-file
- (maybe-string)
- "When @code{log-file} is set, it names the file to which the service’s
-standard output and standard error are redirected. @code{log-file} is created
-if it does not exist, otherwise it is appended to.")
- (auto-start?
- (boolean #t)
- "Whether this service should be started automatically by the Shepherd. If it
-is @code{#f} the service has to be started manually with @command{herd start}.")
- (respawn?
- (boolean #f)
- "Whether to restart the service when it stops, for instance when the
-underlying process dies.")
- (shepherd-actions
- (list '())
- "This is a list of @code{shepherd-action} records defining actions supported
-by the service."
- (sanitizer oci-sanitize-shepherd-actions))
- (network
- (maybe-string)
- "Set a Docker network for the spawned container.")
- (ports
- (list '())
- "Set the port or port ranges to expose from the spawned container. This can
-be a list of pairs or strings, even mixed:
-
-@lisp
-(list '(\"8080\" . \"80\")
- \"10443:443\")
-@end lisp
-
-Pair members can be strings, gexps or file-like objects. Strings are passed
-directly to the Docker CLI. You can refer to the
-@url{https://docs.docker.com/engine/reference/commandline/run/#publish,upstream}
-documentation for semantics."
- (sanitizer oci-sanitize-ports))
- (volumes
- (list '())
- "Set volume mappings for the spawned container. This can be a
-list of pairs or strings, even mixed:
-
-@lisp
-(list '(\"/root/data/grafana\" . \"/var/lib/grafana\")
- \"/gnu/store:/gnu/store\")
-@end lisp
-
-Pair members can be strings, gexps or file-like objects. Strings are passed
-directly to the Docker CLI. You can refer to the
-@url{https://docs.docker.com/engine/reference/commandline/run/#volume,upstream}
-documentation for semantics."
- (sanitizer oci-sanitize-volumes))
- (container-user
- (maybe-string)
- "Set the current user inside the spawned container. You can refer to the
-@url{https://docs.docker.com/engine/reference/run/#user,upstream}
-documentation for semantics.")
- (workdir
- (maybe-string)
- "Set the current working for the spawned Shepherd service.
-You can refer to the
-@url{https://docs.docker.com/engine/reference/run/#workdir,upstream}
-documentation for semantics.")
- (extra-arguments
- (list '())
- "A list of strings, gexps or file-like objects that will be directly passed
-to the @command{docker run} invokation."
- (sanitizer oci-sanitize-extra-arguments)))
-
-(define oci-container-configuration->options
- (lambda (config)
- (let ((entrypoint
- (oci-container-configuration-entrypoint config))
- (network
- (oci-container-configuration-network config))
- (user
- (oci-container-configuration-container-user config))
- (workdir
- (oci-container-configuration-workdir config)))
- (apply append
- (filter (compose not unspecified?)
- `(,(if (maybe-value-set? entrypoint)
- `("--entrypoint" ,entrypoint)
- '())
- ,(append-map
- (lambda (spec)
- (list "--env" spec))
- (oci-container-configuration-environment config))
- ,(if (maybe-value-set? network)
- `("--network" ,network)
- '())
- ,(if (maybe-value-set? user)
- `("--user" ,user)
- '())
- ,(if (maybe-value-set? workdir)
- `("--workdir" ,workdir)
- '())
- ,(append-map
- (lambda (spec)
- (list "-p" spec))
- (oci-container-configuration-ports config))
- ,(append-map
- (lambda (spec)
- (list "-v" spec))
- (oci-container-configuration-volumes config))))))))
-
-(define* (get-keyword-value args keyword #:key (default #f))
- (let ((kv (memq keyword args)))
- (if (and kv (>= (length kv) 2))
- (cadr kv)
- default)))
-
-(define (lower-operating-system os target system)
- (mlet* %store-monad
- ((tarball
- (lower-object
- (system-image (os->image os #:type docker-image-type))
- system
- #:target target)))
- (return tarball)))
-
-(define (lower-manifest name image target system)
- (define value (oci-image-value image))
- (define options (oci-image-pack-options image))
- (define image-reference
- (oci-image-reference image))
- (define image-tag
- (let* ((extra-options
- (get-keyword-value options #:extra-options))
- (image-tag-option
- (and extra-options
- (get-keyword-value extra-options #:image-tag))))
- (if image-tag-option
- '()
- `(#:extra-options (#:image-tag ,image-reference)))))
-
- (mlet* %store-monad
- ((_ (set-grafting
- (oci-image-grafts? image)))
- (guile (set-guile-for-build (default-guile)))
- (profile
- (profile-derivation value
- #:target target
- #:system system
- #:hooks '()
- #:locales? #f))
- (tarball (apply pack:docker-image
- `(,name ,profile
- ,@options
- ,@image-tag
- #:localstatedir? #t))))
- (return tarball)))
-
-(define (lower-oci-image name image)
- (define value (oci-image-value image))
- (define image-target (oci-image-target image))
- (define image-system (oci-image-system image))
- (define target
- (if (maybe-value-set? image-target)
- image-target
- (%current-target-system)))
- (define system
- (if (maybe-value-set? image-system)
- image-system
- (%current-system)))
- (with-store store
- (run-with-store store
- (match value
- ((? manifest? value)
- (lower-manifest name image target system))
- ((? operating-system? value)
- (lower-operating-system value target system))
- ((or (? gexp? value)
- (? file-like? value))
- value)
- (_
- (raise
- (formatted-message
- (G_ "oci-image value must contain only manifest,
-operating-system, gexp or file-like records but ~a was found")
- value))))
- #:target target
- #:system system)))
-
-(define (%oci-image-loader name image tag)
- (let ((docker (file-append docker-cli "/bin/docker"))
- (tarball (lower-oci-image name image)))
- (with-imported-modules '((guix build utils))
- (program-file (format #f "~a-image-loader" name)
- #~(begin
- (use-modules (guix build utils)
- (ice-9 popen)
- (ice-9 rdelim))
-
- (format #t "Loading image for ~a from ~a...~%" #$name #$tarball)
- (define line
- (read-line
- (open-input-pipe
- (string-append #$docker " load -i " #$tarball))))
-
- (unless (or (eof-object? line)
- (string-null? line))
- (format #t "~a~%" line)
- (let ((repository&tag
- (string-drop line
- (string-length
- "Loaded image: "))))
-
- (invoke #$docker "tag" repository&tag #$tag)
- (format #t "Tagged ~a with ~a...~%" #$tarball #$tag))))))))
-
-(define (oci-container-shepherd-service config)
- (define (guess-name name image)
- (if (maybe-value-set? name)
- name
- (string-append "docker-"
- (basename
- (if (string? image)
- (first (string-split image #\:))
- (oci-image-repository image))))))
-
- (let* ((docker (file-append docker-cli "/bin/docker"))
- (actions (oci-container-configuration-shepherd-actions config))
- (auto-start?
- (oci-container-configuration-auto-start? config))
- (user (oci-container-configuration-user config))
- (group (oci-container-configuration-group config))
- (host-environment
- (oci-container-configuration-host-environment config))
- (command (oci-container-configuration-command config))
- (log-file (oci-container-configuration-log-file config))
- (provision (oci-container-configuration-provision config))
- (requirement (oci-container-configuration-requirement config))
- (respawn?
- (oci-container-configuration-respawn? config))
- (image (oci-container-configuration-image config))
- (image-reference (oci-image-reference image))
- (options (oci-container-configuration->options config))
- (name (guess-name provision image))
- (extra-arguments
- (oci-container-configuration-extra-arguments config)))
-
- (shepherd-service (provision `(,(string->symbol name)))
- (requirement `(dockerd user-processes ,@requirement))
- (respawn? respawn?)
- (auto-start? auto-start?)
- (documentation
- (string-append
- "Docker backed Shepherd service for "
- (if (oci-image? image) name image) "."))
- (start
- #~(lambda ()
- #$@(if (oci-image? image)
- #~((invoke #$(%oci-image-loader
- name image image-reference)))
- #~())
- (fork+exec-command
- ;; docker run [OPTIONS] IMAGE [COMMAND] [ARG...]
- (list #$docker "run" "--rm" "--name" #$name
- #$@options #$@extra-arguments
- #$image-reference #$@command)
- #:user #$user
- #:group #$group
- #$@(if (maybe-value-set? log-file)
- (list #:log-file log-file)
- '())
- #:environment-variables
- (list #$@host-environment))))
- (stop
- #~(lambda _
- (invoke #$docker "rm" "-f" #$name)))
- (actions
- (if (oci-image? image)
- '()
- (append
- (list
- (shepherd-action
- (name 'pull)
- (documentation
- (format #f "Pull ~a's image (~a)."
- name image))
- (procedure
- #~(lambda _
- (invoke #$docker "pull" #$image)))))
- actions))))))
-
-(define %oci-container-accounts
- (list (user-account
- (name "oci-container")
- (comment "OCI services account")
- (group "docker")
- (system? #t)
- (home-directory "/var/empty")
- (shell (file-append shadow "/sbin/nologin")))))
-
(define (configs->shepherd-services configs)
(map oci-container-shepherd-service configs))
diff --git a/gnu/tests/docker.scm b/gnu/tests/docker.scm
index 90c8d0f8508..5dcf05a17e3 100644
--- a/gnu/tests/docker.scm
+++ b/gnu/tests/docker.scm
@@ -1,7 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019 Danny Milosavljevic <dannym <at> scratchpost.org>
;;; Copyright © 2019-2023 Ludovic Courtès <ludo <at> gnu.org>
-;;; Copyright © 2024 Giacomo Leidi <goodoldpaul <at> autistici.org>
+;;; Copyright © 2024, 2025 Giacomo Leidi <goodoldpaul <at> autistici.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -414,71 +414,54 @@ (define (run-oci-container-test)
(test-runner-current (system-test-runner #$output))
(test-begin "oci-container")
- (test-assert "containerd service running"
- (marionette-eval
- '(begin
- (use-modules (gnu services herd))
- (match (start-service 'containerd)
- (#f #f)
- (('service response-parts ...)
- (match (assq-ref response-parts 'running)
- ((pid) pid)))))
- marionette))
-
- (test-assert "containerd PID file present"
- (wait-for-file "/run/containerd/containerd.pid" marionette))
-
- (test-assert "dockerd running"
- (marionette-eval
- '(begin
- (use-modules (gnu services herd))
- (match (start-service 'dockerd)
- (#f #f)
- (('service response-parts ...)
- (match (assq-ref response-parts 'running)
- ((pid) pid)))))
- marionette))
-
- (sleep 10) ; let service start
+ (wait-for-file "/run/containerd/containerd.pid" marionette)
(test-assert "docker-guile running"
(marionette-eval
'(begin
(use-modules (gnu services herd))
- (match (start-service 'docker-guile)
- (#f #f)
- (('service response-parts ...)
- (match (assq-ref response-parts 'running)
- ((pid) pid)))))
+ (wait-for-service 'docker-guile #:timeout 120)
+ #t)
marionette))
- (test-equal "passing host environment variables and volumes"
- '("value" "hello")
- (marionette-eval
- `(begin
- (use-modules (ice-9 popen)
- (ice-9 rdelim))
-
- (define slurp
- (lambda args
- (let* ((port (apply open-pipe* OPEN_READ args))
- (output (let ((line (read-line port)))
- (if (eof-object? line)
- ""
- line)))
- (status (close-pipe port)))
- output)))
- (let* ((response1 (slurp
- ,(string-append #$docker-cli "/bin/docker")
- "exec" "docker-guile"
- "/bin/guile" "-c" "(display (getenv \"VARIABLE\"))"))
- (response2 (slurp
- ,(string-append #$docker-cli "/bin/docker")
- "exec" "docker-guile"
- "/bin/guile" "-c" "(begin (use-modules (ice-9 popen) (ice-9 rdelim))
+ (test-assert "passing host environment variables and volumes"
+ (begin
+ (define (run-test)
+ (marionette-eval
+ `(begin
+ (use-modules (ice-9 popen)
+ (ice-9 rdelim))
+
+ (define slurp
+ (lambda args
+ (let* ((port (apply open-pipe* OPEN_READ args))
+ (output (let ((line (read-line port)))
+ (if (eof-object? line)
+ ""
+ line)))
+ (status (close-pipe port)))
+ output)))
+ (let* ((response1 (slurp
+ ,(string-append #$docker-cli "/bin/docker")
+ "exec" "docker-guile"
+ "/bin/guile" "-c" "(display (getenv \"VARIABLE\"))"))
+ (response2 (slurp
+ ,(string-append #$docker-cli "/bin/docker")
+ "exec" "docker-guile"
+ "/bin/guile" "-c" "(begin (use-modules (ice-9 popen) (ice-9 rdelim))
(display (call-with-input-file \"/shared.txt\" read-line)))")))
- (list response1 response2)))
- marionette))
+ (list response1 response2)))
+ marionette))
+ ;; Allow services to come up on slower machines
+ (let loop ((attempts 0))
+ (if (= attempts 60)
+ (error "Service didn't come up after more than 60 seconds")
+ (if (equal? '("value" "hello")
+ (run-test))
+ #t
+ (begin
+ (sleep 1)
+ (loop (+ 1 attempts))))))))
(test-end))))
--
2.48.1
guix-patches <at> gnu.org:bug#76081; Package guix-patches.
(Sun, 09 Feb 2025 20:39:02 GMT) Full text and rfc822 format available.Message #35 received at 76081 <at> debbugs.gnu.org (full text, mbox):
From: paul <goodoldpaul <at> autistici.org> To: 76081 <at> debbugs.gnu.org Subject: Re: OCI provisioning service Date: Sun, 9 Feb 2025 21:38:47 +0100
I'm sending a v3 fixing a bug in the merge algorithm for volumes and networks. On 2/9/25 20:14, paul wrote: > Hi, > > I'm about to send a v2. v2 compared to the first revision features: > > > - it actually compiles all the times :) (rev 1 referenced oci-image > too early for it to be working and generated a compile time error, if > you recompiled it sometimes went away so I thought it was a problem of > my setup. CI caught this) > - it allows more values to be overridden by eventual users of the > Scheme API > - it allows passing extra arguments directly after each podman or > docker invokation, allowing for example for overriding podman --root > and similar options. > > All of these tests should pass: > > guix shell -D guix -CPW -- make check-system TESTS="oci-container > oci-service-rootless-podman docker docker-system rootless-podman > oci-service-docker" > > > Thank you for your work, > > giacomo >
guix-patches <at> gnu.org:bug#76081; Package guix-patches.
(Sun, 09 Feb 2025 20:40:02 GMT) Full text and rfc822 format available.Message #38 received at 76081 <at> debbugs.gnu.org (full text, mbox):
From: Giacomo Leidi <goodoldpaul <at> autistici.org> To: 76081 <at> debbugs.gnu.org Cc: Giacomo Leidi <goodoldpaul <at> autistici.org> Subject: [PATCH v3 1/4] services: rootless-podman: Use login shell. Date: Sun, 9 Feb 2025 21:39:05 +0100
This commit allows for having PATH set when changing the owner of
/sys/fs/group.
* gnu/services/containers.scm (crgroups-fs-owner): Use login shell.
Change-Id: I9510c637a5332325e05ca5ebc9dfd4de32685c50
---
gnu/services/containers.scm | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm
index 19d35ccbcb6..dc66ac4f967 100644
--- a/gnu/services/containers.scm
+++ b/gnu/services/containers.scm
@@ -140,7 +140,7 @@ (define (cgroups-fs-owner-entrypoint config)
(rootless-podman-configuration-group-name config))
(program-file "cgroups2-fs-owner-entrypoint"
#~(system*
- (string-append #+bash-minimal "/bin/bash") "-c"
+ (string-append #+bash-minimal "/bin/bash") "-l" "-c"
(string-append "echo Setting /sys/fs/cgroup "
"group ownership to " #$group " && chown -v "
"root:" #$group " /sys/fs/cgroup && "
base-commit: 5a897c5c95a81278b044c18d962d3bd83131ba06
--
2.48.1
ludo <at> gnu.org, maxim.cournoyer <at> gmail.com, guix-patches <at> gnu.org:bug#76081; Package guix-patches.
(Sun, 09 Feb 2025 20:40:03 GMT) Full text and rfc822 format available.Message #41 received at 76081 <at> debbugs.gnu.org (full text, mbox):
From: Giacomo Leidi <goodoldpaul <at> autistici.org> To: 76081 <at> debbugs.gnu.org Cc: Giacomo Leidi <goodoldpaul <at> autistici.org> Subject: [PATCH v3 3/4] services: Add oci-service-type. Date: Sun, 9 Feb 2025 21:39:07 +0100
This patch implements a generalization of the
oci-container-service-type, which consequently is made deprecated. The
oci-service-type, in addition to all the features from the
oci-container-service-type, can now provision OCI networks and volumes.
It only handles OCI objects creation, the user is supposed to handle
state once the objects are provsioned.
It currently supports two different OCI runtimes: Docker and rootless
Podman. Both runtimes are tested to make sure provisioned containers
can connect to each other through provisioned networks and can
read/write data with provisioned volumes.
At last the Scheme API is thought to facilitate the implementation of a
Guix Home service in the future.
* gnu/services/containers.scm (%oci-supported-runtimes): New variable;
(oci-runtime-cli): new variable;
(oci-runtime-name): new variable;
(oci-network-configuration): new variable;
(oci-volume-configuration): new variable;
(oci-configuration): new variable;
(oci-extension): new variable;
(oci-networks-shepherd-name): new variable;
(oci-service-type): new variable;
(oci-state->shepherd-services): new variable.
* doc/guix.texi: Document it.
* gnu/tests/containers.scm: Test it.
* gnu/services/docker.scm: Deprecate the oci-container-service-type.
Change-Id: I656b3db85832e42d53072fcbfb91d1226f39ef38
---
doc/guix.texi | 299 ++++++++--
gnu/services/containers.scm | 1086 +++++++++++++++++++++++++++++++----
gnu/services/docker.scm | 37 +-
gnu/tests/containers.scm | 999 +++++++++++++++++++++++++++++++-
4 files changed, 2225 insertions(+), 196 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index bb5f29277fb..8f66b35297b 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -41778,59 +41778,159 @@ Miscellaneous Services
@cindex OCI-backed, Shepherd services
@subsubheading OCI backed services
-Should you wish to manage your Docker containers with the same consistent
-interface you use for your other Shepherd services,
-@var{oci-container-service-type} is the tool to use: given an
-@acronym{Open Container Initiative, OCI} container image, it will run it in a
+Should you wish to manage your @acronym{Open Container Initiative, OCI} containers
+with the same consistent interface you use for your other Shepherd services,
+@var{oci-service-type} is the tool to use: given an
+OCI container image, it will run it in a
Shepherd service. One example where this is useful: it lets you run services
-that are available as Docker/OCI images but not yet packaged for Guix.
+that are available as OCI images but not yet packaged for Guix.
-@defvar oci-container-service-type
+@defvar oci-service-type
-This is a thin wrapper around Docker's CLI that executes OCI images backed
+This is a thin wrapper around Docker's or Podman's CLI that executes OCI images backed
processes as Shepherd Services.
@lisp
-(service oci-container-service-type
- (list
- (oci-container-configuration
- (network "host")
- (image
- (oci-image
- (repository "guile")
- (tag "3")
- (value (specifications->manifest '("guile")))
- (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile"))
- #:max-layers 2))))
- (entrypoint "/bin/guile")
- (command
- '("-c" "(display \"hello!\n\")")))
- (oci-container-configuration
- (image "prom/prometheus")
- (ports
- '(("9000" . "9000")
- ("9090" . "9090"))))
- (oci-container-configuration
- (image "grafana/grafana:10.0.1")
- (network "host")
- (volumes
- '("/var/lib/grafana:/var/lib/grafana")))))
+(simple-service 'oci-provisioning
+ oci-service-type
+ (oci-extension
+ (networks
+ (list
+ (oci-network-configuration (name "monitoring"))))
+ (containers
+ (list
+ (oci-container-configuration
+ (network "monitoring")
+ (image
+ (oci-image
+ (repository "guile")
+ (tag "3")
+ (value (specifications->manifest '("guile")))
+ (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile"))
+ #:max-layers 2))))
+ (entrypoint "/bin/guile")
+ (command
+ '("-c" "(display \"hello!\n\")")))
+ (oci-container-configuration
+ (image "prom/prometheus")
+ (network "host")
+ (ports
+ '(("9000" . "9000")
+ ("9090" . "9090"))))
+ (oci-container-configuration
+ (image "grafana/grafana:10.0.1")
+ (network "host")
+ (volumes
+ '("/var/lib/grafana:/var/lib/grafana")))))))
@end lisp
In this example three different Shepherd services are going to be added to the
system. Each @code{oci-container-configuration} record translates to a
-@code{docker run} invocation and its fields directly map to options. You can
-refer to the
-@url{https://docs.docker.com/engine/reference/commandline/run,upstream}
-documentation for the semantics of each value. If the images are not found,
-they will be
-@url{https://docs.docker.com/engine/reference/commandline/pull/,pulled}. The
+@command{docker run} or @command{podman run} invocation and its fields directly
+map to options. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html,Podman}
+upstream documentation for semantics of each value. If the images are not found,
+they will be pulled. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/pull/,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-pull.1.html,Podman}
+upstream documentation for semantics. The
services with @code{(network "host")} are going to be attached to the
host network and are supposed to behave like native processes with regard to
networking.
@end defvar
+@c %start of fragment
+
+@deftp {Data Type} oci-configuration
+Available @code{oci-configuration} fields are:
+
+@table @asis
+@item @code{runtime} (default: @code{'docker}) (type: symbol)
+The OCI runtime to use to run commands. It can be either @code{'docker} or
+@code{'podman}.
+
+@item @code{runtime-cli} (type: maybe-package)
+The OCI runtime command line to be installed in the system profile and used
+to provision OCI resources. When unset it will default to @code{docker-cli}
+package for the @code{'docker} runtime or to @code{podman} package for the
+@code{'podman} runtime.
+
+@item @code{runtime-extra-arguments} (default: @code{'()}) (type: list)
+A list of strings, gexps or file-like objects that will be placed
+after each @command{docker} or @command{podman} invokation.
+
+@item @code{user} (default: @code{"oci-container"}) (type: string)
+The user name under whose authority OCI commands will be run.
+
+@item @code{group} (default: @code{"docker"}) (type: string)
+The group name under whose authority OCI commands will be run. When
+using the @code{'podman} OCI runtime, this field will be ignored and the
+default group of the user configured in the @code{user} field will be used.
+
+@item @code{subuids-range} (type: maybe-subid-range)
+An optional @code{subid-range} record allocating subuids for the user from
+the @code{user} field. When unset, with the rootless Podman OCI runtime, it
+defaults to @code{(subid-range (name "oci-container"))}.
+
+@item @code{subgids-range} (type: maybe-subid-range)
+An optional @code{subid-range} record allocating subgids for the user from
+the @code{user} field. When unset, with the rootless Podman OCI runtime, it
+defaults to @code{(subid-range (name "oci-container"))}.
+
+@item @code{containers} (default: @code{'()}) (type: list-of-oci-containers)
+The list of @code{oci-container-configuration} records representing the
+containers to provision. Most users are supposed not to use this field and use
+the @code{oci-extension} record instead.
+
+@item @code{networks} (default: @code{'()}) (type: list-of-oci-networks)
+The list of @code{oci-network-configuration} records representing the
+containers to provision. Most users are supposed not to use this field and use
+the @code{oci-extension} record instead.
+
+@item @code{volumes} (default: @code{'()}) (type: list-of-oci-volumes)
+The list of @code{oci-volumes-configuration} records representing the
+containers to provision. Most users are supposed not to use this field and use
+the @code{oci-extension} record instead.
+
+@item @code{verbose?} (default: @code{#f}) (type: boolean)
+When true, additional output will be printed, allowing to better follow the
+flow of execution.
+
+@end table
+
+@end deftp
+
+
+@c %end of fragment
+
+@c %start of fragment
+
+@deftp {Data Type} oci-extension
+Available @code{oci-extension} fields are:
+
+@table @asis
+@item @code{containers} (default: @code{'()}) (type: list-of-oci-containers)
+The list of @code{oci-container-configuration} records representing the
+containers to provision.
+
+@item @code{networks} (default: @code{'()}) (type: list-of-oci-networks)
+The list of @code{oci-network-configuration} records representing the
+containers to provision.
+
+@item @code{volumes} (default: @code{'()}) (type: list-of-oci-volumes)
+The list of @code{oci-volumes-configuration} records representing the
+containers to provision.
+
+@end table
+
+@end deftp
+
+
+@c %end of fragment
+
+
@c %start of fragment
@deftp {Data Type} oci-container-configuration
@@ -41850,16 +41950,16 @@ Miscellaneous Services
Overwrite the default entrypoint (@code{ENTRYPOINT}) of the image.
@item @code{host-environment} (default: @code{'()}) (type: list)
-Set environment variables in the host environment where @command{docker
-run} is invoked. This is especially useful to pass secrets from the
-host to the container without having them on the @command{docker run}'s
-command line: by setting the @code{MYSQL_PASSWORD} on the host and by passing
+Set environment variables in the host environment where @command{docker run}
+or @command{podman run} are invoked. This is especially useful to pass secrets
+from the host to the container without having them on the OCI runtime command line,
+for example: by setting the @code{MYSQL_PASSWORD} on the host and by passing
@code{--env MYSQL_PASSWORD} through the @code{extra-arguments} field, it is
possible to securely set values in the container environment. This field's
value can be a list of pairs or strings, even mixed:
@lisp
-(list '("LANGUAGE\" . "eo:ca:eu")
+(list '("LANGUAGE" . "eo:ca:eu")
"JAVA_HOME=/opt/java")
@end lisp
@@ -41867,22 +41967,24 @@ Miscellaneous Services
directly to @code{make-forkexec-constructor}.
@item @code{environment} (default: @code{'()}) (type: list)
-Set environment variables. This can be a list of pairs or strings, even mixed:
+Set environment variables inside the container. This can be a list of pairs
+or strings, even mixed:
@lisp
(list '("LANGUAGE" . "eo:ca:eu")
"JAVA_HOME=/opt/java")
@end lisp
-Pair members can be strings, gexps or file-like objects.
-Strings are passed directly to the Docker CLI. You can refer to the
-@uref{https://docs.docker.com/engine/reference/commandline/run/#env,upstream}
-documentation for semantics.
+Pair members can be strings, gexps or file-like objects. Strings are passed
+directly to the OCI runtime CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#env,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#env-e-env,Podman}
+upstream documentation for semantics.
@item @code{image} (type: string-or-oci-image)
The image used to build the container. It can be a string or an
-@code{oci-image} record. Strings are resolved by the Docker Engine, and
-follow the usual format
+@code{oci-image} record. Strings are resolved by the OCI runtime,
+and follow the usual format
@code{myregistry.local:5000/testing/test-image:tag}.
@item @code{provision} (default: @code{""}) (type: string)
@@ -41910,7 +42012,7 @@ Miscellaneous Services
by the service.
@item @code{network} (default: @code{""}) (type: string)
-Set a Docker network for the spawned container.
+Set an OCI network for the spawned container.
@item @code{ports} (default: @code{'()}) (type: list)
Set the port or port ranges to expose from the spawned container. This can be a
@@ -41921,10 +42023,11 @@ Miscellaneous Services
"10443:443")
@end lisp
-Pair members can be strings, gexps or file-like objects.
-Strings are passed directly to the Docker CLI. You can refer to the
-@uref{https://docs.docker.com/engine/reference/commandline/run/#publish,upstream}
-documentation for semantics.
+Pair members can be strings, gexps or file-like objects. Strings are passed
+directly to the OCI runtime CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#publish,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#publish-p-ip-hostport-containerport-protocol,Podman}
+upstream documentation for semantics.
@item @code{volumes} (default: @code{'()}) (type: list)
Set volume mappings for the spawned container. This can be a
@@ -41935,25 +42038,95 @@ Miscellaneous Services
"/gnu/store:/gnu/store")
@end lisp
-Pair members can be strings, gexps or file-like objects.
-Strings are passed directly to the Docker CLI. You can refer to the
-@uref{https://docs.docker.com/engine/reference/commandline/run/#volume,upstream}
-documentation for semantics.
+Pair members can be strings, gexps or file-like objects. Strings are passed
+directly to the OCI runtime CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#volume,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#volume-v-source-volume-host-dir-container-dir-options,Podman}
+upstream documentation for semantics.
@item @code{container-user} (default: @code{""}) (type: string)
Set the current user inside the spawned container. You can refer to the
-@url{https://docs.docker.com/engine/reference/run/#user,upstream}
-documentation for semantics.
+@url{https://docs.docker.com/engine/reference/run/#user,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#user-u-user-group,Podman}
+upstream documentation for semantics.
@item @code{workdir} (default: @code{""}) (type: string)
Set the current working directory for the spawned Shepherd service.
You can refer to the
-@url{https://docs.docker.com/engine/reference/run/#workdir,upstream}
-documentation for semantics.
+@url{https://docs.docker.com/engine/reference/run/#workdir,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#workdir-w-dir,Podman}
+upstream documentation for semantics.
+
+@item @code{extra-arguments} (default: @code{'()}) (type: list)
+A list of strings, gexps or file-like objects that will be directly passed
+to the @command{docker run} or @command{podman run} invokation.
+
+@end table
+
+@end deftp
+
+
+@c %end of fragment
+
+@c %start of fragment
+
+@deftp {Data Type} oci-network-configuration
+Available @code{oci-network-configuration} fields are:
+
+@table @asis
+@item @code{name} (type: string)
+The name of the OCI network to provision.
+
+@item @code{driver} (type: maybe-string)
+The driver to manage the network.
+
+@item @code{gateway} (type: maybe-string)
+IPv4 or IPv6 gateway for the subnet.
+
+@item @code{internal?} (default: @code{#f}) (type: boolean)
+Restrict external access to the network
+
+@item @code{ip-range} (type: maybe-string)
+Allocate container ip from a sub-range in CIDR format.
+
+@item @code{ipam-driver} (type: maybe-string)
+IP Address Management Driver.
+
+@item @code{ipv6?} (default: @code{#f}) (type: boolean)
+Enable IPv6 networking.
+
+@item @code{subnet} (type: maybe-string)
+Subnet in CIDR format that represents a network segment.
+
+@item @code{labels} (default: @code{'()}) (type: list)
+The list of labels that will be used to tag the current volume.
+
+@item @code{extra-arguments} (default: @code{'()}) (type: list)
+A list of strings, gexps or file-like objects that will be directly
+passed to the runtime invokation.
+
+@end table
+
+@end deftp
+
+
+@c %end of fragment
+
+@c %start of fragment
+
+@deftp {Data Type} oci-volume-configuration
+Available @code{oci-volume-configuration} fields are:
+
+@table @asis
+@item @code{name} (type: string)
+The name of the OCI volume to provision.
+
+@item @code{labels} (default: @code{'()}) (type: list)
+The list of labels that will be used to tag the current volume.
@item @code{extra-arguments} (default: @code{'()}) (type: list)
A list of strings, gexps or file-like objects that will be directly
-passed to the @command{docker run} invocation.
+passed to the runtime invokation.
@end table
diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm
index 50bf6c05549..12c509c07ab 100644
--- a/gnu/services/containers.scm
+++ b/gnu/services/containers.scm
@@ -41,6 +41,7 @@ (define-module (gnu services containers)
#:use-module ((guix scripts pack) #:prefix pack:)
#:use-module (guix store)
#:use-module (srfi srfi-1)
+ #:use-module (ice-9 format)
#:use-module (ice-9 match)
#:export (rootless-podman-configuration
rootless-podman-configuration?
@@ -96,8 +97,72 @@ (define-module (gnu services containers)
oci-container-configuration-workdir
oci-container-configuration-extra-arguments
+ list-of-oci-containers?
+ list-of-oci-networks?
+ list-of-oci-volumes?
+
+ %oci-supported-runtimes
+ oci-sanitize-runtime
+ oci-runtime-system-environment
+ oci-runtime-system-extra-arguments
+ oci-runtime-system-group
+ oci-runtime-system-requirement
+ oci-runtime-cli
+ oci-runtime-system-cli
+ oci-runtime-name
+ oci-runtime-group
+
+ oci-network-configuration
+ oci-network-configuration?
+ oci-network-configuration-fields
+ oci-network-configuration-name
+ oci-network-configuration-driver
+ oci-network-configuration-gateway
+ oci-network-configuration-internal?
+ oci-network-configuration-ip-range
+ oci-network-configuration-ipam-driver
+ oci-network-configuration-ipv6?
+ oci-network-configuration-subnet
+ oci-network-configuration-labels
+ oci-network-configuration-extra-arguments
+
+ oci-volume-configuration
+ oci-volume-configuration?
+ oci-volume-configuration-fields
+ oci-volume-configuration-name
+ oci-volume-configuration-labels
+ oci-volume-configuration-extra-arguments
+
+ oci-configuration
+ oci-configuration?
+ oci-configuration-fields
+ oci-configuration-runtime
+ oci-configuration-runtime-cli
+ oci-configuration-runtime-extra-arguments
+ oci-configuration-user
+ oci-configuration-group
+ oci-configuration-containers
+ oci-configuration-networks
+ oci-configuration-volumes
+ oci-configuration-verbose?
+
+ oci-extension
+ oci-extension?
+ oci-extension-fields
+ oci-extension-containers
+ oci-extension-networks
+ oci-extension-volumes
+
+ oci-networks-shepherd-name
+ oci-volumes-shepherd-name
+
oci-container-shepherd-service
- %oci-container-accounts))
+ oci-service-type
+ oci-service-accounts
+ oci-service-profile
+ oci-service-subids
+ oci-state->shepherd-services
+ oci-configuration->shepherd-services))
(define (gexp-or-string? value)
(or (gexp? value)
@@ -294,9 +359,42 @@ (define rootless-podman-service-type
;;;
-;;; OCI container.
+;;; OCI provisioning service.
;;;
+(define %oci-supported-runtimes
+ '(docker podman))
+
+(define (oci-runtime-system-requirement runtime)
+ "Return a list of Shepherd service names required by a given OCI runtime,
+before it is able to run containers."
+ (if (eq? 'podman runtime)
+ '(cgroups2-fs-owner cgroups2-limits
+ rootless-podman-shared-root-fs user-processes)
+ '(dockerd user-processes)))
+
+(define (oci-runtime-name runtime)
+ "Return a human readable name for a given OCI runtime."
+ (if (eq? 'podman runtime)
+ "Podman" "Docker"))
+
+(define (oci-runtime-group runtime maybe-group)
+ "Implement the logic behind selection of the group that is to be used by
+Shepherd to execute OCI commands."
+ (if (maybe-value-set? maybe-group)
+ maybe-group
+ (if (eq? 'podman runtime)
+ "cgroup"
+ "docker")))
+
+(define (oci-sanitize-runtime value)
+ (unless (member value %oci-supported-runtimes)
+ (raise
+ (formatted-message
+ (G_ "OCI runtime must be a symbol and one of ~a,
+but ~a was found") %oci-supported-runtimes value)))
+ value)
+
(define (oci-sanitize-pair pair delimiter)
(define (valid? member)
(or (string? member)
@@ -345,6 +443,11 @@ (define (oci-sanitize-volumes value)
;; '(("/mnt/dir" . "/dir") "/run/current-system/profile:/java")
(oci-sanitize-mixed-list "volumes" value ":"))
+(define (oci-sanitize-labels value)
+ ;; Expected spec format:
+ ;; '(("foo" . "bar") "foo=bar")
+ (oci-sanitize-mixed-list "labels" value "="))
+
(define (oci-sanitize-shepherd-actions value)
(map
(lambda (el)
@@ -372,6 +475,7 @@ (define (oci-sanitize-extra-arguments value)
value))
(define (oci-image-reference image)
+ "Return a string OCI image reference representing IMAGE."
(if (string? image)
image
(string-append (oci-image-repository image)
@@ -390,7 +494,19 @@ (define (string-or-oci-image? image)
(define list-of-symbols?
(list-of symbol?))
+(define (list-of-oci-records? name predicate value)
+ (map
+ (lambda (el)
+ (if (predicate el)
+ el
+ (raise
+ (formatted-message
+ (G_ "~a contains an illegal value: ~a") name el))))
+ value))
+
(define-maybe/no-serialization string)
+(define-maybe/no-serialization package)
+(define-maybe/no-serialization subid-range)
(define-configuration/no-serialization oci-image
(repository
@@ -436,10 +552,12 @@ (define-configuration/no-serialization oci-image
(define-configuration/no-serialization oci-container-configuration
(user
(string "oci-container")
- "The user under whose authority docker commands will be run.")
+ "The user name under whose authority OCI commands will be run.")
(group
(string "docker")
- "The group under whose authority docker commands will be run.")
+ "The group name under whose authority OCI commands will be run. When
+using the @code{'podman} OCI runtime, this field will be ignored and the
+default group of the user configured in the @code{user} field will be used.")
(command
(list-of-strings '())
"Overwrite the default command (@code{CMD}) of the image.")
@@ -449,9 +567,9 @@ (define-configuration/no-serialization oci-container-configuration
(host-environment
(list '())
"Set environment variables in the host environment where @command{docker run}
-is invoked. This is especially useful to pass secrets from the host to the
-container without having them on the @command{docker run}'s command line: by
-setting the @code{MYSQL_PASSWORD} on the host and by passing
+or @command{podman run} are invoked. This is especially useful to pass secrets
+from the host to the container without having them on the OCI runtime command line,
+for example: by setting the @code{MYSQL_PASSWORD} on the host and by passing
@code{--env MYSQL_PASSWORD} through the @code{extra-arguments} field, it is
possible to securely set values in the container environment. This field's
value can be a list of pairs or strings, even mixed:
@@ -475,15 +593,16 @@ (define-configuration/no-serialization oci-container-configuration
@end lisp
Pair members can be strings, gexps or file-like objects. Strings are passed
-directly to the Docker CLI. You can refer to the
-@url{https://docs.docker.com/engine/reference/commandline/run/#env,upstream}
-documentation for semantics."
+directly to the OCI runtime CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#env,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#env-e-env,Podman}
+upstream documentation for semantics."
(sanitizer oci-sanitize-environment))
(image
(string-or-oci-image)
"The image used to build the container. It can be a string or an
-@code{oci-image} record. Strings are resolved by the Docker
-Engine, and follow the usual format
+@code{oci-image} record. Strings are resolved by the OCI runtime,
+and follow the usual format
@code{myregistry.local:5000/testing/test-image:tag}.")
(provision
(maybe-string)
@@ -512,7 +631,7 @@ (define-configuration/no-serialization oci-container-configuration
(sanitizer oci-sanitize-shepherd-actions))
(network
(maybe-string)
- "Set a Docker network for the spawned container.")
+ "Set an OCI network for the spawned container.")
(ports
(list '())
"Set the port or port ranges to expose from the spawned container. This can
@@ -524,9 +643,10 @@ (define-configuration/no-serialization oci-container-configuration
@end lisp
Pair members can be strings, gexps or file-like objects. Strings are passed
-directly to the Docker CLI. You can refer to the
-@url{https://docs.docker.com/engine/reference/commandline/run/#publish,upstream}
-documentation for semantics."
+directly to the OCI runtime CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#publish,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#publish-p-ip-hostport-containerport-protocol,Podman}
+upstream documentation for semantics."
(sanitizer oci-sanitize-ports))
(volumes
(list '())
@@ -539,63 +659,326 @@ (define-configuration/no-serialization oci-container-configuration
@end lisp
Pair members can be strings, gexps or file-like objects. Strings are passed
-directly to the Docker CLI. You can refer to the
-@url{https://docs.docker.com/engine/reference/commandline/run/#volume,upstream}
-documentation for semantics."
+directly to the OCI runtime CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#volume,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#volume-v-source-volume-host-dir-container-dir-options,Podman}
+upstream documentation for semantics."
(sanitizer oci-sanitize-volumes))
(container-user
(maybe-string)
"Set the current user inside the spawned container. You can refer to the
-@url{https://docs.docker.com/engine/reference/run/#user,upstream}
-documentation for semantics.")
+@url{https://docs.docker.com/engine/reference/run/#user,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#user-u-user-group,Podman}
+upstream documentation for semantics.")
(workdir
(maybe-string)
- "Set the current working for the spawned Shepherd service.
+ "Set the current working directory for the spawned Shepherd service.
You can refer to the
-@url{https://docs.docker.com/engine/reference/run/#workdir,upstream}
-documentation for semantics.")
+@url{https://docs.docker.com/engine/reference/run/#workdir,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#workdir-w-dir,Podman}
+upstream documentation for semantics.")
(extra-arguments
(list '())
"A list of strings, gexps or file-like objects that will be directly passed
-to the @command{docker run} invokation."
+to the @command{docker run} or @command{podman run} invokation."
(sanitizer oci-sanitize-extra-arguments)))
-(define oci-container-configuration->options
- (lambda (config)
- (let ((entrypoint
- (oci-container-configuration-entrypoint config))
- (network
- (oci-container-configuration-network config))
- (user
- (oci-container-configuration-container-user config))
- (workdir
- (oci-container-configuration-workdir config)))
- (apply append
- (filter (compose not unspecified?)
- `(,(if (maybe-value-set? entrypoint)
- `("--entrypoint" ,entrypoint)
- '())
- ,(append-map
- (lambda (spec)
- (list "--env" spec))
- (oci-container-configuration-environment config))
- ,(if (maybe-value-set? network)
- `("--network" ,network)
- '())
- ,(if (maybe-value-set? user)
- `("--user" ,user)
- '())
- ,(if (maybe-value-set? workdir)
- `("--workdir" ,workdir)
- '())
- ,(append-map
- (lambda (spec)
- (list "-p" spec))
- (oci-container-configuration-ports config))
- ,(append-map
- (lambda (spec)
- (list "-v" spec))
- (oci-container-configuration-volumes config))))))))
+(define (list-of-oci-containers? value)
+ (list-of-oci-records? "containers" oci-container-configuration? value))
+
+(define-configuration/no-serialization oci-volume-configuration
+ (name
+ (string)
+ "The name of the OCI volume to provision.")
+ (labels
+ (list '())
+ "The list of labels that will be used to tag the current volume."
+ (sanitizer oci-sanitize-labels))
+ (extra-arguments
+ (list '())
+ "A list of strings, gexps or file-like objects that will be directly passed
+to the runtime invokation."
+ (sanitizer oci-sanitize-extra-arguments)))
+
+(define (list-of-oci-volumes? value)
+ (list-of-oci-records? "volumes" oci-volume-configuration? value))
+
+(define-configuration/no-serialization oci-network-configuration
+ (name
+ (string)
+ "The name of the OCI network to provision.")
+ (driver
+ (maybe-string)
+ "The driver to manage the network.")
+ (gateway
+ (maybe-string)
+ "IPv4 or IPv6 gateway for the subnet.")
+ (internal?
+ (boolean #f)
+ "Restrict external access to the network")
+ (ip-range
+ (maybe-string)
+ "Allocate container ip from a sub-range in CIDR format.")
+ (ipam-driver
+ (maybe-string)
+ "IP Address Management Driver.")
+ (ipv6?
+ (boolean #f)
+ "Enable IPv6 networking.")
+ (subnet
+ (maybe-string)
+ "Subnet in CIDR format that represents a network segment.")
+ (labels
+ (list '())
+ "The list of labels that will be used to tag the current volume."
+ (sanitizer oci-sanitize-labels))
+ (extra-arguments
+ (list '())
+ "A list of strings, gexps or file-like objects that will be directly passed
+to the runtime invokation."
+ (sanitizer oci-sanitize-extra-arguments)))
+
+(define (list-of-oci-networks? value)
+ (list-of-oci-records? "networks" oci-network-configuration? value))
+
+(define-configuration/no-serialization oci-configuration
+ (runtime
+ (symbol 'docker)
+ "The OCI runtime to use to run commands. It can be either @code{'docker} or
+@code{'podman}."
+ (sanitizer oci-sanitize-runtime))
+ (runtime-cli
+ (maybe-package)
+ "The OCI runtime command line to be installed in the system profile and used
+to provision OCI resources. When unset it will default to @code{docker-cli}
+package for the @code{'docker} runtime or to @code{podman} package for the
+@code{'podman} runtime.")
+ (runtime-extra-arguments
+ (list '())
+ "A list of strings, gexps or file-like objects that will be placed
+after each @command{docker} or @command{podman} invokation.")
+ (user
+ (string "oci-container")
+ "The user name under whose authority OCI runtime commands will be run.")
+ (group
+ (maybe-string)
+ "The group name under whose authority OCI commands will be run. When
+using the @code{'podman} OCI runtime, this field will be ignored and the
+default group of the user configured in the @code{user} field will be used.")
+ (subuids-range
+ (maybe-subid-range)
+ "An optional @code{subid-range} record allocating subuids for the user from
+the @code{user} field. When unset, with the rootless Podman OCI runtime, it
+defaults to @code{(subid-range (name \"oci-container\"))}.")
+ (subgids-range
+ (maybe-subid-range)
+ "An optional @code{subid-range} record allocating subgids for the user from
+the @code{user} field. When unset, with the rootless Podman OCI runtime, it
+defaults to @code{(subid-range (name \"oci-container\"))}.")
+ (containers
+ (list-of-oci-containers '())
+ "The list of @code{oci-container-configuration} records representing the
+containers to provision. Most users are supposed not to use this field and use
+the @code{oci-extension} record instead.")
+ (networks
+ (list-of-oci-networks '())
+ "The list of @code{oci-network-configuration} records representing the
+networks to provision. Most users are supposed not to use this field and use
+the @code{oci-extension} record instead.")
+ (volumes
+ (list-of-oci-volumes '())
+ "The list of @code{oci-volume-configuration} records representing the
+volumes to provision. Most users are supposed not to use this field and use
+the @code{oci-extension} record instead.")
+ (verbose?
+ (boolean #f)
+ "When true, additional output will be printed, allowing to better follow the
+flow of execution."))
+
+(define (oci-runtime-system-environment runtime user)
+ (if (eq? runtime 'podman)
+ (list
+ #~(string-append
+ "HOME=" (passwd:dir (getpwnam #$user))))
+ #~()))
+
+(define (oci-runtime-system-group runtime user group)
+ (if (eq? runtime 'podman)
+ #~(group:name
+ (getgrgid
+ (passwd:gid
+ (getpwnam #$user))))
+ group))
+
+(define (oci-runtime-cli runtime runtime-cli path)
+ "Return a gexp that, when lowered, evaluates to the file system path of the OCI
+runtime command requested by the user."
+ (if (string? runtime-cli)
+ ;; It is a user defined absolute path
+ runtime-cli
+ #~(string-append
+ #$(if (maybe-value-set? runtime-cli)
+ runtime-cli
+ path)
+ #$(if (eq? 'podman runtime)
+ "/bin/podman"
+ "/bin/docker"))))
+
+(define* (oci-runtime-system-cli config #:key (path "/run/current-system/profile"))
+ (let ((runtime-cli
+ (oci-configuration-runtime-cli config))
+ (runtime
+ (oci-configuration-runtime config)))
+ (oci-runtime-cli runtime runtime-cli path)))
+
+(define-configuration/no-serialization oci-extension
+ (containers
+ (list-of-oci-containers '())
+ "The list of @code{oci-container-configuration} records representing the
+containers to add.")
+ (networks
+ (list-of-oci-networks '())
+ "The list of @code{oci-network-configuration} records representing the
+networks to add.")
+ (volumes
+ (list-of-oci-volumes '())
+ "The list of @code{oci-volume-configuration} records representing the
+volumes to add."))
+
+(define (oci-image->container-name image)
+ "Infer the name of an OCI backed Shepherd service from its OCI image."
+ (basename
+ (if (string? image)
+ (first (string-split image #\:))
+ (oci-image-repository image))))
+
+(define (oci-object-command-shepherd-action object-name invokation)
+ "Return a Shepherd action printing a given INVOKATION of an OCI command for the
+given OBJECT-NAME."
+ (shepherd-action
+ (name 'command-line)
+ (documentation
+ (format #f "Prints ~a's OCI runtime command line invokation."
+ object-name))
+ (procedure
+ #~(lambda _
+ (format #t "~a~%" #$invokation)))))
+
+(define (oci-container-shepherd-name runtime config)
+ "Return the name of an OCI backed Shepherd service based on CONFIG.
+The name configured in the configuration record is returned when
+CONFIG's name field has a value, otherwise a name is inferred from CONFIG's
+image field."
+ (define name (oci-container-configuration-provision config))
+ (define image (oci-container-configuration-image config))
+
+ (if (maybe-value-set? name)
+ name
+ (string-append (symbol->string runtime) "-"
+ (oci-image->container-name image))))
+
+(define (oci-networks-shepherd-name runtime)
+ "Return the name of the OCI networks provisioning Shepherd service based on
+RUNTIME."
+ (string-append (symbol->string runtime) "-networks"))
+
+(define (oci-volumes-shepherd-name runtime)
+ "Return the name of the OCI volumes provisioning Shepherd service based on
+RUNTIME."
+ (string-append (symbol->string runtime) "-volumes"))
+
+(define (oci-container-configuration->options config)
+ "Map CONFIG, an oci-container-configuration record, to a gexp that, upon
+lowering, will be evaluated to a list of strings containing command line options
+for the OCI runtime run command."
+ (let ((entrypoint
+ (oci-container-configuration-entrypoint config))
+ (network
+ (oci-container-configuration-network config))
+ (user
+ (oci-container-configuration-container-user config))
+ (workdir
+ (oci-container-configuration-workdir config)))
+ (apply append
+ (filter (compose not unspecified?)
+ `(,(if (maybe-value-set? entrypoint)
+ `("--entrypoint" ,entrypoint)
+ '())
+ ,(append-map
+ (lambda (spec)
+ (list "--env" spec))
+ (oci-container-configuration-environment config))
+ ,(if (maybe-value-set? network)
+ `("--network" ,network)
+ '())
+ ,(if (maybe-value-set? user)
+ `("--user" ,user)
+ '())
+ ,(if (maybe-value-set? workdir)
+ `("--workdir" ,workdir)
+ '())
+ ,(append-map
+ (lambda (spec)
+ (list "-p" spec))
+ (oci-container-configuration-ports config))
+ ,(append-map
+ (lambda (spec)
+ (list "-v" spec))
+ (oci-container-configuration-volumes config)))))))
+
+(define (oci-network-configuration->options config)
+ "Map CONFIG, an oci-network-configuration record, to a gexp that, upon
+lowering, will be evaluated to a list of strings containing command line options
+for the OCI runtime network create command."
+ (let ((driver (oci-network-configuration-driver config))
+ (gateway
+ (oci-network-configuration-gateway config))
+ (internal?
+ (oci-network-configuration-internal? config))
+ (ip-range
+ (oci-network-configuration-ip-range config))
+ (ipam-driver
+ (oci-network-configuration-ipam-driver config))
+ (ipv6?
+ (oci-network-configuration-ipv6? config))
+ (subnet
+ (oci-network-configuration-subnet config)))
+ (apply append
+ (filter (compose not unspecified?)
+ `(,(if (maybe-value-set? driver)
+ `("--driver" ,driver)
+ '())
+ ,(if (maybe-value-set? gateway)
+ `("--gateway" ,gateway)
+ '())
+ ,(if internal?
+ `("--internal")
+ '())
+ ,(if (maybe-value-set? ip-range)
+ `("--ip-range" ,ip-range)
+ '())
+ ,(if (maybe-value-set? ipam-driver)
+ `("--ipam-driver" ,ipam-driver)
+ '())
+ ,(if ipv6?
+ `("--ipv6")
+ '())
+ ,(if (maybe-value-set? subnet)
+ `("--subnet" ,subnet)
+ '())
+ ,(append-map
+ (lambda (spec)
+ (list "--label" spec))
+ (oci-network-configuration-labels config)))))))
+
+(define (oci-volume-configuration->options config)
+ "Map CONFIG, an oci-volume-configuration record, to a gexp that, upon
+lowering, will be evaluated to a list of strings containing command line options
+for the OCI runtime volume create command."
+ (append-map
+ (lambda (spec)
+ (list "--label" spec))
+ (oci-volume-configuration-labels config)))
(define* (get-keyword-value args keyword #:key (default #f))
(let ((kv (memq keyword args)))
@@ -604,6 +987,7 @@ (define* (get-keyword-value args keyword #:key (default #f))
default)))
(define (lower-operating-system os target system)
+ "Lower OS, an operating-system record, into a tarball containing an OCI image."
(mlet* %store-monad
((tarball
(lower-object
@@ -613,6 +997,7 @@ (define (lower-operating-system os target system)
(return tarball)))
(define (lower-manifest name image target system)
+ "Lower IMAGE, a manifest record, into a tarball containing an OCI image."
(define value (oci-image-value image))
(define options (oci-image-pack-options image))
(define image-reference
@@ -645,6 +1030,7 @@ (define (lower-manifest name image target system)
(return tarball)))
(define (lower-oci-image name image)
+ "Lower IMAGE, a oci-image record, into a tarball containing an OCI image."
(define value (oci-image-value image))
(define image-target (oci-image-target image))
(define image-system (oci-image-system image))
@@ -675,9 +1061,10 @@ (define (lower-oci-image name image)
#:target target
#:system system)))
-(define (%oci-image-loader name image tag)
- (let ((docker (file-append docker-cli "/bin/docker"))
- (tarball (lower-oci-image name image)))
+(define* (oci-image-loader runtime-cli name image tag #:key (verbose? #f))
+ "Return a file-like object that, once lowered, will evaluate to a program able
+to load IMAGE through RUNTIME-CLI and to tag it with TAG afterwards."
+ (let ((tarball (lower-oci-image name image)))
(with-imported-modules '((guix build utils))
(program-file (format #f "~a-image-loader" name)
#~(begin
@@ -686,102 +1073,561 @@ (define (%oci-image-loader name image tag)
(ice-9 rdelim))
(format #t "Loading image for ~a from ~a...~%" #$name #$tarball)
+ (define load-command
+ (string-append #$runtime-cli
+ " load -i " #$tarball))
+ (when #$verbose?
+ (format #t "Running ~a~%" load-command))
(define line
(read-line
- (open-input-pipe
- (string-append #$docker " load -i " #$tarball))))
+ (open-input-pipe load-command)))
(unless (or (eof-object? line)
(string-null? line))
(format #t "~a~%" line)
- (let ((repository&tag
- (string-drop line
- (string-length
- "Loaded image: "))))
+ (let* ((repository&tag
+ (string-drop line
+ (string-length
+ "Loaded image: ")))
+ (tag-command
+ (list #$runtime-cli "tag" repository&tag #$tag)))
+
+ (when #$verbose?
+ (format #t "Running~{ ~a~}~%" tag-command))
- (invoke #$docker "tag" repository&tag #$tag)
+ (apply invoke tag-command)
(format #t "Tagged ~a with ~a...~%" #$tarball #$tag))))))))
-(define (oci-container-shepherd-service config)
- (define (guess-name name image)
- (if (maybe-value-set? name)
- name
- (string-append "docker-"
- (basename
- (if (string? image)
- (first (string-split image #\:))
- (oci-image-repository image))))))
-
- (let* ((docker (file-append docker-cli "/bin/docker"))
- (actions (oci-container-configuration-shepherd-actions config))
+(define (oci-container-run-invokation runtime-cli name command image-reference
+ options runtime-extra-arguments run-extra-arguments)
+ "Return a list representing the OCI runtime
+invokation for running containers."
+ ;; run [OPTIONS] IMAGE [COMMAND] [ARG...]
+ `(,runtime-cli ,@runtime-extra-arguments "run"
+ "--rm" "--name" ,name
+ ,@options ,@run-extra-arguments
+ ,image-reference ,@command))
+
+(define* (oci-container-entrypoint runtime-cli name image image-reference
+ invokation #:key (verbose? #f))
+ "Return a file-like object that, once lowered, will evaluate to the entrypoint
+for the Shepherd service that will run IMAGE through RUNTIME-CLI."
+ (program-file
+ (string-append "oci-entrypoint-" name)
+ #~(begin
+ (use-modules (ice-9 format)
+ (srfi srfi-1))
+ (when #$verbose?
+ (format #t "Running in verbose mode...~%"))
+ (define invokation (list #$@invokation))
+ #$@(if (oci-image? image)
+ #~((system*
+ #$(oci-image-loader
+ runtime-cli name image
+ image-reference #:verbose? verbose?)))
+ #~())
+ (when #$verbose?
+ (format #t "Running~{ ~a~}~%" invokation))
+ (apply execlp `(,(first invokation) ,@invokation)))))
+
+(define* (oci-container-shepherd-service runtime runtime-cli config
+ #:key
+ (runtime-environment #~())
+ (runtime-extra-arguments '())
+ (oci-requirement '())
+ (user #f)
+ (group #f)
+ (verbose? #f))
+ "Return a Shepherd service object that will run the OCI container represented
+by CONFIG through RUNTIME-CLI."
+ (let* ((actions (oci-container-configuration-shepherd-actions config))
(auto-start?
(oci-container-configuration-auto-start? config))
- (user (oci-container-configuration-user config))
- (group (oci-container-configuration-group config))
+ (user (or user (oci-container-configuration-user config)))
+ (group (if (and group (maybe-value-set? group))
+ group
+ (oci-container-configuration-group config)))
(host-environment
(oci-container-configuration-host-environment config))
(command (oci-container-configuration-command config))
(log-file (oci-container-configuration-log-file config))
- (provision (oci-container-configuration-provision config))
(requirement (oci-container-configuration-requirement config))
(respawn?
(oci-container-configuration-respawn? config))
(image (oci-container-configuration-image config))
(image-reference (oci-image-reference image))
(options (oci-container-configuration->options config))
- (name (guess-name provision image))
+ (name
+ (oci-container-shepherd-name runtime config))
(extra-arguments
- (oci-container-configuration-extra-arguments config)))
+ (oci-container-configuration-extra-arguments config))
+ (invokation
+ (oci-container-run-invokation
+ runtime-cli name command image-reference
+ options runtime-extra-arguments extra-arguments)))
(shepherd-service (provision `(,(string->symbol name)))
- (requirement `(dockerd user-processes ,@requirement))
+ (requirement `(,@oci-requirement
+ ,@requirement))
(respawn? respawn?)
(auto-start? auto-start?)
(documentation
(string-append
- "Docker backed Shepherd service for "
+ (oci-runtime-name runtime) " backed Shepherd service for "
(if (oci-image? image) name image) "."))
(start
#~(lambda ()
- #$@(if (oci-image? image)
- #~((invoke #$(%oci-image-loader
- name image image-reference)))
- #~())
(fork+exec-command
- ;; docker run [OPTIONS] IMAGE [COMMAND] [ARG...]
- (list #$docker "run" "--rm" "--name" #$name
- #$@options #$@extra-arguments
- #$image-reference #$@command)
- #:user #$user
- #:group #$group
+ (list
+ #$(oci-container-entrypoint
+ runtime-cli name image image-reference
+ invokation #:verbose? verbose?))
+ #$@(if user (list #:user user) '())
+ #$@(if group (list #:group group) '())
#$@(if (maybe-value-set? log-file)
(list #:log-file log-file)
'())
+ #$@(if (eq? runtime 'podman)
+ (list #:directory
+ #~(passwd:dir (getpwnam #$user)))
+ '())
#:environment-variables
- (list #$@host-environment))))
+ (append
+ (list #$@host-environment)
+ (list #$@runtime-environment)))))
(stop
#~(lambda _
- (invoke #$docker "rm" "-f" #$name)))
+ (invoke #$runtime-cli "rm" "-f" #$name)))
(actions
- (if (oci-image? image)
- '()
- (append
+ (append
+ (list
+ (oci-object-command-shepherd-action
+ name #~(string-join (list #$@invokation) " ")))
+ (if (oci-image? image)
+ '()
(list
- (shepherd-action
- (name 'pull)
- (documentation
- (format #f "Pull ~a's image (~a)."
- name image))
- (procedure
- #~(lambda _
- (invoke #$docker "pull" #$image)))))
- actions))))))
-
-(define %oci-container-accounts
+ (let ((service-name name))
+ (shepherd-action
+ (name 'pull)
+ (documentation
+ (format #f "Pull ~a's image (~a)."
+ service-name image))
+ (procedure
+ #~(lambda _
+ (invoke #$runtime-cli "pull" #$image)))))))
+ actions)))))
+
+(define (oci-object-create-invokation object runtime-cli name options
+ runtime-extra-arguments
+ create-extra-arguments)
+ "Return a gexp that, upon lowering, will evaluate to the OCI runtime
+invokation for creating networks and volumes."
+ ;; network|volume create [options] [NAME]
+ #~(list #$runtime-cli #$@runtime-extra-arguments #$object "create"
+ #$@options #$@create-extra-arguments #$name))
+
+(define (format-oci-invokations invokations)
+ "Return a gexp that, upon lowering, will evaluate to a formatted message
+containing the INVOKATIONS that the OCI runtime will execute to provision
+networks or volumes."
+ #~(string-join (map (lambda (i) (string-join i " "))
+ (list #$@invokations))
+ "\n"))
+
+(define* (oci-object-create-script object runtime runtime-cli invokations
+ #:key (verbose? #f))
+ "Return a file-like object that, once lowered, will evaluate to a program able
+to create OCI networks and volumes through RUNTIME-CLI."
+ (define runtime-string (symbol->string runtime))
+ (program-file
+ (string-append runtime-string "-" object "s-create.scm")
+ #~(begin
+ (use-modules (ice-9 format)
+ (ice-9 match)
+ (ice-9 popen)
+ (ice-9 rdelim)
+ (srfi srfi-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 (object-exists? name)
+ #$(if (eq? runtime 'podman)
+ #~(let ((command
+ (list #$runtime-cli
+ #$object "exists" name)))
+ (when #$verbose?
+ (format #t "Running~{ ~a~}~%" command))
+ (define exit-code (status:exit-val (apply system* command)))
+ (when #$verbose?
+ (format #t "Exit code: ~a~%" exit-code))
+ (equal? EXIT_SUCCESS exit-code))
+ #~(let ((command
+ (string-append #$runtime-cli
+ " " #$object " ls --format "
+ "\"{{.Name}}\"")))
+ (when #$verbose?
+ (format #t "Running ~a~%" command))
+ (member name (read-lines (open-input-pipe command))))))
+
+ (for-each
+ (lambda (invokation)
+ (define name (last invokation))
+ (if (object-exists? name)
+ (format #t "~a ~a ~a already exists, skipping creation.~%"
+ #$(oci-runtime-name runtime) name #$object)
+ (begin
+ (when #$verbose?
+ (format #t "Running~{ ~a~}~%" invokation))
+ (let ((exit-code (status:exit-val (apply system* invokation))))
+ (when #$verbose?
+ (format #t "Exit code: ~a~%" exit-code))))))
+ (list #$@invokations)))))
+
+(define* (oci-object-shepherd-service object runtime runtime-cli name requirement invokations
+ #:key
+ (runtime-environment #~())
+ (user #f)
+ (group #f)
+ (verbose? #f))
+ "Return a Shepherd service object that will create the OBJECTs represented
+by INVOKATIONS through RUNTIME-CLI."
+ (shepherd-service (provision `(,(string->symbol name)))
+ (requirement requirement)
+ (one-shot? #t)
+ (documentation
+ (string-append
+ (oci-runtime-name runtime) " " object
+ " provisioning service"))
+ (start
+ #~(lambda _
+ (fork+exec-command
+ (list
+ #$(oci-object-create-script
+ object runtime runtime-cli
+ invokations
+ #:verbose? verbose?))
+ #$@(if user (list #:user user) '())
+ #$@(if group (list #:group group) '())
+ #:environment-variables
+ (list #$@runtime-environment))))
+ (actions
+ (list
+ (oci-object-command-shepherd-action
+ name (format-oci-invokations invokations))))))
+
+(define* (oci-networks-shepherd-service runtime runtime-cli name networks
+ #:key (user #f) (group #f) (verbose? #f)
+ (runtime-extra-arguments '())
+ (runtime-environment #~())
+ (runtime-requirement '()))
+ "Return a Shepherd service object that will create the networks represented
+in CONFIG."
+ (let ((invokations
+ (map
+ (lambda (network)
+ (oci-object-create-invokation
+ "network" runtime-cli
+ (oci-network-configuration-name network)
+ (oci-network-configuration->options network)
+ runtime-extra-arguments
+ (oci-network-configuration-extra-arguments network)))
+ networks)))
+
+ (oci-object-shepherd-service
+ "network" runtime runtime-cli name
+ runtime-requirement invokations
+ #:user user #:group group #:runtime-environment runtime-environment
+ #:verbose? verbose?)))
+
+(define* (oci-volumes-shepherd-service runtime runtime-cli name volumes
+ #:key (user #f) (group #f) (verbose? #f)
+ (runtime-extra-arguments '())
+ (runtime-environment #~())
+ (runtime-requirement '()))
+ "Return a Shepherd service object that will create the volumes represented
+in CONFIG."
+ (let ((invokations
+ (map
+ (lambda (volume)
+ (oci-object-create-invokation
+ "volume" runtime-cli
+ (oci-volume-configuration-name volume)
+ (oci-volume-configuration->options volume)
+ runtime-extra-arguments
+ (oci-volume-configuration-extra-arguments volume)))
+ volumes)))
+
+ (oci-object-shepherd-service
+ "volume" runtime runtime-cli name runtime-requirement invokations
+ #:user user #:group group #:runtime-environment runtime-environment
+ #:verbose? verbose?)))
+
+(define (oci-service-accounts config)
+ (define user (oci-configuration-user config))
+ (define maybe-group (oci-configuration-group config))
+ (define runtime (oci-configuration-runtime config))
(list (user-account
- (name "oci-container")
+ (name user)
(comment "OCI services account")
- (group "docker")
- (system? #t)
- (home-directory "/var/empty")
+ (group "users")
+ (supplementary-groups
+ (list (oci-runtime-group runtime maybe-group)))
+ (system? (eq? 'docker runtime))
+ (home-directory (if (eq? 'podman runtime)
+ (string-append "/home/" user)
+ "/var/empty"))
+ (create-home-directory? (eq? 'podman runtime))
(shell (file-append shadow "/sbin/nologin")))))
+
+(define* (oci-state->shepherd-services runtime runtime-cli containers networks volumes
+ #:key (user #f) (group #f) (verbose? #f)
+ (networks-name #f) (volumes-name #f)
+ (runtime-extra-arguments '())
+ (runtime-environment #~())
+ (runtime-requirement '())
+ (containers-requirement '())
+ (networks-requirement '())
+ (volumes-requirement '()))
+ (let* ((networks?
+ (> (length networks) 0))
+ (networks-service
+ (if networks?
+ (list
+ (string->symbol
+ (oci-networks-shepherd-name runtime)))
+ '()))
+ (volumes?
+ (> (length volumes) 0))
+ (volumes-service
+ (if volumes?
+ (list
+ (string->symbol
+ (oci-volumes-shepherd-name runtime)))
+ '())))
+ (append
+ (map
+ (lambda (c)
+ (oci-container-shepherd-service
+ runtime runtime-cli c
+ #:user user
+ #:group group
+ #:runtime-environment runtime-environment
+ #:runtime-extra-arguments runtime-extra-arguments
+ #:oci-requirement
+ (append containers-requirement
+ runtime-requirement
+ networks-service
+ volumes-service)
+ #:verbose? verbose?))
+ containers)
+ (if networks?
+ (list
+ (oci-networks-shepherd-service
+ runtime runtime-cli
+ (if (string? networks-name)
+ networks-name
+ (oci-networks-shepherd-name runtime))
+ networks
+ #:user user #:group group
+ #:runtime-extra-arguments runtime-extra-arguments
+ #:runtime-environment runtime-environment
+ #:runtime-requirement (append networks-requirement
+ runtime-requirement)
+ #:verbose? verbose?))
+ '())
+ (if volumes?
+ (list
+ (oci-volumes-shepherd-service
+ runtime runtime-cli
+ (if (string? volumes-name)
+ volumes-name
+ (oci-volumes-shepherd-name runtime))
+ volumes
+ #:user user #:group group
+ #:runtime-extra-arguments runtime-extra-arguments
+ #:runtime-environment runtime-environment
+ #:runtime-requirement (append runtime-requirement
+ volumes-requirement)
+ #:verbose? verbose?))
+ '()))))
+
+(define (oci-configuration->shepherd-services config)
+ (let* ((runtime (oci-configuration-runtime config))
+ (runtime-cli
+ (oci-runtime-system-cli config))
+ (runtime-extra-arguments
+ (oci-configuration-runtime-extra-arguments config))
+ (containers (oci-configuration-containers config))
+ (networks (oci-configuration-networks config))
+ (volumes (oci-configuration-volumes config))
+ (user (oci-configuration-user config))
+ (group (oci-runtime-group
+ runtime (oci-configuration-group config)))
+ (verbose? (oci-configuration-verbose? config)))
+ (oci-state->shepherd-services runtime runtime-cli containers networks volumes
+ #:user user
+ #:group
+ (oci-runtime-system-group runtime user group)
+ #:verbose? verbose?
+ #:runtime-extra-arguments
+ runtime-extra-arguments
+ #:runtime-environment
+ (oci-runtime-system-environment runtime user)
+ #:runtime-requirement
+ (oci-runtime-system-requirement runtime)
+ #:networks-requirement '(networking))))
+
+(define (oci-service-subids config)
+ "Return a subids-extension record representing subuids and subgids required by
+the rootless Podman backend."
+ (define (delete-duplicate-ranges ranges)
+ (delete-duplicates ranges
+ (lambda args
+ (apply string=? (map subid-range-name ranges)))))
+ (define runtime
+ (oci-configuration-runtime config))
+ (define user
+ (oci-configuration-user config))
+ (define subgids (oci-configuration-subgids-range config))
+ (define subuids (oci-configuration-subuids-range config))
+ (define container-users
+ (filter (lambda (range) (not (string=? (subid-range-name range) user)))
+ (map (lambda (container)
+ (subid-range
+ (name
+ (oci-container-configuration-user container))))
+ (oci-configuration-containers config))))
+ (define subgid-ranges
+ (delete-duplicate-ranges
+ (cons
+ (if (maybe-value-set? subgids)
+ subgids
+ (subid-range (name user)))
+ container-users)))
+ (define subuid-ranges
+ (delete-duplicate-ranges
+ (cons
+ (if (maybe-value-set? subuids)
+ subuids
+ (subid-range (name user)))
+ container-users)))
+
+ (if (eq? 'podman runtime)
+ (subids-extension
+ (subgids
+ subgid-ranges)
+ (subuids
+ subuid-ranges))
+ (subids-extension)))
+
+(define (oci-objects-merge-lst a b object get-name)
+ (define (contains? value lst)
+ (member value (map get-name lst)))
+ (let loop ((merged '())
+ (lst (append a b)))
+ (if (null? lst)
+ merged
+ (loop
+ (let ((element (car lst)))
+ (when (contains? element merged)
+ (raise
+ (formatted-message
+ (G_ "Duplicated ~a: ~a. ~as names should be unique, please
+remove the duplicate.") object (get-name element) object)))
+ (cons element merged))
+ (cdr lst)))))
+
+(define (oci-extension-merge a b)
+ (oci-extension
+ (containers (oci-objects-merge-lst
+ (oci-extension-containers a)
+ (oci-extension-containers b)
+ "container"
+ (lambda (config)
+ (define maybe-name (oci-container-configuration-provision config))
+ (if (maybe-value-set? maybe-name)
+ maybe-name
+ (oci-image->container-name
+ (oci-container-configuration-image config))))))
+ (networks (oci-objects-merge-lst
+ (oci-extension-networks a)
+ (oci-extension-networks b)
+ "network"
+ oci-network-configuration-name))
+ (volumes (oci-objects-merge-lst
+ (oci-extension-volumes a)
+ (oci-extension-volumes b)
+ "volume"
+ oci-volume-configuration-name))))
+
+(define (oci-service-profile runtime runtime-cli)
+ (list bash-minimal
+ (cond
+ ((maybe-value-set? runtime-cli)
+ runtime-cli)
+ ((eq? 'podman runtime)
+ podman)
+ (else
+ docker-cli))))
+
+(define oci-service-type
+ (service-type (name 'oci)
+ (extensions
+ (list
+ (service-extension profile-service-type
+ (lambda (config)
+ (let ((runtime-cli
+ (oci-configuration-runtime-cli config))
+ (runtime
+ (oci-configuration-runtime config)))
+ (oci-service-profile runtime runtime-cli))))
+ (service-extension subids-service-type
+ oci-service-subids)
+ (service-extension account-service-type
+ oci-service-accounts)
+ (service-extension shepherd-root-service-type
+ oci-configuration->shepherd-services)))
+ ;; Concatenate OCI object lists.
+ (compose (lambda (args)
+ (fold oci-extension-merge
+ (oci-extension)
+ args)))
+ (extend
+ (lambda (config extension)
+ (oci-configuration
+ (inherit config)
+ (containers
+ (oci-objects-merge-lst
+ (oci-configuration-containers config)
+ (oci-extension-containers extension)
+ "container"
+ (lambda (oci-config)
+ (define runtime
+ (oci-configuration-runtime config))
+ (oci-container-shepherd-name runtime oci-config))))
+ (networks (oci-objects-merge-lst
+ (oci-configuration-networks config)
+ (oci-extension-networks extension)
+ "network"
+ oci-network-configuration-name))
+ (volumes (oci-objects-merge-lst
+ (oci-configuration-volumes config)
+ (oci-extension-volumes extension)
+ "volume"
+ oci-volume-configuration-name)))))
+ (default-value (oci-configuration))
+ (description
+ "This service implements the provisioning of OCI object such
+as containers, networks and volumes.")))
diff --git a/gnu/services/docker.scm b/gnu/services/docker.scm
index 69ff9f1d9e4..98ee175873d 100644
--- a/gnu/services/docker.scm
+++ b/gnu/services/docker.scm
@@ -31,7 +31,10 @@ (define-module (gnu services docker)
#:use-module (gnu system shadow)
#:use-module (gnu packages docker)
#:use-module (gnu packages linux) ;singularity
+ #:use-module (guix deprecation)
+ #:use-module (guix diagnostics)
#:use-module (guix gexp)
+ #:use-module (guix i18n)
#:use-module (guix records)
#:use-module (srfi srfi-1)
#:use-module (ice-9 format)
@@ -67,16 +70,18 @@ (define-module (gnu services docker)
oci-container-configuration-volumes
oci-container-configuration-container-user
oci-container-configuration-workdir
- oci-container-configuration-extra-arguments
- oci-container-shepherd-service
- %oci-container-accounts)
+ oci-container-configuration-extra-arguments)
#:export (containerd-configuration
containerd-service-type
docker-configuration
docker-service-type
singularity-service-type
- oci-container-service-type))
+ ;; for backwards compatibility, until the
+ ;; oci-container-service-type is fully deprecated
+ oci-container-shepherd-service
+ oci-container-service-type
+ %oci-container-accounts))
(define-maybe file-like)
@@ -295,17 +300,25 @@ (define singularity-service-type
;;; OCI container.
;;;
-(define (configs->shepherd-services configs)
- (map oci-container-shepherd-service configs))
+;; for backwards compatibility, until the
+;; oci-container-service-type is fully deprecated
+(define-deprecated (oci-container-shepherd-service config)
+ oci-service-type
+ ((@ (gnu services containers) oci-container-shepherd-service)
+ 'docker config))
+(define %oci-container-accounts
+ (filter user-account? (oci-service-accounts (oci-configuration))))
(define oci-container-service-type
(service-type (name 'oci-container)
- (extensions (list (service-extension profile-service-type
- (lambda _ (list docker-cli)))
- (service-extension account-service-type
- (const %oci-container-accounts))
- (service-extension shepherd-root-service-type
- configs->shepherd-services)))
+ (extensions
+ (list (service-extension oci-service-type
+ (lambda (containers)
+ (warning
+ (G_
+ "'oci-container-service-type' is deprecated, use 'oci-service-type' instead~%"))
+ (oci-extension
+ (containers containers))))))
(default-value '())
(extend append)
(compose concatenate)
diff --git a/gnu/tests/containers.scm b/gnu/tests/containers.scm
index 0ecc8ddb126..bac1f47bd34 100644
--- a/gnu/tests/containers.scm
+++ b/gnu/tests/containers.scm
@@ -27,6 +27,9 @@ (define-module (gnu tests containers)
#:use-module (gnu services)
#:use-module (gnu services containers)
#:use-module (gnu services desktop)
+ #:use-module ((gnu services docker)
+ #:select (containerd-service-type
+ docker-service-type))
#:use-module (gnu services dbus)
#:use-module (gnu services networking)
#:use-module (gnu system)
@@ -39,7 +42,9 @@ (define-module (gnu tests containers)
#:use-module (guix profiles)
#:use-module ((guix scripts pack) #:prefix pack:)
#:use-module (guix store)
- #:export (%test-rootless-podman))
+ #:export (%test-rootless-podman
+ %test-oci-service-rootless-podman
+ %test-oci-service-docker))
(define %rootless-podman-os
@@ -345,3 +350,995 @@ (define %test-rootless-podman
(name "rootless-podman")
(description "Test rootless Podman service.")
(value (build-tarball&run-rootless-podman-test))))
+
+
+(define %oci-rootless-podman-os
+ (simple-operating-system
+ (service dhcp-client-service-type)
+ (service dbus-root-service-type)
+ (service polkit-service-type)
+ (service elogind-service-type)
+ (service iptables-service-type)
+ (service rootless-podman-service-type)
+ (extra-special-file "/shared.txt"
+ (plain-file "shared.txt" "hello"))
+ (service oci-service-type
+ (oci-configuration
+ (runtime 'podman)
+ (verbose? #t)))
+ (simple-service 'oci-provisioning
+ oci-service-type
+ (oci-extension
+ (networks
+ (list (oci-network-configuration (name "my-network"))))
+ (volumes
+ (list (oci-volume-configuration (name "my-volume"))))
+ (containers
+ (list
+ (oci-container-configuration
+ (provision "first")
+ (image
+ (oci-image
+ (repository "guile")
+ (value
+ (specifications->manifest '("guile")))
+ (pack-options
+ '(#:symlinks (("/bin" -> "bin"))))))
+ (entrypoint "/bin/guile")
+ (network "my-network")
+ (command
+ '("-c" "(use-modules (web server))
+(define (handler request request-body)
+ (values '((content-type . (text/plain))) \"out of office\"))
+(run-server handler 'http `(#:addr ,(inet-pton AF_INET \"0.0.0.0\")))"))
+ (host-environment
+ '(("VARIABLE" . "value")))
+ (volumes
+ '(("my-volume" . "/my-volume")))
+ (extra-arguments
+ '("--env" "VARIABLE")))
+ (oci-container-configuration
+ (provision "second")
+ (image
+ (oci-image
+ (repository "guile")
+ (value
+ (specifications->manifest '("guile")))
+ (pack-options
+ '(#:symlinks (("/bin" -> "bin"))))))
+ (entrypoint "/bin/guile")
+ (network "my-network")
+ (command
+ '("-c" "(let l ((c 300))(display c)(sleep 1)(when(positive? c)(l (- c 1))))"))
+ (volumes
+ '(("my-volume" . "/my-volume")
+ ("/shared.txt" . "/shared.txt:ro"))))))))))
+
+(define (run-rootless-podman-oci-service-test)
+ (define os
+ (marionette-operating-system
+ (operating-system-with-gc-roots
+ %oci-rootless-podman-os
+ (list))
+ #: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))
+ #~(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-oci-service")
+
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (wait-for-service 'user-processes))
+ marionette)
+
+ (test-assert "rootless-podman services started successfully"
+ (begin
+ (define (run-test)
+ (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))
+ ;; Allow services to come up on slower machines
+ (let loop ((attempts 0))
+ (if (= attempts 60)
+ (error "Services didn't come up after more than 60 seconds")
+ (if (equal? '("cgroup" "cgroup")
+ (run-test))
+ #t
+ (begin
+ (sleep 1)
+ (format #t "Services didn't come up yet, retrying with attempt ~a~%"
+ (+ 1 attempts))
+ (loop (+ 1 attempts))))))))
+
+ (test-assert "podman-volumes running"
+ (begin
+ (define (run-test)
+ (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 6))
+ (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 "oci-container")))
+ (setuid (passwd:uid (getpw "oci-container")))
+
+ (let ((response (slurp
+ "/run/current-system/profile/bin/podman"
+ "volume" "ls" "-n" "--format" "\"{{.Name}}\""
+ "|" "tr" "' '" "'\n'")))
+
+ (call-with-output-file (string-append ,out-dir "/response")
+ (lambda (port)
+ (display (string-join response "\n") port)))))
+ (lambda ()
+ (primitive-exit 127))))
+ (pid
+ (cdr (waitpid pid))))
+
+ (wait-for-file (string-append ,out-dir "/response"))
+
+ (stable-sort
+ (slurp "cat" (string-append ,out-dir "/response"))
+ string<=?))
+ marionette))
+ ;; Allow services to come up on slower machines
+ (let loop ((attempts 0))
+ (if (= attempts 80)
+ (error "Service didn't come up after more than 80 seconds")
+ (if (equal? '("my-volume")
+ (run-test))
+ #t
+ (begin
+ (sleep 1)
+ (loop (+ 1 attempts))))))))
+
+ (test-assert "podman-networks running"
+ (begin
+ (define (run-test)
+ (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 6))
+ (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 "oci-container")))
+ (setuid (passwd:uid (getpw "oci-container")))
+
+ (let ((response (slurp
+ "/run/current-system/profile/bin/podman"
+ "network" "ls" "-n" "--format" "\"{{.Name}}\""
+ "|" "tr" "' '" "'\n'")))
+
+ (call-with-output-file (string-append ,out-dir "/response")
+ (lambda (port)
+ (display (string-join response "\n") port)))))
+ (lambda ()
+ (primitive-exit 127))))
+ (pid
+ (cdr (waitpid pid))))
+
+ (wait-for-file (string-append ,out-dir "/response"))
+
+ (stable-sort
+ (slurp "cat" (string-append ,out-dir "/response"))
+ string<=?))
+ marionette))
+ ;; Allow services to come up on slower machines
+ (let loop ((attempts 0))
+ (if (= attempts 80)
+ (error "Service didn't come up after more than 80 seconds")
+ (if (equal? '("my-network" "podman")
+ (run-test))
+ #t
+ (begin
+ (sleep 1)
+ (loop (+ 1 attempts))))))))
+
+ (test-assert "first container running"
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (wait-for-service 'first #:timeout 120)
+ #t)
+ marionette))
+
+ (test-assert "second container running"
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (wait-for-service 'second #:timeout 120)
+ #t)
+ marionette))
+
+ (test-assert "passing host environment variables"
+ (begin
+ (define (run-test)
+ (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 "oci-container")))
+ (setuid (passwd:uid (getpw "oci-container")))
+
+ (let ((response (slurp
+ "/run/current-system/profile/bin/podman"
+ "exec" "first"
+ "/bin/guile" "-c" "'(display (getenv \"VARIABLE\"))'")))
+ (call-with-output-file (string-append ,out-dir "/response")
+ (lambda (port)
+ (display (string-join response "\n") port)))))
+ (lambda ()
+ (primitive-exit 127))))
+ (pid
+ (cdr (waitpid pid))))
+
+ (wait-for-file (string-append ,out-dir "/response"))
+ (slurp "cat" (string-append ,out-dir "/response")))
+ marionette))
+ ;; Allow image to be loaded on slower machines
+ (let loop ((attempts 0))
+ (if (= attempts 180)
+ (error "Service didn't come up after more than 180 seconds")
+ (if (equal? (list "value")
+ (run-test))
+ #t
+ (begin
+ (sleep 1)
+ (loop (+ 1 attempts))))))))
+
+ (test-equal "mounting host files"
+ '("hello")
+ (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 "oci-container")))
+ (setuid (passwd:uid (getpw "oci-container")))
+
+ (let ((response (slurp
+ "/run/current-system/profile/bin/podman"
+ "exec" "second"
+ "/bin/guile" "-c" "'(begin (use-modules (ice-9 popen) (ice-9 rdelim))
+(display (call-with-input-file \"/shared.txt\" read-line)))'")))
+ (call-with-output-file (string-append ,out-dir "/response")
+ (lambda (port)
+ (display (string-join response " ") port)))))
+ (lambda ()
+ (primitive-exit 127))))
+ (pid
+ (cdr (waitpid pid))))
+
+ (wait-for-file (string-append ,out-dir "/response"))
+ (slurp "cat" (string-append ,out-dir "/response")))
+ marionette))
+
+ (test-equal "write to volumes"
+ '("world")
+ (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 "oci-container")))
+ (setuid (passwd:uid (getpw "oci-container")))
+
+ (slurp
+ "/run/current-system/profile/bin/podman"
+ "exec" "first"
+ "/bin/guile" "-c" "'(begin (use-modules (ice-9 popen) (ice-9 rdelim))
+(call-with-output-file \"/my-volume/out.txt\" (lambda (p) (display \"world\" p))))'")
+
+ (let ((response (slurp
+ "/run/current-system/profile/bin/podman"
+ "exec" "second"
+ "/bin/guile" "-c" "'(begin (use-modules (ice-9 popen) (ice-9 rdelim))
+(display (call-with-input-file \"/my-volume/out.txt\" read-line)))'")))
+ (call-with-output-file (string-append ,out-dir "/response")
+ (lambda (port)
+ (display (string-join response " ") port)))))
+ (lambda ()
+ (primitive-exit 127))))
+ (pid
+ (cdr (waitpid pid))))
+
+ (wait-for-file (string-append ,out-dir "/response"))
+ (slurp "cat" (string-append ,out-dir "/response")))
+ marionette))
+
+ (test-equal "can read ports over network"
+ '("out of office")
+ (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 "oci-container")))
+ (setuid (passwd:uid (getpw "oci-container")))
+
+ (let ((response (slurp
+ "/run/current-system/profile/bin/podman"
+ "exec" "second"
+ "/bin/guile" "-c" "'(begin (use-modules (web client))
+(define-values (response out)
+ (http-get \"http://first:8080\"))
+(display out))'")))
+ (call-with-output-file (string-append ,out-dir "/response")
+ (lambda (port)
+ (display (string-join response " ") port)))))
+ (lambda ()
+ (primitive-exit 127))))
+ (pid
+ (cdr (waitpid pid))))
+
+ (wait-for-file (string-append ,out-dir "/response"))
+ (slurp "cat" (string-append ,out-dir "/response")))
+ marionette))
+
+ (test-end))))
+
+ (gexp->derivation "rootless-podman-oci-service-test" test))
+
+(define %test-oci-service-rootless-podman
+ (system-test
+ (name "oci-service-rootless-podman")
+ (description "Test Rootless-Podman backed OCI provisioning service.")
+ (value (run-rootless-podman-oci-service-test))))
+
+(define %oci-docker-os
+ (simple-operating-system
+ (service dhcp-client-service-type)
+ (service dbus-root-service-type)
+ (service polkit-service-type)
+ (service elogind-service-type)
+ (service containerd-service-type)
+ (service docker-service-type)
+ (extra-special-file "/shared.txt"
+ (plain-file "shared.txt" "hello"))
+ (service oci-service-type
+ (oci-configuration
+ (verbose? #t)))
+ (simple-service 'oci-provisioning
+ oci-service-type
+ (oci-extension
+ (networks
+ (list (oci-network-configuration (name "my-network"))))
+ (volumes
+ (list (oci-volume-configuration (name "my-volume"))))
+ (containers
+ (list
+ (oci-container-configuration
+ (provision "first")
+ (image
+ (oci-image
+ (repository "guile")
+ (value
+ (specifications->manifest '("guile")))
+ (pack-options
+ '(#:symlinks (("/bin" -> "bin"))))))
+ (entrypoint "/bin/guile")
+ (network "my-network")
+ (command
+ '("-c" "(use-modules (web server))
+(define (handler request request-body)
+ (values '((content-type . (text/plain))) \"out of office\"))
+(run-server handler 'http `(#:addr ,(inet-pton AF_INET \"0.0.0.0\")))"))
+ (host-environment
+ '(("VARIABLE" . "value")))
+ (volumes
+ '(("my-volume" . "/my-volume")))
+ (extra-arguments
+ '("--env" "VARIABLE")))
+ (oci-container-configuration
+ (provision "second")
+ (image
+ (oci-image
+ (repository "guile")
+ (value
+ (specifications->manifest '("guile")))
+ (pack-options
+ '(#:symlinks (("/bin" -> "bin"))))))
+ (entrypoint "/bin/guile")
+ (network "my-network")
+ (command
+ '("-c" "(let l ((c 300))(display c)(sleep 1)(when(positive? c)(l (- c 1))))"))
+ (volumes
+ '(("my-volume" . "/my-volume")
+ ("/shared.txt" . "/shared.txt:ro"))))))))))
+
+(define (run-docker-oci-service-test)
+ (define os
+ (marionette-operating-system
+ (operating-system-with-gc-roots
+ %oci-docker-os
+ (list))
+ #: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))
+ #~(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))
+
+ (test-runner-current (system-test-runner #$output))
+ (test-begin "docker-oci-service")
+
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (wait-for-service 'dockerd))
+ marionette)
+
+ (test-assert "docker-volumes running"
+ (begin
+ (define (run-test)
+ (marionette-eval
+ `(begin
+ (use-modules (ice-9 popen)
+ (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
+ (list "sh" "-l" "-c"
+ (string-join
+ args
+ " "))))
+ (output (read-lines port))
+ (status (close-pipe port)))
+ output)))
+
+ (stable-sort
+ (slurp
+ "/run/current-system/profile/bin/docker"
+ "volume" "ls" "--format" "\"{{.Name}}\"")
+ string<=?))
+
+ marionette))
+ ;; Allow services to come up on slower machines
+ (let loop ((attempts 0))
+ (if (= attempts 80)
+ (error "Service didn't come up after more than 80 seconds")
+ (if (equal? '("my-volume")
+ (run-test))
+ #t
+ (begin
+ (sleep 1)
+ (loop (+ 1 attempts))))))))
+
+ (test-assert "docker-networks running"
+ (begin
+ (define (run-test)
+ (marionette-eval
+ `(begin
+ (use-modules (ice-9 popen)
+ (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
+ (list "sh" "-l" "-c"
+ (string-join
+ args
+ " "))))
+ (output (read-lines port))
+ (status (close-pipe port)))
+ output)))
+
+ (stable-sort
+ (slurp
+ "/run/current-system/profile/bin/docker"
+ "network" "ls" "--format" "\"{{.Name}}\"")
+ string<=?))
+
+ marionette))
+ ;; Allow services to come up on slower machines
+ (let loop ((attempts 0))
+ (if (= attempts 80)
+ (error "Service didn't come up after more than 80 seconds")
+ (if (equal? '("bridge" "host" "my-network" "none")
+ (run-test))
+ #t
+ (begin
+ (sleep 1)
+ (loop (+ 1 attempts))))))))
+
+ (test-assert "first container running"
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (wait-for-service 'first #:timeout 120)
+ #t)
+ marionette))
+
+ (test-assert "second container running"
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (wait-for-service 'second #:timeout 120)
+ #t)
+ marionette))
+
+ (test-assert "passing host environment variables"
+ (begin
+ (define (run-test)
+ (marionette-eval
+ `(begin
+ (use-modules (ice-9 popen)
+ (ice-9 rdelim))
+
+ (define slurp
+ (lambda args
+ (let* ((port (apply open-pipe* OPEN_READ args))
+ (output (let ((line (read-line port)))
+ (if (eof-object? line)
+ ""
+ line)))
+ (status (close-pipe port)))
+ output)))
+
+ (slurp
+ "/run/current-system/profile/bin/docker"
+ "exec" "first"
+ "/bin/guile" "-c" "(display (getenv \"VARIABLE\"))"))
+ marionette))
+ ;; Allow image to be loaded on slower machines
+ (let loop ((attempts 0))
+ (if (= attempts 180)
+ (error "Service didn't come up after more than 180 seconds")
+ (if (equal? "value"
+ (run-test))
+ #t
+ (begin
+ (sleep 1)
+ (loop (+ 1 attempts))))))))
+
+ (test-equal "mounting host files"
+ "hello"
+ (marionette-eval
+ `(begin
+ (use-modules (ice-9 popen)
+ (ice-9 rdelim))
+
+ (define slurp
+ (lambda args
+ (let* ((port (apply open-pipe* OPEN_READ args))
+ (output (let ((line (read-line port)))
+ (if (eof-object? line)
+ ""
+ line)))
+ (status (close-pipe port)))
+ output)))
+
+ (slurp
+ "/run/current-system/profile/bin/docker"
+ "exec" "second"
+ "/bin/guile" "-c" "(begin (use-modules (ice-9 popen) (ice-9 rdelim))
+(display (call-with-input-file \"/shared.txt\" read-line)))"))
+ marionette))
+
+ (test-equal "write to volumes"
+ "world"
+ (marionette-eval
+ `(begin
+ (use-modules (ice-9 popen)
+ (ice-9 rdelim))
+
+ (define slurp
+ (lambda args
+ (let* ((port (apply open-pipe* OPEN_READ args))
+ (output (let ((line (read-line port)))
+ (if (eof-object? line)
+ ""
+ line)))
+ (status (close-pipe port)))
+ output)))
+
+ (slurp
+ "/run/current-system/profile/bin/docker"
+ "exec" "first"
+ "/bin/guile" "-c" "(begin (use-modules (ice-9 popen) (ice-9 rdelim))
+(call-with-output-file \"/my-volume/out.txt\" (lambda (p) (display \"world\" p))))")
+ (slurp
+ "/run/current-system/profile/bin/docker"
+ "exec" "second"
+ "/bin/guile" "-c" "(begin (use-modules (ice-9 popen) (ice-9 rdelim))
+(display (call-with-input-file \"/my-volume/out.txt\" read-line)))"))
+ marionette))
+
+ (test-equal "can read ports over network"
+ "out of office"
+ (marionette-eval
+ `(begin
+ (use-modules (ice-9 popen)
+ (ice-9 rdelim))
+
+ (define slurp
+ (lambda args
+ (let* ((port (apply open-pipe* OPEN_READ args))
+ (output (let ((line (read-line port)))
+ (if (eof-object? line)
+ ""
+ line)))
+ (status (close-pipe port)))
+ output)))
+
+ (slurp
+ "/run/current-system/profile/bin/docker"
+ "exec" "second"
+ "/bin/guile" "-c" "(begin (use-modules (web client))
+(define-values (response out)
+ (http-get \"http://first:8080\"))
+(display out))"))
+ marionette))
+
+ (test-end))))
+
+ (gexp->derivation "docker-oci-service-test" test))
+
+(define %test-oci-service-docker
+ (system-test
+ (name "oci-service-docker")
+ (description "Test Docker backed OCI provisioning service.")
+ (value (run-docker-oci-service-test))))
--
2.48.1
guix-patches <at> gnu.org:bug#76081; Package guix-patches.
(Sun, 09 Feb 2025 20:40:03 GMT) Full text and rfc822 format available.Message #44 received at 76081 <at> debbugs.gnu.org (full text, mbox):
From: Giacomo Leidi <goodoldpaul <at> autistici.org> To: 76081 <at> debbugs.gnu.org Cc: Giacomo Leidi <goodoldpaul <at> autistici.org> Subject: [PATCH v3 4/4] tests: Use lower-oci-image-state in container tests. Date: Sun, 9 Feb 2025 21:39:08 +0100
This patch replaces boilerplate in container related tests with
oci-image plumbing from (gnu services containers).
* gnu/services/containers.scm: Export lower-oci-image-state.
* gnu/tests/containers.scm (%oci-tarball): New variable;
(run-rootless-podman-test): use %oci-tarball;
(build-tarball&run-rootless-podman-test): drop procedure.
* gnu/tests/docker.scm (%docker-tarball): New variable;
(build-tarball&run-docker-test): use %docker-tarball;
(%docker-system-tarball): New variable;
(build-tarball&run-docker-system-test): new procedure.
Change-Id: Iad6f0704aee188d89464c83722dea0bb7adb084a
---
gnu/services/containers.scm | 35 ++++++++-----
gnu/tests/containers.scm | 80 ++++++++++++++---------------
gnu/tests/docker.scm | 100 ++++++++++++++++++++----------------
3 files changed, 114 insertions(+), 101 deletions(-)
diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm
index 12c509c07ab..5979b26e6c9 100644
--- a/gnu/services/containers.scm
+++ b/gnu/services/containers.scm
@@ -74,6 +74,8 @@ (define-module (gnu services containers)
oci-image-system
oci-image-grafts?
+ lower-oci-image-state
+
oci-container-configuration
oci-container-configuration?
oci-container-configuration-fields
@@ -996,12 +998,9 @@ (define (lower-operating-system os target system)
#:target target)))
(return tarball)))
-(define (lower-manifest name image target system)
- "Lower IMAGE, a manifest record, into a tarball containing an OCI image."
- (define value (oci-image-value image))
- (define options (oci-image-pack-options image))
- (define image-reference
- (oci-image-reference image))
+(define (lower-manifest name value options image-reference
+ target system grafts?)
+ "Lower VALUE, a manifest record, into a tarball containing an OCI image."
(define image-tag
(let* ((extra-options
(get-keyword-value options #:extra-options))
@@ -1013,8 +1012,7 @@ (define (lower-manifest name image target system)
`(#:extra-options (#:image-tag ,image-reference)))))
(mlet* %store-monad
- ((_ (set-grafting
- (oci-image-grafts? image)))
+ ((_ (set-grafting grafts?))
(guile (set-guile-for-build (default-guile)))
(profile
(profile-derivation value
@@ -1029,11 +1027,8 @@ (define (lower-manifest name image target system)
#:localstatedir? #t))))
(return tarball)))
-(define (lower-oci-image name image)
- "Lower IMAGE, a oci-image record, into a tarball containing an OCI image."
- (define value (oci-image-value image))
- (define image-target (oci-image-target image))
- (define image-system (oci-image-system image))
+(define (lower-oci-image-state name value options reference
+ image-target image-system grafts?)
(define target
(if (maybe-value-set? image-target)
image-target
@@ -1046,7 +1041,8 @@ (define (lower-oci-image name image)
(run-with-store store
(match value
((? manifest? value)
- (lower-manifest name image target system))
+ (lower-manifest name value options reference
+ target system grafts?))
((? operating-system? value)
(lower-operating-system value target system))
((or (? gexp? value)
@@ -1061,6 +1057,17 @@ (define (lower-oci-image name image)
#:target target
#:system system)))
+(define (lower-oci-image name image)
+ "Lower IMAGE, a oci-image record, into a tarball containing an OCI image."
+ (lower-oci-image-state
+ name
+ (oci-image-value image)
+ (oci-image-pack-options image)
+ (oci-image-reference image)
+ (oci-image-target image)
+ (oci-image-system image)
+ (oci-image-grafts? image)))
+
(define* (oci-image-loader runtime-cli name image tag #:key (verbose? #f))
"Return a file-like object that, once lowered, will evaluate to a program able
to load IMAGE through RUNTIME-CLI and to tag it with TAG afterwards."
diff --git a/gnu/tests/containers.scm b/gnu/tests/containers.scm
index bac1f47bd34..1fcf6be7ace 100644
--- a/gnu/tests/containers.scm
+++ b/gnu/tests/containers.scm
@@ -69,13 +69,47 @@ (define %rootless-podman-os
(supplementary-groups '("wheel" "netdev" "cgroup"
"audio" "video")))))))
-(define (run-rootless-podman-test oci-tarball)
+(define %oci-tarball
+ (lower-oci-image-state
+ "guile-guest"
+ (packages->manifest
+ (list
+ guile-3.0 guile-json-3
+ (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))))
+ '(#:entry-point "bin/guile"
+ #:localstatedir? #t
+ #:extra-options (#:image-tag "guile-guest")
+ #:symlinks (("/bin/Guile" -> "bin/guile")
+ ("aa.scm" -> "a.scm")))
+ "guile-guest"
+ (%current-target-system)
+ (%current-system)
+ #f))
+
+(define (run-rootless-podman-test)
(define os
(marionette-operating-system
(operating-system-with-gc-roots
%rootless-podman-os
- (list oci-tarball))
+ (list %oci-tarball))
#:imported-modules '((gnu services herd)
(guix combinators))))
@@ -254,7 +288,7 @@ (define (run-rootless-podman-test oci-tarball)
(let* ((loaded (slurp ,(string-append #$podman
"/bin/podman")
"load" "-i"
- ,#$oci-tarball))
+ ,#$%oci-tarball))
(repository&tag "localhost/guile-guest:latest")
(response1 (slurp
,(string-append #$podman "/bin/podman")
@@ -307,49 +341,11 @@ (define (run-rootless-podman-test oci-tarball)
(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))))
+ (value (run-rootless-podman-test))))
(define %oci-rootless-podman-os
diff --git a/gnu/tests/docker.scm b/gnu/tests/docker.scm
index 5dcf05a17e3..07edd9d5341 100644
--- a/gnu/tests/docker.scm
+++ b/gnu/tests/docker.scm
@@ -26,6 +26,7 @@ (define-module (gnu tests docker)
#:use-module (gnu system image)
#:use-module (gnu system vm)
#:use-module (gnu services)
+ #:use-module (gnu services containers)
#:use-module (gnu services dbus)
#:use-module (gnu services networking)
#:use-module (gnu services docker)
@@ -57,6 +58,40 @@ (define %docker-os
(service containerd-service-type)
(service docker-service-type)))
+(define %docker-tarball
+ (lower-oci-image-state
+ "guile-guest"
+ (packages->manifest
+ (list
+ guile-3.0 guile-json-3
+ (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))))
+ '(#:entry-point "bin/guile"
+ #:localstatedir? #t
+ #:extra-options (#:image-tag "guile-guest")
+ #:symlinks (("/bin/Guile" -> "bin/guile")
+ ("aa.scm" -> "a.scm")))
+ "guile-guest"
+ (%current-target-system)
+ (%current-system)
+ #f))
+
(define (run-docker-test docker-tarball)
"Load DOCKER-TARBALL as Docker image and run it in a Docker container,
inside %DOCKER-OS."
@@ -173,40 +208,7 @@ (define (run-docker-test docker-tarball)
(gexp->derivation "docker-test" test))
(define (build-tarball&run-docker-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"))
- #:entry-point "bin/guile"
- #:localstatedir? #t)))
- (run-docker-test tarball)))
+ (run-docker-test %docker-tarball))
(define %test-docker
(system-test
@@ -215,8 +217,22 @@ (define %test-docker
(value (build-tarball&run-docker-test))))
+(define %docker-system-tarball
+ (lower-oci-image-state
+ "guix-system-guest"
+ (operating-system
+ (inherit (simple-operating-system))
+ ;; Use locales for a single libc to
+ ;; reduce space requirements.
+ (locale-libcs (list glibc)))
+ '()
+ "guix-system-guest"
+ (%current-target-system)
+ (%current-system)
+ #f))
+
(define (run-docker-system-test tarball)
- "Load DOCKER-TARBALL as Docker image and run it in a Docker container,
+ "Load TARBALL as Docker image and run it in a Docker container,
inside %DOCKER-OS."
(define os
(marionette-operating-system
@@ -333,21 +349,15 @@ (define (run-docker-system-test tarball)
(gexp->derivation "docker-system-test" test))
+(define (build-tarball&run-docker-system-test)
+ (run-docker-system-test %docker-system-tarball))
+
(define %test-docker-system
(system-test
(name "docker-system")
(description "Run a system image as produced by @command{guix system
docker-image} inside Docker.")
- (value (with-monad %store-monad
- (>>= (lower-object
- (system-image (os->image
- (operating-system
- (inherit (simple-operating-system))
- ;; Use locales for a single libc to
- ;; reduce space requirements.
- (locale-libcs (list glibc)))
- #:type docker-image-type)))
- run-docker-system-test)))))
+ (value (build-tarball&run-docker-system-test))))
(define %oci-os
--
2.48.1
guix-patches <at> gnu.org:bug#76081; Package guix-patches.
(Sun, 09 Feb 2025 20:40:04 GMT) Full text and rfc822 format available.Message #47 received at 76081 <at> debbugs.gnu.org (full text, mbox):
From: Giacomo Leidi <goodoldpaul <at> autistici.org> To: 76081 <at> debbugs.gnu.org Cc: Giacomo Leidi <goodoldpaul <at> autistici.org> Subject: [PATCH v3 2/4] services: oci-container-configuration: Move to (gnu services containers). Date: Sun, 9 Feb 2025 21:39:06 +0100
This patch moves the oci-container-configuration and related
configuration records to (gnu services containers).
Public symbols are still exported for backwards
compatibility but since the oci-container-service-type will be
deprecated in favor of the more general oci-service-type, everything is
moved outside of the docker related module.
* gnu/services/docker.scm: Move everything related to oci-container-configuration
to...
* gnu/services/containers.scm: ...here.scm.
* gnu/tests/docker.scm: Simplify %test-oci-container test case.
Change-Id: Iae599dd5cc7442eb632f0c1b3b12f6b928397ae7
---
gnu/services/containers.scm | 549 +++++++++++++++++++++++++++++++++-
gnu/services/docker.scm | 577 +++---------------------------------
gnu/tests/docker.scm | 99 +++----
3 files changed, 625 insertions(+), 600 deletions(-)
diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm
index dc66ac4f967..50bf6c05549 100644
--- a/gnu/services/containers.scm
+++ b/gnu/services/containers.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2024 Giacomo Leidi <goodoldpaul <at> autistici.org>
+;;; Copyright © 2024, 2025 Giacomo Leidi <goodoldpaul <at> autistici.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -17,19 +17,31 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu services containers)
+ #:use-module (gnu image)
+ #:use-module (gnu packages admin)
#:use-module (gnu packages bash)
#:use-module (gnu packages containers)
+ #:use-module (gnu packages docker)
#: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)
#:use-module (gnu system accounts)
+ #:use-module (gnu system image)
#:use-module (gnu system shadow)
#:use-module (gnu system pam)
+ #:use-module (guix diagnostics)
#:use-module (guix gexp)
+ #:use-module (guix i18n)
+ #:use-module (guix monads)
#:use-module (guix packages)
+ #:use-module (guix profiles)
+ #:use-module ((guix scripts pack) #:prefix pack:)
+ #:use-module (guix store)
#:use-module (srfi srfi-1)
+ #:use-module (ice-9 match)
#:export (rootless-podman-configuration
rootless-podman-configuration?
rootless-podman-configuration-fields
@@ -48,7 +60,44 @@ (define-module (gnu services containers)
rootless-podman-shepherd-services
rootless-podman-service-etc
- rootless-podman-service-type))
+ rootless-podman-service-type
+
+ oci-image
+ oci-image?
+ oci-image-fields
+ oci-image-repository
+ oci-image-tag
+ oci-image-value
+ oci-image-pack-options
+ oci-image-target
+ oci-image-system
+ oci-image-grafts?
+
+ oci-container-configuration
+ oci-container-configuration?
+ oci-container-configuration-fields
+ oci-container-configuration-user
+ oci-container-configuration-group
+ oci-container-configuration-command
+ oci-container-configuration-entrypoint
+ oci-container-configuration-host-environment
+ oci-container-configuration-environment
+ oci-container-configuration-image
+ oci-container-configuration-provision
+ oci-container-configuration-requirement
+ oci-container-configuration-log-file
+ oci-container-configuration-auto-start?
+ oci-container-configuration-respawn?
+ oci-container-configuration-shepherd-actions
+ oci-container-configuration-network
+ oci-container-configuration-ports
+ oci-container-configuration-volumes
+ oci-container-configuration-container-user
+ oci-container-configuration-workdir
+ oci-container-configuration-extra-arguments
+
+ oci-container-shepherd-service
+ %oci-container-accounts))
(define (gexp-or-string? value)
(or (gexp? value)
@@ -188,7 +237,7 @@ (define (rootless-podman-cgroups-limits-service config)
rootless-podman-shared-root-fs))
(one-shot? #t)
(documentation
- "Allow setting cgroups limits: cpu, cpuset, memory and
+ "Allow setting cgroups limits: cpu, cpuset, io, memory and
pids.")
(start
#~(make-forkexec-constructor
@@ -242,3 +291,497 @@ (define rootless-podman-service-type
(default-value (rootless-podman-configuration))
(description
"This service configures rootless @code{podman} on the Guix System.")))
+
+
+;;;
+;;; OCI container.
+;;;
+
+(define (oci-sanitize-pair pair delimiter)
+ (define (valid? member)
+ (or (string? member)
+ (gexp? member)
+ (file-like? member)))
+ (match pair
+ (((? valid? key) . (? valid? value))
+ #~(string-append #$key #$delimiter #$value))
+ (_
+ (raise
+ (formatted-message
+ (G_ "pair members must contain only strings, gexps or file-like objects
+but ~a was found")
+ pair)))))
+
+(define (oci-sanitize-mixed-list name value delimiter)
+ (map
+ (lambda (el)
+ (cond ((string? el) el)
+ ((pair? el) (oci-sanitize-pair el delimiter))
+ (else
+ (raise
+ (formatted-message
+ (G_ "~a members must be either a string or a pair but ~a was
+found!")
+ name el)))))
+ value))
+
+(define (oci-sanitize-host-environment value)
+ ;; Expected spec format:
+ ;; '(("HOME" . "/home/nobody") "JAVA_HOME=/java")
+ (oci-sanitize-mixed-list "host-environment" value "="))
+
+(define (oci-sanitize-environment value)
+ ;; Expected spec format:
+ ;; '(("HOME" . "/home/nobody") "JAVA_HOME=/java")
+ (oci-sanitize-mixed-list "environment" value "="))
+
+(define (oci-sanitize-ports value)
+ ;; Expected spec format:
+ ;; '(("8088" . "80") "2022:22")
+ (oci-sanitize-mixed-list "ports" value ":"))
+
+(define (oci-sanitize-volumes value)
+ ;; Expected spec format:
+ ;; '(("/mnt/dir" . "/dir") "/run/current-system/profile:/java")
+ (oci-sanitize-mixed-list "volumes" value ":"))
+
+(define (oci-sanitize-shepherd-actions value)
+ (map
+ (lambda (el)
+ (if (shepherd-action? el)
+ el
+ (raise
+ (formatted-message
+ (G_ "shepherd-actions may only be shepherd-action records
+but ~a was found") el))))
+ value))
+
+(define (oci-sanitize-extra-arguments value)
+ (define (valid? member)
+ (or (string? member)
+ (gexp? member)
+ (file-like? member)))
+ (map
+ (lambda (el)
+ (if (valid? el)
+ el
+ (raise
+ (formatted-message
+ (G_ "extra arguments may only be strings, gexps or file-like objects
+but ~a was found") el))))
+ value))
+
+(define (oci-image-reference image)
+ (if (string? image)
+ image
+ (string-append (oci-image-repository image)
+ ":" (oci-image-tag image))))
+
+(define (oci-lowerable-image? image)
+ (or (manifest? image)
+ (operating-system? image)
+ (gexp? image)
+ (file-like? image)))
+
+(define (string-or-oci-image? image)
+ (or (string? image)
+ (oci-image? image)))
+
+(define list-of-symbols?
+ (list-of symbol?))
+
+(define-maybe/no-serialization string)
+
+(define-configuration/no-serialization oci-image
+ (repository
+ (string)
+ "A string like @code{myregistry.local:5000/testing/test-image} that names
+the OCI image.")
+ (tag
+ (string "latest")
+ "A string representing the OCI image tag. Defaults to @code{latest}.")
+ (value
+ (oci-lowerable-image)
+ "A @code{manifest} or @code{operating-system} record that will be lowered
+into an OCI compatible tarball. Otherwise this field's value can be a gexp
+or a file-like object that evaluates to an OCI compatible tarball.")
+ (pack-options
+ (list '())
+ "An optional set of keyword arguments that will be passed to the
+@code{docker-image} procedure from @code{guix scripts pack}. They can be used
+to replicate @command{guix pack} behavior:
+
+@lisp
+(oci-image
+ (repository \"guile\")
+ (tag \"3\")
+ (manifest (specifications->manifest '(\"guile\")))
+ (pack-options
+ '(#:symlinks ((\"/bin/guile\" -> \"bin/guile\"))
+ #:max-layers 2)))
+@end lisp
+
+If the @code{value} field is an @code{operating-system} record, this field's
+value will be ignored.")
+ (system
+ (maybe-string)
+ "Attempt to build for a given system, e.g. \"i686-linux\"")
+ (target
+ (maybe-string)
+ "Attempt to cross-build for a given triple, e.g. \"aarch64-linux-gnu\"")
+ (grafts?
+ (boolean #f)
+ "Whether to allow grafting or not in the pack build."))
+
+(define-configuration/no-serialization oci-container-configuration
+ (user
+ (string "oci-container")
+ "The user under whose authority docker commands will be run.")
+ (group
+ (string "docker")
+ "The group under whose authority docker commands will be run.")
+ (command
+ (list-of-strings '())
+ "Overwrite the default command (@code{CMD}) of the image.")
+ (entrypoint
+ (maybe-string)
+ "Overwrite the default entrypoint (@code{ENTRYPOINT}) of the image.")
+ (host-environment
+ (list '())
+ "Set environment variables in the host environment where @command{docker run}
+is invoked. This is especially useful to pass secrets from the host to the
+container without having them on the @command{docker run}'s command line: by
+setting the @code{MYSQL_PASSWORD} on the host and by passing
+@code{--env MYSQL_PASSWORD} through the @code{extra-arguments} field, it is
+possible to securely set values in the container environment. This field's
+value can be a list of pairs or strings, even mixed:
+
+@lisp
+(list '(\"LANGUAGE\" . \"eo:ca:eu\")
+ \"JAVA_HOME=/opt/java\")
+@end lisp
+
+Pair members can be strings, gexps or file-like objects. Strings are passed
+directly to @code{make-forkexec-constructor}."
+ (sanitizer oci-sanitize-host-environment))
+ (environment
+ (list '())
+ "Set environment variables inside the container. This can be a list of pairs
+or strings, even mixed:
+
+@lisp
+(list '(\"LANGUAGE\" . \"eo:ca:eu\")
+ \"JAVA_HOME=/opt/java\")
+@end lisp
+
+Pair members can be strings, gexps or file-like objects. Strings are passed
+directly to the Docker CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#env,upstream}
+documentation for semantics."
+ (sanitizer oci-sanitize-environment))
+ (image
+ (string-or-oci-image)
+ "The image used to build the container. It can be a string or an
+@code{oci-image} record. Strings are resolved by the Docker
+Engine, and follow the usual format
+@code{myregistry.local:5000/testing/test-image:tag}.")
+ (provision
+ (maybe-string)
+ "Set the name of the provisioned Shepherd service.")
+ (requirement
+ (list-of-symbols '())
+ "Set additional Shepherd services dependencies to the provisioned Shepherd
+service.")
+ (log-file
+ (maybe-string)
+ "When @code{log-file} is set, it names the file to which the service’s
+standard output and standard error are redirected. @code{log-file} is created
+if it does not exist, otherwise it is appended to.")
+ (auto-start?
+ (boolean #t)
+ "Whether this service should be started automatically by the Shepherd. If it
+is @code{#f} the service has to be started manually with @command{herd start}.")
+ (respawn?
+ (boolean #f)
+ "Whether to restart the service when it stops, for instance when the
+underlying process dies.")
+ (shepherd-actions
+ (list '())
+ "This is a list of @code{shepherd-action} records defining actions supported
+by the service."
+ (sanitizer oci-sanitize-shepherd-actions))
+ (network
+ (maybe-string)
+ "Set a Docker network for the spawned container.")
+ (ports
+ (list '())
+ "Set the port or port ranges to expose from the spawned container. This can
+be a list of pairs or strings, even mixed:
+
+@lisp
+(list '(\"8080\" . \"80\")
+ \"10443:443\")
+@end lisp
+
+Pair members can be strings, gexps or file-like objects. Strings are passed
+directly to the Docker CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#publish,upstream}
+documentation for semantics."
+ (sanitizer oci-sanitize-ports))
+ (volumes
+ (list '())
+ "Set volume mappings for the spawned container. This can be a
+list of pairs or strings, even mixed:
+
+@lisp
+(list '(\"/root/data/grafana\" . \"/var/lib/grafana\")
+ \"/gnu/store:/gnu/store\")
+@end lisp
+
+Pair members can be strings, gexps or file-like objects. Strings are passed
+directly to the Docker CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#volume,upstream}
+documentation for semantics."
+ (sanitizer oci-sanitize-volumes))
+ (container-user
+ (maybe-string)
+ "Set the current user inside the spawned container. You can refer to the
+@url{https://docs.docker.com/engine/reference/run/#user,upstream}
+documentation for semantics.")
+ (workdir
+ (maybe-string)
+ "Set the current working for the spawned Shepherd service.
+You can refer to the
+@url{https://docs.docker.com/engine/reference/run/#workdir,upstream}
+documentation for semantics.")
+ (extra-arguments
+ (list '())
+ "A list of strings, gexps or file-like objects that will be directly passed
+to the @command{docker run} invokation."
+ (sanitizer oci-sanitize-extra-arguments)))
+
+(define oci-container-configuration->options
+ (lambda (config)
+ (let ((entrypoint
+ (oci-container-configuration-entrypoint config))
+ (network
+ (oci-container-configuration-network config))
+ (user
+ (oci-container-configuration-container-user config))
+ (workdir
+ (oci-container-configuration-workdir config)))
+ (apply append
+ (filter (compose not unspecified?)
+ `(,(if (maybe-value-set? entrypoint)
+ `("--entrypoint" ,entrypoint)
+ '())
+ ,(append-map
+ (lambda (spec)
+ (list "--env" spec))
+ (oci-container-configuration-environment config))
+ ,(if (maybe-value-set? network)
+ `("--network" ,network)
+ '())
+ ,(if (maybe-value-set? user)
+ `("--user" ,user)
+ '())
+ ,(if (maybe-value-set? workdir)
+ `("--workdir" ,workdir)
+ '())
+ ,(append-map
+ (lambda (spec)
+ (list "-p" spec))
+ (oci-container-configuration-ports config))
+ ,(append-map
+ (lambda (spec)
+ (list "-v" spec))
+ (oci-container-configuration-volumes config))))))))
+
+(define* (get-keyword-value args keyword #:key (default #f))
+ (let ((kv (memq keyword args)))
+ (if (and kv (>= (length kv) 2))
+ (cadr kv)
+ default)))
+
+(define (lower-operating-system os target system)
+ (mlet* %store-monad
+ ((tarball
+ (lower-object
+ (system-image (os->image os #:type docker-image-type))
+ system
+ #:target target)))
+ (return tarball)))
+
+(define (lower-manifest name image target system)
+ (define value (oci-image-value image))
+ (define options (oci-image-pack-options image))
+ (define image-reference
+ (oci-image-reference image))
+ (define image-tag
+ (let* ((extra-options
+ (get-keyword-value options #:extra-options))
+ (image-tag-option
+ (and extra-options
+ (get-keyword-value extra-options #:image-tag))))
+ (if image-tag-option
+ '()
+ `(#:extra-options (#:image-tag ,image-reference)))))
+
+ (mlet* %store-monad
+ ((_ (set-grafting
+ (oci-image-grafts? image)))
+ (guile (set-guile-for-build (default-guile)))
+ (profile
+ (profile-derivation value
+ #:target target
+ #:system system
+ #:hooks '()
+ #:locales? #f))
+ (tarball (apply pack:docker-image
+ `(,name ,profile
+ ,@options
+ ,@image-tag
+ #:localstatedir? #t))))
+ (return tarball)))
+
+(define (lower-oci-image name image)
+ (define value (oci-image-value image))
+ (define image-target (oci-image-target image))
+ (define image-system (oci-image-system image))
+ (define target
+ (if (maybe-value-set? image-target)
+ image-target
+ (%current-target-system)))
+ (define system
+ (if (maybe-value-set? image-system)
+ image-system
+ (%current-system)))
+ (with-store store
+ (run-with-store store
+ (match value
+ ((? manifest? value)
+ (lower-manifest name image target system))
+ ((? operating-system? value)
+ (lower-operating-system value target system))
+ ((or (? gexp? value)
+ (? file-like? value))
+ value)
+ (_
+ (raise
+ (formatted-message
+ (G_ "oci-image value must contain only manifest,
+operating-system, gexp or file-like records but ~a was found")
+ value))))
+ #:target target
+ #:system system)))
+
+(define (%oci-image-loader name image tag)
+ (let ((docker (file-append docker-cli "/bin/docker"))
+ (tarball (lower-oci-image name image)))
+ (with-imported-modules '((guix build utils))
+ (program-file (format #f "~a-image-loader" name)
+ #~(begin
+ (use-modules (guix build utils)
+ (ice-9 popen)
+ (ice-9 rdelim))
+
+ (format #t "Loading image for ~a from ~a...~%" #$name #$tarball)
+ (define line
+ (read-line
+ (open-input-pipe
+ (string-append #$docker " load -i " #$tarball))))
+
+ (unless (or (eof-object? line)
+ (string-null? line))
+ (format #t "~a~%" line)
+ (let ((repository&tag
+ (string-drop line
+ (string-length
+ "Loaded image: "))))
+
+ (invoke #$docker "tag" repository&tag #$tag)
+ (format #t "Tagged ~a with ~a...~%" #$tarball #$tag))))))))
+
+(define (oci-container-shepherd-service config)
+ (define (guess-name name image)
+ (if (maybe-value-set? name)
+ name
+ (string-append "docker-"
+ (basename
+ (if (string? image)
+ (first (string-split image #\:))
+ (oci-image-repository image))))))
+
+ (let* ((docker (file-append docker-cli "/bin/docker"))
+ (actions (oci-container-configuration-shepherd-actions config))
+ (auto-start?
+ (oci-container-configuration-auto-start? config))
+ (user (oci-container-configuration-user config))
+ (group (oci-container-configuration-group config))
+ (host-environment
+ (oci-container-configuration-host-environment config))
+ (command (oci-container-configuration-command config))
+ (log-file (oci-container-configuration-log-file config))
+ (provision (oci-container-configuration-provision config))
+ (requirement (oci-container-configuration-requirement config))
+ (respawn?
+ (oci-container-configuration-respawn? config))
+ (image (oci-container-configuration-image config))
+ (image-reference (oci-image-reference image))
+ (options (oci-container-configuration->options config))
+ (name (guess-name provision image))
+ (extra-arguments
+ (oci-container-configuration-extra-arguments config)))
+
+ (shepherd-service (provision `(,(string->symbol name)))
+ (requirement `(dockerd user-processes ,@requirement))
+ (respawn? respawn?)
+ (auto-start? auto-start?)
+ (documentation
+ (string-append
+ "Docker backed Shepherd service for "
+ (if (oci-image? image) name image) "."))
+ (start
+ #~(lambda ()
+ #$@(if (oci-image? image)
+ #~((invoke #$(%oci-image-loader
+ name image image-reference)))
+ #~())
+ (fork+exec-command
+ ;; docker run [OPTIONS] IMAGE [COMMAND] [ARG...]
+ (list #$docker "run" "--rm" "--name" #$name
+ #$@options #$@extra-arguments
+ #$image-reference #$@command)
+ #:user #$user
+ #:group #$group
+ #$@(if (maybe-value-set? log-file)
+ (list #:log-file log-file)
+ '())
+ #:environment-variables
+ (list #$@host-environment))))
+ (stop
+ #~(lambda _
+ (invoke #$docker "rm" "-f" #$name)))
+ (actions
+ (if (oci-image? image)
+ '()
+ (append
+ (list
+ (shepherd-action
+ (name 'pull)
+ (documentation
+ (format #f "Pull ~a's image (~a)."
+ name image))
+ (procedure
+ #~(lambda _
+ (invoke #$docker "pull" #$image)))))
+ actions))))))
+
+(define %oci-container-accounts
+ (list (user-account
+ (name "oci-container")
+ (comment "OCI services account")
+ (group "docker")
+ (system? #t)
+ (home-directory "/var/empty")
+ (shell (file-append shadow "/sbin/nologin")))))
diff --git a/gnu/services/docker.scm b/gnu/services/docker.scm
index 3af0f792701..69ff9f1d9e4 100644
--- a/gnu/services/docker.scm
+++ b/gnu/services/docker.scm
@@ -5,7 +5,7 @@
;;; Copyright © 2020 Efraim Flashner <efraim <at> flashner.co.il>
;;; Copyright © 2020 Jesse Dowell <jessedowell <at> gmail.com>
;;; Copyright © 2021 Brice Waegeneire <brice <at> waegenei.re>
-;;; Copyright © 2023, 2024 Giacomo Leidi <goodoldpaul <at> autistici.org>
+;;; Copyright © 2023, 2024, 2025 Giacomo Leidi <goodoldpaul <at> autistici.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -23,72 +23,60 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu services docker)
- #:use-module (gnu image)
#:use-module (gnu services)
#:use-module (gnu services configuration)
- #:use-module (gnu services base)
- #:use-module (gnu services dbus)
+ #:use-module (gnu services containers)
#:use-module (gnu services shepherd)
- #:use-module (gnu system)
- #:use-module (gnu system image)
#:use-module (gnu system privilege)
#:use-module (gnu system shadow)
- #:use-module (gnu packages admin) ;shadow
#:use-module (gnu packages docker)
#:use-module (gnu packages linux) ;singularity
- #:use-module (guix records)
- #:use-module (guix diagnostics)
#:use-module (guix gexp)
- #:use-module (guix i18n)
- #:use-module (guix monads)
- #:use-module (guix packages)
- #:use-module (guix profiles)
- #:use-module ((guix scripts pack) #:prefix pack:)
- #:use-module (guix store)
+ #:use-module (guix records)
#:use-module (srfi srfi-1)
#:use-module (ice-9 format)
#:use-module (ice-9 match)
+ #:re-export (oci-image ;for backwards compatibility, until the
+ oci-image? ;oci-container-service-type is fully deprecated
+ oci-image-fields
+ oci-image-repository
+ oci-image-tag
+ oci-image-value
+ oci-image-pack-options
+ oci-image-target
+ oci-image-system
+ oci-image-grafts?
+ oci-container-configuration
+ oci-container-configuration?
+ oci-container-configuration-fields
+ oci-container-configuration-user
+ oci-container-configuration-group
+ oci-container-configuration-command
+ oci-container-configuration-entrypoint
+ oci-container-configuration-host-environment
+ oci-container-configuration-environment
+ oci-container-configuration-image
+ oci-container-configuration-provision
+ oci-container-configuration-requirement
+ oci-container-configuration-log-file
+ oci-container-configuration-auto-start?
+ oci-container-configuration-respawn?
+ oci-container-configuration-shepherd-actions
+ oci-container-configuration-network
+ oci-container-configuration-ports
+ oci-container-configuration-volumes
+ oci-container-configuration-container-user
+ oci-container-configuration-workdir
+ oci-container-configuration-extra-arguments
+ oci-container-shepherd-service
+ %oci-container-accounts)
#:export (containerd-configuration
containerd-service-type
docker-configuration
docker-service-type
singularity-service-type
- oci-image
- oci-image?
- oci-image-fields
- oci-image-repository
- oci-image-tag
- oci-image-value
- oci-image-pack-options
- oci-image-target
- oci-image-system
- oci-image-grafts?
- oci-container-configuration
- oci-container-configuration?
- oci-container-configuration-fields
- oci-container-configuration-user
- oci-container-configuration-group
- oci-container-configuration-command
- oci-container-configuration-entrypoint
- oci-container-configuration-host-environment
- oci-container-configuration-environment
- oci-container-configuration-image
- oci-container-configuration-provision
- oci-container-configuration-requirement
- oci-container-configuration-log-file
- oci-container-configuration-auto-start?
- oci-container-configuration-respawn?
- oci-container-configuration-shepherd-actions
- oci-container-configuration-network
- oci-container-configuration-ports
- oci-container-configuration-volumes
- oci-container-configuration-container-user
- oci-container-configuration-workdir
- oci-container-configuration-extra-arguments
- oci-container-service-type
- oci-container-shepherd-service
- %oci-container-accounts))
+ oci-container-service-type))
(define-maybe file-like)
@@ -307,495 +295,6 @@ (define singularity-service-type
;;; OCI container.
;;;
-(define (oci-sanitize-pair pair delimiter)
- (define (valid? member)
- (or (string? member)
- (gexp? member)
- (file-like? member)))
- (match pair
- (((? valid? key) . (? valid? value))
- #~(string-append #$key #$delimiter #$value))
- (_
- (raise
- (formatted-message
- (G_ "pair members must contain only strings, gexps or file-like objects
-but ~a was found")
- pair)))))
-
-(define (oci-sanitize-mixed-list name value delimiter)
- (map
- (lambda (el)
- (cond ((string? el) el)
- ((pair? el) (oci-sanitize-pair el delimiter))
- (else
- (raise
- (formatted-message
- (G_ "~a members must be either a string or a pair but ~a was
-found!")
- name el)))))
- value))
-
-(define (oci-sanitize-host-environment value)
- ;; Expected spec format:
- ;; '(("HOME" . "/home/nobody") "JAVA_HOME=/java")
- (oci-sanitize-mixed-list "host-environment" value "="))
-
-(define (oci-sanitize-environment value)
- ;; Expected spec format:
- ;; '(("HOME" . "/home/nobody") "JAVA_HOME=/java")
- (oci-sanitize-mixed-list "environment" value "="))
-
-(define (oci-sanitize-ports value)
- ;; Expected spec format:
- ;; '(("8088" . "80") "2022:22")
- (oci-sanitize-mixed-list "ports" value ":"))
-
-(define (oci-sanitize-volumes value)
- ;; Expected spec format:
- ;; '(("/mnt/dir" . "/dir") "/run/current-system/profile:/java")
- (oci-sanitize-mixed-list "volumes" value ":"))
-
-(define (oci-sanitize-shepherd-actions value)
- (map
- (lambda (el)
- (if (shepherd-action? el)
- el
- (raise
- (formatted-message
- (G_ "shepherd-actions may only be shepherd-action records
-but ~a was found") el))))
- value))
-
-(define (oci-sanitize-extra-arguments value)
- (define (valid? member)
- (or (string? member)
- (gexp? member)
- (file-like? member)))
- (map
- (lambda (el)
- (if (valid? el)
- el
- (raise
- (formatted-message
- (G_ "extra arguments may only be strings, gexps or file-like objects
-but ~a was found") el))))
- value))
-
-(define (oci-image-reference image)
- (if (string? image)
- image
- (string-append (oci-image-repository image)
- ":" (oci-image-tag image))))
-
-(define (oci-lowerable-image? image)
- (or (manifest? image)
- (operating-system? image)
- (gexp? image)
- (file-like? image)))
-
-(define (string-or-oci-image? image)
- (or (string? image)
- (oci-image? image)))
-
-(define list-of-symbols?
- (list-of symbol?))
-
-(define-maybe/no-serialization string)
-
-(define-configuration/no-serialization oci-image
- (repository
- (string)
- "A string like @code{myregistry.local:5000/testing/test-image} that names
-the OCI image.")
- (tag
- (string "latest")
- "A string representing the OCI image tag. Defaults to @code{latest}.")
- (value
- (oci-lowerable-image)
- "A @code{manifest} or @code{operating-system} record that will be lowered
-into an OCI compatible tarball. Otherwise this field's value can be a gexp
-or a file-like object that evaluates to an OCI compatible tarball.")
- (pack-options
- (list '())
- "An optional set of keyword arguments that will be passed to the
-@code{docker-image} procedure from @code{guix scripts pack}. They can be used
-to replicate @command{guix pack} behavior:
-
-@lisp
-(oci-image
- (repository \"guile\")
- (tag \"3\")
- (manifest (specifications->manifest '(\"guile\")))
- (pack-options
- '(#:symlinks ((\"/bin/guile\" -> \"bin/guile\"))
- #:max-layers 2)))
-@end lisp
-
-If the @code{value} field is an @code{operating-system} record, this field's
-value will be ignored.")
- (system
- (maybe-string)
- "Attempt to build for a given system, e.g. \"i686-linux\"")
- (target
- (maybe-string)
- "Attempt to cross-build for a given triple, e.g. \"aarch64-linux-gnu\"")
- (grafts?
- (boolean #f)
- "Whether to allow grafting or not in the pack build."))
-
-(define-configuration/no-serialization oci-container-configuration
- (user
- (string "oci-container")
- "The user under whose authority docker commands will be run.")
- (group
- (string "docker")
- "The group under whose authority docker commands will be run.")
- (command
- (list-of-strings '())
- "Overwrite the default command (@code{CMD}) of the image.")
- (entrypoint
- (maybe-string)
- "Overwrite the default entrypoint (@code{ENTRYPOINT}) of the image.")
- (host-environment
- (list '())
- "Set environment variables in the host environment where @command{docker run}
-is invoked. This is especially useful to pass secrets from the host to the
-container without having them on the @command{docker run}'s command line: by
-setting the @code{MYSQL_PASSWORD} on the host and by passing
-@code{--env MYSQL_PASSWORD} through the @code{extra-arguments} field, it is
-possible to securely set values in the container environment. This field's
-value can be a list of pairs or strings, even mixed:
-
-@lisp
-(list '(\"LANGUAGE\" . \"eo:ca:eu\")
- \"JAVA_HOME=/opt/java\")
-@end lisp
-
-Pair members can be strings, gexps or file-like objects. Strings are passed
-directly to @code{make-forkexec-constructor}."
- (sanitizer oci-sanitize-host-environment))
- (environment
- (list '())
- "Set environment variables inside the container. This can be a list of pairs
-or strings, even mixed:
-
-@lisp
-(list '(\"LANGUAGE\" . \"eo:ca:eu\")
- \"JAVA_HOME=/opt/java\")
-@end lisp
-
-Pair members can be strings, gexps or file-like objects. Strings are passed
-directly to the Docker CLI. You can refer to the
-@url{https://docs.docker.com/engine/reference/commandline/run/#env,upstream}
-documentation for semantics."
- (sanitizer oci-sanitize-environment))
- (image
- (string-or-oci-image)
- "The image used to build the container. It can be a string or an
-@code{oci-image} record. Strings are resolved by the Docker
-Engine, and follow the usual format
-@code{myregistry.local:5000/testing/test-image:tag}.")
- (provision
- (maybe-string)
- "Set the name of the provisioned Shepherd service.")
- (requirement
- (list-of-symbols '())
- "Set additional Shepherd services dependencies to the provisioned Shepherd
-service.")
- (log-file
- (maybe-string)
- "When @code{log-file} is set, it names the file to which the service’s
-standard output and standard error are redirected. @code{log-file} is created
-if it does not exist, otherwise it is appended to.")
- (auto-start?
- (boolean #t)
- "Whether this service should be started automatically by the Shepherd. If it
-is @code{#f} the service has to be started manually with @command{herd start}.")
- (respawn?
- (boolean #f)
- "Whether to restart the service when it stops, for instance when the
-underlying process dies.")
- (shepherd-actions
- (list '())
- "This is a list of @code{shepherd-action} records defining actions supported
-by the service."
- (sanitizer oci-sanitize-shepherd-actions))
- (network
- (maybe-string)
- "Set a Docker network for the spawned container.")
- (ports
- (list '())
- "Set the port or port ranges to expose from the spawned container. This can
-be a list of pairs or strings, even mixed:
-
-@lisp
-(list '(\"8080\" . \"80\")
- \"10443:443\")
-@end lisp
-
-Pair members can be strings, gexps or file-like objects. Strings are passed
-directly to the Docker CLI. You can refer to the
-@url{https://docs.docker.com/engine/reference/commandline/run/#publish,upstream}
-documentation for semantics."
- (sanitizer oci-sanitize-ports))
- (volumes
- (list '())
- "Set volume mappings for the spawned container. This can be a
-list of pairs or strings, even mixed:
-
-@lisp
-(list '(\"/root/data/grafana\" . \"/var/lib/grafana\")
- \"/gnu/store:/gnu/store\")
-@end lisp
-
-Pair members can be strings, gexps or file-like objects. Strings are passed
-directly to the Docker CLI. You can refer to the
-@url{https://docs.docker.com/engine/reference/commandline/run/#volume,upstream}
-documentation for semantics."
- (sanitizer oci-sanitize-volumes))
- (container-user
- (maybe-string)
- "Set the current user inside the spawned container. You can refer to the
-@url{https://docs.docker.com/engine/reference/run/#user,upstream}
-documentation for semantics.")
- (workdir
- (maybe-string)
- "Set the current working for the spawned Shepherd service.
-You can refer to the
-@url{https://docs.docker.com/engine/reference/run/#workdir,upstream}
-documentation for semantics.")
- (extra-arguments
- (list '())
- "A list of strings, gexps or file-like objects that will be directly passed
-to the @command{docker run} invokation."
- (sanitizer oci-sanitize-extra-arguments)))
-
-(define oci-container-configuration->options
- (lambda (config)
- (let ((entrypoint
- (oci-container-configuration-entrypoint config))
- (network
- (oci-container-configuration-network config))
- (user
- (oci-container-configuration-container-user config))
- (workdir
- (oci-container-configuration-workdir config)))
- (apply append
- (filter (compose not unspecified?)
- `(,(if (maybe-value-set? entrypoint)
- `("--entrypoint" ,entrypoint)
- '())
- ,(append-map
- (lambda (spec)
- (list "--env" spec))
- (oci-container-configuration-environment config))
- ,(if (maybe-value-set? network)
- `("--network" ,network)
- '())
- ,(if (maybe-value-set? user)
- `("--user" ,user)
- '())
- ,(if (maybe-value-set? workdir)
- `("--workdir" ,workdir)
- '())
- ,(append-map
- (lambda (spec)
- (list "-p" spec))
- (oci-container-configuration-ports config))
- ,(append-map
- (lambda (spec)
- (list "-v" spec))
- (oci-container-configuration-volumes config))))))))
-
-(define* (get-keyword-value args keyword #:key (default #f))
- (let ((kv (memq keyword args)))
- (if (and kv (>= (length kv) 2))
- (cadr kv)
- default)))
-
-(define (lower-operating-system os target system)
- (mlet* %store-monad
- ((tarball
- (lower-object
- (system-image (os->image os #:type docker-image-type))
- system
- #:target target)))
- (return tarball)))
-
-(define (lower-manifest name image target system)
- (define value (oci-image-value image))
- (define options (oci-image-pack-options image))
- (define image-reference
- (oci-image-reference image))
- (define image-tag
- (let* ((extra-options
- (get-keyword-value options #:extra-options))
- (image-tag-option
- (and extra-options
- (get-keyword-value extra-options #:image-tag))))
- (if image-tag-option
- '()
- `(#:extra-options (#:image-tag ,image-reference)))))
-
- (mlet* %store-monad
- ((_ (set-grafting
- (oci-image-grafts? image)))
- (guile (set-guile-for-build (default-guile)))
- (profile
- (profile-derivation value
- #:target target
- #:system system
- #:hooks '()
- #:locales? #f))
- (tarball (apply pack:docker-image
- `(,name ,profile
- ,@options
- ,@image-tag
- #:localstatedir? #t))))
- (return tarball)))
-
-(define (lower-oci-image name image)
- (define value (oci-image-value image))
- (define image-target (oci-image-target image))
- (define image-system (oci-image-system image))
- (define target
- (if (maybe-value-set? image-target)
- image-target
- (%current-target-system)))
- (define system
- (if (maybe-value-set? image-system)
- image-system
- (%current-system)))
- (with-store store
- (run-with-store store
- (match value
- ((? manifest? value)
- (lower-manifest name image target system))
- ((? operating-system? value)
- (lower-operating-system value target system))
- ((or (? gexp? value)
- (? file-like? value))
- value)
- (_
- (raise
- (formatted-message
- (G_ "oci-image value must contain only manifest,
-operating-system, gexp or file-like records but ~a was found")
- value))))
- #:target target
- #:system system)))
-
-(define (%oci-image-loader name image tag)
- (let ((docker (file-append docker-cli "/bin/docker"))
- (tarball (lower-oci-image name image)))
- (with-imported-modules '((guix build utils))
- (program-file (format #f "~a-image-loader" name)
- #~(begin
- (use-modules (guix build utils)
- (ice-9 popen)
- (ice-9 rdelim))
-
- (format #t "Loading image for ~a from ~a...~%" #$name #$tarball)
- (define line
- (read-line
- (open-input-pipe
- (string-append #$docker " load -i " #$tarball))))
-
- (unless (or (eof-object? line)
- (string-null? line))
- (format #t "~a~%" line)
- (let ((repository&tag
- (string-drop line
- (string-length
- "Loaded image: "))))
-
- (invoke #$docker "tag" repository&tag #$tag)
- (format #t "Tagged ~a with ~a...~%" #$tarball #$tag))))))))
-
-(define (oci-container-shepherd-service config)
- (define (guess-name name image)
- (if (maybe-value-set? name)
- name
- (string-append "docker-"
- (basename
- (if (string? image)
- (first (string-split image #\:))
- (oci-image-repository image))))))
-
- (let* ((docker (file-append docker-cli "/bin/docker"))
- (actions (oci-container-configuration-shepherd-actions config))
- (auto-start?
- (oci-container-configuration-auto-start? config))
- (user (oci-container-configuration-user config))
- (group (oci-container-configuration-group config))
- (host-environment
- (oci-container-configuration-host-environment config))
- (command (oci-container-configuration-command config))
- (log-file (oci-container-configuration-log-file config))
- (provision (oci-container-configuration-provision config))
- (requirement (oci-container-configuration-requirement config))
- (respawn?
- (oci-container-configuration-respawn? config))
- (image (oci-container-configuration-image config))
- (image-reference (oci-image-reference image))
- (options (oci-container-configuration->options config))
- (name (guess-name provision image))
- (extra-arguments
- (oci-container-configuration-extra-arguments config)))
-
- (shepherd-service (provision `(,(string->symbol name)))
- (requirement `(dockerd user-processes ,@requirement))
- (respawn? respawn?)
- (auto-start? auto-start?)
- (documentation
- (string-append
- "Docker backed Shepherd service for "
- (if (oci-image? image) name image) "."))
- (start
- #~(lambda ()
- #$@(if (oci-image? image)
- #~((invoke #$(%oci-image-loader
- name image image-reference)))
- #~())
- (fork+exec-command
- ;; docker run [OPTIONS] IMAGE [COMMAND] [ARG...]
- (list #$docker "run" "--rm" "--name" #$name
- #$@options #$@extra-arguments
- #$image-reference #$@command)
- #:user #$user
- #:group #$group
- #$@(if (maybe-value-set? log-file)
- (list #:log-file log-file)
- '())
- #:environment-variables
- (list #$@host-environment))))
- (stop
- #~(lambda _
- (invoke #$docker "rm" "-f" #$name)))
- (actions
- (if (oci-image? image)
- '()
- (append
- (list
- (shepherd-action
- (name 'pull)
- (documentation
- (format #f "Pull ~a's image (~a)."
- name image))
- (procedure
- #~(lambda _
- (invoke #$docker "pull" #$image)))))
- actions))))))
-
-(define %oci-container-accounts
- (list (user-account
- (name "oci-container")
- (comment "OCI services account")
- (group "docker")
- (system? #t)
- (home-directory "/var/empty")
- (shell (file-append shadow "/sbin/nologin")))))
-
(define (configs->shepherd-services configs)
(map oci-container-shepherd-service configs))
diff --git a/gnu/tests/docker.scm b/gnu/tests/docker.scm
index 90c8d0f8508..5dcf05a17e3 100644
--- a/gnu/tests/docker.scm
+++ b/gnu/tests/docker.scm
@@ -1,7 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019 Danny Milosavljevic <dannym <at> scratchpost.org>
;;; Copyright © 2019-2023 Ludovic Courtès <ludo <at> gnu.org>
-;;; Copyright © 2024 Giacomo Leidi <goodoldpaul <at> autistici.org>
+;;; Copyright © 2024, 2025 Giacomo Leidi <goodoldpaul <at> autistici.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -414,71 +414,54 @@ (define (run-oci-container-test)
(test-runner-current (system-test-runner #$output))
(test-begin "oci-container")
- (test-assert "containerd service running"
- (marionette-eval
- '(begin
- (use-modules (gnu services herd))
- (match (start-service 'containerd)
- (#f #f)
- (('service response-parts ...)
- (match (assq-ref response-parts 'running)
- ((pid) pid)))))
- marionette))
-
- (test-assert "containerd PID file present"
- (wait-for-file "/run/containerd/containerd.pid" marionette))
-
- (test-assert "dockerd running"
- (marionette-eval
- '(begin
- (use-modules (gnu services herd))
- (match (start-service 'dockerd)
- (#f #f)
- (('service response-parts ...)
- (match (assq-ref response-parts 'running)
- ((pid) pid)))))
- marionette))
-
- (sleep 10) ; let service start
+ (wait-for-file "/run/containerd/containerd.pid" marionette)
(test-assert "docker-guile running"
(marionette-eval
'(begin
(use-modules (gnu services herd))
- (match (start-service 'docker-guile)
- (#f #f)
- (('service response-parts ...)
- (match (assq-ref response-parts 'running)
- ((pid) pid)))))
+ (wait-for-service 'docker-guile #:timeout 120)
+ #t)
marionette))
- (test-equal "passing host environment variables and volumes"
- '("value" "hello")
- (marionette-eval
- `(begin
- (use-modules (ice-9 popen)
- (ice-9 rdelim))
-
- (define slurp
- (lambda args
- (let* ((port (apply open-pipe* OPEN_READ args))
- (output (let ((line (read-line port)))
- (if (eof-object? line)
- ""
- line)))
- (status (close-pipe port)))
- output)))
- (let* ((response1 (slurp
- ,(string-append #$docker-cli "/bin/docker")
- "exec" "docker-guile"
- "/bin/guile" "-c" "(display (getenv \"VARIABLE\"))"))
- (response2 (slurp
- ,(string-append #$docker-cli "/bin/docker")
- "exec" "docker-guile"
- "/bin/guile" "-c" "(begin (use-modules (ice-9 popen) (ice-9 rdelim))
+ (test-assert "passing host environment variables and volumes"
+ (begin
+ (define (run-test)
+ (marionette-eval
+ `(begin
+ (use-modules (ice-9 popen)
+ (ice-9 rdelim))
+
+ (define slurp
+ (lambda args
+ (let* ((port (apply open-pipe* OPEN_READ args))
+ (output (let ((line (read-line port)))
+ (if (eof-object? line)
+ ""
+ line)))
+ (status (close-pipe port)))
+ output)))
+ (let* ((response1 (slurp
+ ,(string-append #$docker-cli "/bin/docker")
+ "exec" "docker-guile"
+ "/bin/guile" "-c" "(display (getenv \"VARIABLE\"))"))
+ (response2 (slurp
+ ,(string-append #$docker-cli "/bin/docker")
+ "exec" "docker-guile"
+ "/bin/guile" "-c" "(begin (use-modules (ice-9 popen) (ice-9 rdelim))
(display (call-with-input-file \"/shared.txt\" read-line)))")))
- (list response1 response2)))
- marionette))
+ (list response1 response2)))
+ marionette))
+ ;; Allow services to come up on slower machines
+ (let loop ((attempts 0))
+ (if (= attempts 60)
+ (error "Service didn't come up after more than 60 seconds")
+ (if (equal? '("value" "hello")
+ (run-test))
+ #t
+ (begin
+ (sleep 1)
+ (loop (+ 1 attempts))))))))
(test-end))))
--
2.48.1
guix-patches <at> gnu.org:bug#76081; Package guix-patches.
(Wed, 12 Feb 2025 01:10:02 GMT) Full text and rfc822 format available.Message #50 received at 76081 <at> debbugs.gnu.org (full text, mbox):
From: paul <goodoldpaul <at> autistici.org> To: 76081 <at> debbugs.gnu.org Subject: Re: OCI provisioning service Date: Wed, 12 Feb 2025 02:09:26 +0100
Hi guix, On 2/9/25 21:38, paul wrote: > I'm sending a v3 fixing a bug in the merge algorithm for volumes and > networks. > > On 2/9/25 20:14, paul wrote: >> Hi, >> >> I'm about to send a v2. v2 compared to the first revision features: >> >> >> - it actually compiles all the times :) (rev 1 referenced oci-image >> too early for it to be working and generated a compile time error, if >> you recompiled it sometimes went away so I thought it was a problem >> of my setup. CI caught this) >> - it allows more values to be overridden by eventual users of the >> Scheme API >> - it allows passing extra arguments directly after each podman or >> docker invokation, allowing for example for overriding podman --root >> and similar options. >> >> All of these tests should pass: >> >> guix shell -D guix -CPW -- make check-system TESTS="oci-container >> oci-service-rootless-podman docker docker-system rootless-podman >> oci-service-docker" >> I'm sending a v4 changing slightly the image loader, the same tests as before are supposed to pass. Now the Home service [0] is working for me with rootless podman. I'll try it on different distros if I manage to. Thank you for your work, giacomo [0]: https://github.com/fishinthecalculator/gocix/blob/main/modules/oci/home/services/containers.scm
ludo <at> gnu.org, maxim.cournoyer <at> gmail.com, guix-patches <at> gnu.org:bug#76081; Package guix-patches.
(Wed, 12 Feb 2025 01:11:02 GMT) Full text and rfc822 format available.Message #53 received at 76081 <at> debbugs.gnu.org (full text, mbox):
From: Giacomo Leidi <goodoldpaul <at> autistici.org> To: 76081 <at> debbugs.gnu.org Cc: Giacomo Leidi <goodoldpaul <at> autistici.org> Subject: [PATCH v4 3/4] services: Add oci-service-type. Date: Wed, 12 Feb 2025 02:10:36 +0100
This patch implements a generalization of the
oci-container-service-type, which consequently is made deprecated. The
oci-service-type, in addition to all the features from the
oci-container-service-type, can now provision OCI networks and volumes.
It only handles OCI objects creation, the user is supposed to handle
state once the objects are provsioned.
It currently supports two different OCI runtimes: Docker and rootless
Podman. Both runtimes are tested to make sure provisioned containers
can connect to each other through provisioned networks and can
read/write data with provisioned volumes.
At last the Scheme API is thought to facilitate the implementation of a
Guix Home service in the future.
* gnu/services/containers.scm (%oci-supported-runtimes): New variable;
(oci-runtime-cli): new variable;
(oci-runtime-name): new variable;
(oci-network-configuration): new variable;
(oci-volume-configuration): new variable;
(oci-configuration): new variable;
(oci-extension): new variable;
(oci-networks-shepherd-name): new variable;
(oci-service-type): new variable;
(oci-state->shepherd-services): new variable.
* doc/guix.texi: Document it.
* gnu/tests/containers.scm: Test it.
* gnu/services/docker.scm: Deprecate the oci-container-service-type.
Change-Id: I656b3db85832e42d53072fcbfb91d1226f39ef38
---
doc/guix.texi | 305 +++++++--
gnu/services/containers.scm | 1217 ++++++++++++++++++++++++++++++-----
gnu/services/docker.scm | 37 +-
gnu/tests/containers.scm | 999 +++++++++++++++++++++++++++-
4 files changed, 2313 insertions(+), 245 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index ce780682ed0..500cf9f839c 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -41872,59 +41872,161 @@ Miscellaneous Services
@cindex OCI-backed, Shepherd services
@subsubheading OCI backed services
-Should you wish to manage your Docker containers with the same consistent
-interface you use for your other Shepherd services,
-@var{oci-container-service-type} is the tool to use: given an
-@acronym{Open Container Initiative, OCI} container image, it will run it in a
+Should you wish to manage your @acronym{Open Container Initiative, OCI} containers
+with the same consistent interface you use for your other Shepherd services,
+@var{oci-service-type} is the tool to use: given an
+OCI container image, it will run it in a
Shepherd service. One example where this is useful: it lets you run services
-that are available as Docker/OCI images but not yet packaged for Guix.
+that are available as OCI images but not yet packaged for Guix.
-@defvar oci-container-service-type
+@defvar oci-service-type
-This is a thin wrapper around Docker's CLI that executes OCI images backed
+This is a thin wrapper around Docker's or Podman's CLI that executes OCI images backed
processes as Shepherd Services.
@lisp
-(service oci-container-service-type
- (list
- (oci-container-configuration
- (network "host")
- (image
- (oci-image
- (repository "guile")
- (tag "3")
- (value (specifications->manifest '("guile")))
- (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile"))
- #:max-layers 2))))
- (entrypoint "/bin/guile")
- (command
- '("-c" "(display \"hello!\n\")")))
- (oci-container-configuration
- (image "prom/prometheus")
- (ports
- '(("9000" . "9000")
- ("9090" . "9090"))))
- (oci-container-configuration
- (image "grafana/grafana:10.0.1")
- (network "host")
- (volumes
- '("/var/lib/grafana:/var/lib/grafana")))))
+(simple-service 'oci-provisioning
+ oci-service-type
+ (oci-extension
+ (networks
+ (list
+ (oci-network-configuration (name "monitoring"))))
+ (containers
+ (list
+ (oci-container-configuration
+ (network "monitoring")
+ (image
+ (oci-image
+ (repository "guile")
+ (tag "3")
+ (value (specifications->manifest '("guile")))
+ (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile"))
+ #:max-layers 2))))
+ (entrypoint "/bin/guile")
+ (command
+ '("-c" "(display \"hello!\n\")")))
+ (oci-container-configuration
+ (image "prom/prometheus")
+ (network "host")
+ (ports
+ '(("9000" . "9000")
+ ("9090" . "9090"))))
+ (oci-container-configuration
+ (image "grafana/grafana:10.0.1")
+ (network "host")
+ (volumes
+ '("/var/lib/grafana:/var/lib/grafana")))))))
@end lisp
In this example three different Shepherd services are going to be added to the
system. Each @code{oci-container-configuration} record translates to a
-@code{docker run} invocation and its fields directly map to options. You can
-refer to the
-@url{https://docs.docker.com/engine/reference/commandline/run,upstream}
-documentation for the semantics of each value. If the images are not found,
-they will be
-@url{https://docs.docker.com/engine/reference/commandline/pull/,pulled}. The
+@command{docker run} or @command{podman run} invocation and its fields directly
+map to options. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html,Podman}
+upstream documentation for semantics of each value. If the images are not found,
+they will be pulled. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/pull/,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-pull.1.html,Podman}
+upstream documentation for semantics. The
services with @code{(network "host")} are going to be attached to the
host network and are supposed to behave like native processes with regard to
networking.
@end defvar
+@c %start of fragment
+
+@deftp {Data Type} oci-configuration
+Available @code{oci-configuration} fields are:
+
+@table @asis
+@item @code{runtime} (default: @code{'docker}) (type: symbol)
+The OCI runtime to use to run commands. It can be either @code{'docker} or
+@code{'podman}.
+
+@item @code{runtime-cli} (type: maybe-package)
+The OCI runtime command line to be installed in the system profile and used
+to provision OCI resources. When unset it will default to @code{docker-cli}
+package for the @code{'docker} runtime or to @code{podman} package for the
+@code{'podman} runtime.
+
+@item @code{runtime-extra-arguments} (default: @code{'()}) (type: list)
+A list of strings, gexps or file-like objects that will be placed
+after each @command{docker} or @command{podman} invokation.
+
+@item @code{user} (type: maybe-string)
+The user name under whose authority OCI commands will be run. This field will
+override the @code{user} field of @code{oci-configuration}.
+
+@item @code{group} (type: maybe-string)
+The group name under whose authority OCI commands will be run. When
+using the @code{'podman} OCI runtime, this field will be ignored and the
+default group of the user configured in the @code{user} field will be used.
+This field will override the @code{group} field of @code{oci-configuration}.
+
+@item @code{subuids-range} (type: maybe-subid-range)
+An optional @code{subid-range} record allocating subuids for the user from
+the @code{user} field. When unset, with the rootless Podman OCI runtime, it
+defaults to @code{(subid-range (name "oci-container"))}.
+
+@item @code{subgids-range} (type: maybe-subid-range)
+An optional @code{subid-range} record allocating subgids for the user from
+the @code{user} field. When unset, with the rootless Podman OCI runtime, it
+defaults to @code{(subid-range (name "oci-container"))}.
+
+@item @code{containers} (default: @code{'()}) (type: list-of-oci-containers)
+The list of @code{oci-container-configuration} records representing the
+containers to provision. Most users are supposed not to use this field and use
+the @code{oci-extension} record instead.
+
+@item @code{networks} (default: @code{'()}) (type: list-of-oci-networks)
+The list of @code{oci-network-configuration} records representing the
+containers to provision. Most users are supposed not to use this field and use
+the @code{oci-extension} record instead.
+
+@item @code{volumes} (default: @code{'()}) (type: list-of-oci-volumes)
+The list of @code{oci-volumes-configuration} records representing the
+containers to provision. Most users are supposed not to use this field and use
+the @code{oci-extension} record instead.
+
+@item @code{verbose?} (default: @code{#f}) (type: boolean)
+When true, additional output will be printed, allowing to better follow the
+flow of execution.
+
+@end table
+
+@end deftp
+
+
+@c %end of fragment
+
+@c %start of fragment
+
+@deftp {Data Type} oci-extension
+Available @code{oci-extension} fields are:
+
+@table @asis
+@item @code{containers} (default: @code{'()}) (type: list-of-oci-containers)
+The list of @code{oci-container-configuration} records representing the
+containers to provision.
+
+@item @code{networks} (default: @code{'()}) (type: list-of-oci-networks)
+The list of @code{oci-network-configuration} records representing the
+containers to provision.
+
+@item @code{volumes} (default: @code{'()}) (type: list-of-oci-volumes)
+The list of @code{oci-volumes-configuration} records representing the
+containers to provision.
+
+@end table
+
+@end deftp
+
+
+@c %end of fragment
+
+
@c %start of fragment
@deftp {Data Type} oci-container-configuration
@@ -41944,16 +42046,16 @@ Miscellaneous Services
Overwrite the default entrypoint (@code{ENTRYPOINT}) of the image.
@item @code{host-environment} (default: @code{'()}) (type: list)
-Set environment variables in the host environment where @command{docker
-run} is invoked. This is especially useful to pass secrets from the
-host to the container without having them on the @command{docker run}'s
-command line: by setting the @code{MYSQL_PASSWORD} on the host and by passing
+Set environment variables in the host environment where @command{docker run}
+or @command{podman run} are invoked. This is especially useful to pass secrets
+from the host to the container without having them on the OCI runtime command line,
+for example: by setting the @code{MYSQL_PASSWORD} on the host and by passing
@code{--env MYSQL_PASSWORD} through the @code{extra-arguments} field, it is
possible to securely set values in the container environment. This field's
value can be a list of pairs or strings, even mixed:
@lisp
-(list '("LANGUAGE\" . "eo:ca:eu")
+(list '("LANGUAGE" . "eo:ca:eu")
"JAVA_HOME=/opt/java")
@end lisp
@@ -41961,22 +42063,24 @@ Miscellaneous Services
directly to @code{make-forkexec-constructor}.
@item @code{environment} (default: @code{'()}) (type: list)
-Set environment variables. This can be a list of pairs or strings, even mixed:
+Set environment variables inside the container. This can be a list of pairs
+or strings, even mixed:
@lisp
(list '("LANGUAGE" . "eo:ca:eu")
"JAVA_HOME=/opt/java")
@end lisp
-Pair members can be strings, gexps or file-like objects.
-Strings are passed directly to the Docker CLI. You can refer to the
-@uref{https://docs.docker.com/engine/reference/commandline/run/#env,upstream}
-documentation for semantics.
+Pair members can be strings, gexps or file-like objects. Strings are passed
+directly to the OCI runtime CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#env,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#env-e-env,Podman}
+upstream documentation for semantics.
@item @code{image} (type: string-or-oci-image)
The image used to build the container. It can be a string or an
-@code{oci-image} record. Strings are resolved by the Docker Engine, and
-follow the usual format
+@code{oci-image} record. Strings are resolved by the OCI runtime,
+and follow the usual format
@code{myregistry.local:5000/testing/test-image:tag}.
@item @code{provision} (default: @code{""}) (type: string)
@@ -42004,7 +42108,7 @@ Miscellaneous Services
by the service.
@item @code{network} (default: @code{""}) (type: string)
-Set a Docker network for the spawned container.
+Set an OCI network for the spawned container.
@item @code{ports} (default: @code{'()}) (type: list)
Set the port or port ranges to expose from the spawned container. This can be a
@@ -42015,10 +42119,11 @@ Miscellaneous Services
"10443:443")
@end lisp
-Pair members can be strings, gexps or file-like objects.
-Strings are passed directly to the Docker CLI. You can refer to the
-@uref{https://docs.docker.com/engine/reference/commandline/run/#publish,upstream}
-documentation for semantics.
+Pair members can be strings, gexps or file-like objects. Strings are passed
+directly to the OCI runtime CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#publish,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#publish-p-ip-hostport-containerport-protocol,Podman}
+upstream documentation for semantics.
@item @code{volumes} (default: @code{'()}) (type: list)
Set volume mappings for the spawned container. This can be a
@@ -42029,25 +42134,97 @@ Miscellaneous Services
"/gnu/store:/gnu/store")
@end lisp
-Pair members can be strings, gexps or file-like objects.
-Strings are passed directly to the Docker CLI. You can refer to the
-@uref{https://docs.docker.com/engine/reference/commandline/run/#volume,upstream}
-documentation for semantics.
+Pair members can be strings, gexps or file-like objects. Strings are passed
+directly to the OCI runtime CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#volume,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#volume-v-source-volume-host-dir-container-dir-options,Podman}
+upstream documentation for semantics.
@item @code{container-user} (default: @code{""}) (type: string)
Set the current user inside the spawned container. You can refer to the
-@url{https://docs.docker.com/engine/reference/run/#user,upstream}
-documentation for semantics.
+@url{https://docs.docker.com/engine/reference/run/#user,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#user-u-user-group,Podman}
+upstream documentation for semantics.
@item @code{workdir} (default: @code{""}) (type: string)
Set the current working directory for the spawned Shepherd service.
You can refer to the
-@url{https://docs.docker.com/engine/reference/run/#workdir,upstream}
-documentation for semantics.
+@url{https://docs.docker.com/engine/reference/run/#workdir,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#workdir-w-dir,Podman}
+upstream documentation for semantics.
@item @code{extra-arguments} (default: @code{'()}) (type: list)
-A list of strings, gexps or file-like objects that will be directly
-passed to the @command{docker run} invocation.
+A list of strings, gexps or file-like objects that will be directly passed
+to the @command{docker run} or @command{podman run} invokation.
+
+@end table
+
+@end deftp
+
+
+@c %end of fragment
+
+@c %start of fragment
+
+@deftp {Data Type} oci-network-configuration
+Available @code{oci-network-configuration} fields are:
+
+@table @asis
+@item @code{name} (type: string)
+The name of the OCI network to provision.
+
+@item @code{driver} (type: maybe-string)
+The driver to manage the network.
+
+@item @code{gateway} (type: maybe-string)
+IPv4 or IPv6 gateway for the subnet.
+
+@item @code{internal?} (default: @code{#f}) (type: boolean)
+Restrict external access to the network
+
+@item @code{ip-range} (type: maybe-string)
+Allocate container ip from a sub-range in CIDR format.
+
+@item @code{ipam-driver} (type: maybe-string)
+IP Address Management Driver.
+
+@item @code{ipv6?} (default: @code{#f}) (type: boolean)
+Enable IPv6 networking.
+
+@item @code{subnet} (type: maybe-string)
+Subnet in CIDR format that represents a network segment.
+
+@item @code{labels} (default: @code{'()}) (type: list)
+The list of labels that will be used to tag the current volume.
+
+@item @code{extra-arguments} (default: @code{'()}) (type: list)
+A list of strings, gexps or file-like objects that will be directly passed
+to the @command{docker network create} or @command{podman network create}
+invokation.
+
+@end table
+
+@end deftp
+
+
+@c %end of fragment
+
+@c %start of fragment
+
+@deftp {Data Type} oci-volume-configuration
+Available @code{oci-volume-configuration} fields are:
+
+@table @asis
+@item @code{name} (type: string)
+The name of the OCI volume to provision.
+
+@item @code{labels} (default: @code{'()}) (type: list)
+The list of labels that will be used to tag the current volume.
+
+@item @code{extra-arguments} (default: @code{'()}) (type: list)
+A list of strings, gexps or file-like objects that will be directly passed
+to the @command{docker volume create} or @command{podman volume create}
+invokation.
@end table
diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm
index 50bf6c05549..018dfa60f48 100644
--- a/gnu/services/containers.scm
+++ b/gnu/services/containers.scm
@@ -41,6 +41,7 @@ (define-module (gnu services containers)
#:use-module ((guix scripts pack) #:prefix pack:)
#:use-module (guix store)
#:use-module (srfi srfi-1)
+ #:use-module (ice-9 format)
#:use-module (ice-9 match)
#:export (rootless-podman-configuration
rootless-podman-configuration?
@@ -96,8 +97,73 @@ (define-module (gnu services containers)
oci-container-configuration-workdir
oci-container-configuration-extra-arguments
+ list-of-oci-containers?
+ list-of-oci-networks?
+ list-of-oci-volumes?
+
+ %oci-supported-runtimes
+ oci-sanitize-runtime
+ oci-runtime-system-environment
+ oci-runtime-system-extra-arguments
+ oci-runtime-system-group
+ oci-runtime-system-requirement
+ oci-runtime-cli
+ oci-runtime-system-cli
+ oci-runtime-name
+ oci-runtime-group
+
+ oci-network-configuration
+ oci-network-configuration?
+ oci-network-configuration-fields
+ oci-network-configuration-name
+ oci-network-configuration-driver
+ oci-network-configuration-gateway
+ oci-network-configuration-internal?
+ oci-network-configuration-ip-range
+ oci-network-configuration-ipam-driver
+ oci-network-configuration-ipv6?
+ oci-network-configuration-subnet
+ oci-network-configuration-labels
+ oci-network-configuration-extra-arguments
+
+ oci-volume-configuration
+ oci-volume-configuration?
+ oci-volume-configuration-fields
+ oci-volume-configuration-name
+ oci-volume-configuration-labels
+ oci-volume-configuration-extra-arguments
+
+ oci-configuration
+ oci-configuration?
+ oci-configuration-fields
+ oci-configuration-runtime
+ oci-configuration-runtime-cli
+ oci-configuration-runtime-extra-arguments
+ oci-configuration-user
+ oci-configuration-group
+ oci-configuration-containers
+ oci-configuration-networks
+ oci-configuration-volumes
+ oci-configuration-verbose?
+
+ oci-extension
+ oci-extension?
+ oci-extension-fields
+ oci-extension-containers
+ oci-extension-networks
+ oci-extension-volumes
+
+ oci-networks-shepherd-name
+ oci-volumes-shepherd-name
+
oci-container-shepherd-service
- %oci-container-accounts))
+ oci-objects-merge-lst
+ oci-service-type
+ oci-service-accounts
+ oci-service-profile
+ oci-service-subids
+ oci-state->shepherd-services
+ oci-configuration->shepherd-services))
(define (gexp-or-string? value)
(or (gexp? value)
@@ -294,9 +360,42 @@ (define rootless-podman-service-type
;;;
-;;; OCI container.
+;;; OCI provisioning service.
;;;
+(define %oci-supported-runtimes
+ '(docker podman))
+
+(define (oci-runtime-system-requirement runtime)
+ "Return a list of Shepherd service names required by a given OCI runtime,
+before it is able to run containers."
+ (if (eq? 'podman runtime)
+ '(cgroups2-fs-owner cgroups2-limits
+ rootless-podman-shared-root-fs user-processes)
+ '(dockerd user-processes)))
+
+(define (oci-runtime-name runtime)
+ "Return a human readable name for a given OCI runtime."
+ (if (eq? 'podman runtime)
+ "Podman" "Docker"))
+
+(define (oci-runtime-group runtime maybe-group)
+ "Implement the logic behind selection of the group that is to be used by
+Shepherd to execute OCI commands."
+ (if (maybe-value-set? maybe-group)
+ maybe-group
+ (if (eq? 'podman runtime)
+ "cgroup"
+ "docker")))
+
+(define (oci-sanitize-runtime value)
+ (unless (member value %oci-supported-runtimes)
+ (raise
+ (formatted-message
+ (G_ "OCI runtime must be a symbol and one of ~a,
+but ~a was found") %oci-supported-runtimes value)))
+ value)
+
(define (oci-sanitize-pair pair delimiter)
(define (valid? member)
(or (string? member)
@@ -345,6 +444,11 @@ (define (oci-sanitize-volumes value)
;; '(("/mnt/dir" . "/dir") "/run/current-system/profile:/java")
(oci-sanitize-mixed-list "volumes" value ":"))
+(define (oci-sanitize-labels value)
+ ;; Expected spec format:
+ ;; '(("foo" . "bar") "foo=bar")
+ (oci-sanitize-mixed-list "labels" value "="))
+
(define (oci-sanitize-shepherd-actions value)
(map
(lambda (el)
@@ -372,10 +476,15 @@ (define (oci-sanitize-extra-arguments value)
value))
(define (oci-image-reference image)
- (if (string? image)
- image
- (string-append (oci-image-repository image)
- ":" (oci-image-tag image))))
+ "Return a string OCI image reference representing IMAGE."
+ (define reference
+ (if (string? image)
+ image
+ (string-append (oci-image-repository image)
+ ":" (oci-image-tag image))))
+ (if (> (length (string-split reference #\/)) 1)
+ reference
+ (string-append "localhost/" reference)))
(define (oci-lowerable-image? image)
(or (manifest? image)
@@ -390,7 +499,19 @@ (define (string-or-oci-image? image)
(define list-of-symbols?
(list-of symbol?))
+(define (list-of-oci-records? name predicate value)
+ (map
+ (lambda (el)
+ (if (predicate el)
+ el
+ (raise
+ (formatted-message
+ (G_ "~a contains an illegal value: ~a") name el))))
+ value))
+
(define-maybe/no-serialization string)
+(define-maybe/no-serialization package)
+(define-maybe/no-serialization subid-range)
(define-configuration/no-serialization oci-image
(repository
@@ -435,11 +556,15 @@ (define-configuration/no-serialization oci-image
(define-configuration/no-serialization oci-container-configuration
(user
- (string "oci-container")
- "The user under whose authority docker commands will be run.")
+ (maybe-string)
+ "The user name under whose authority OCI commands will be run. This field will
+override the @code{user} field of @code{oci-configuration}.")
(group
- (string "docker")
- "The group under whose authority docker commands will be run.")
+ (maybe-string)
+ "The group name under whose authority OCI commands will be run. When
+using the @code{'podman} OCI runtime, this field will be ignored and the
+default group of the user configured in the @code{user} field will be used.
+This field will override the @code{group} field of @code{oci-configuration}.")
(command
(list-of-strings '())
"Overwrite the default command (@code{CMD}) of the image.")
@@ -449,9 +574,9 @@ (define-configuration/no-serialization oci-container-configuration
(host-environment
(list '())
"Set environment variables in the host environment where @command{docker run}
-is invoked. This is especially useful to pass secrets from the host to the
-container without having them on the @command{docker run}'s command line: by
-setting the @code{MYSQL_PASSWORD} on the host and by passing
+or @command{podman run} are invoked. This is especially useful to pass secrets
+from the host to the container without having them on the OCI runtime command line,
+for example: by setting the @code{MYSQL_PASSWORD} on the host and by passing
@code{--env MYSQL_PASSWORD} through the @code{extra-arguments} field, it is
possible to securely set values in the container environment. This field's
value can be a list of pairs or strings, even mixed:
@@ -475,15 +600,16 @@ (define-configuration/no-serialization oci-container-configuration
@end lisp
Pair members can be strings, gexps or file-like objects. Strings are passed
-directly to the Docker CLI. You can refer to the
-@url{https://docs.docker.com/engine/reference/commandline/run/#env,upstream}
-documentation for semantics."
+directly to the OCI runtime CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#env,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#env-e-env,Podman}
+upstream documentation for semantics."
(sanitizer oci-sanitize-environment))
(image
(string-or-oci-image)
"The image used to build the container. It can be a string or an
-@code{oci-image} record. Strings are resolved by the Docker
-Engine, and follow the usual format
+@code{oci-image} record. Strings are resolved by the OCI runtime,
+and follow the usual format
@code{myregistry.local:5000/testing/test-image:tag}.")
(provision
(maybe-string)
@@ -512,7 +638,7 @@ (define-configuration/no-serialization oci-container-configuration
(sanitizer oci-sanitize-shepherd-actions))
(network
(maybe-string)
- "Set a Docker network for the spawned container.")
+ "Set an OCI network for the spawned container.")
(ports
(list '())
"Set the port or port ranges to expose from the spawned container. This can
@@ -524,9 +650,10 @@ (define-configuration/no-serialization oci-container-configuration
@end lisp
Pair members can be strings, gexps or file-like objects. Strings are passed
-directly to the Docker CLI. You can refer to the
-@url{https://docs.docker.com/engine/reference/commandline/run/#publish,upstream}
-documentation for semantics."
+directly to the OCI runtime CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#publish,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#publish-p-ip-hostport-containerport-protocol,Podman}
+upstream documentation for semantics."
(sanitizer oci-sanitize-ports))
(volumes
(list '())
@@ -539,71 +666,331 @@ (define-configuration/no-serialization oci-container-configuration
@end lisp
Pair members can be strings, gexps or file-like objects. Strings are passed
-directly to the Docker CLI. You can refer to the
-@url{https://docs.docker.com/engine/reference/commandline/run/#volume,upstream}
-documentation for semantics."
+directly to the OCI runtime CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#volume,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#volume-v-source-volume-host-dir-container-dir-options,Podman}
+upstream documentation for semantics."
(sanitizer oci-sanitize-volumes))
(container-user
(maybe-string)
"Set the current user inside the spawned container. You can refer to the
-@url{https://docs.docker.com/engine/reference/run/#user,upstream}
-documentation for semantics.")
+@url{https://docs.docker.com/engine/reference/run/#user,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#user-u-user-group,Podman}
+upstream documentation for semantics.")
(workdir
(maybe-string)
- "Set the current working for the spawned Shepherd service.
+ "Set the current working directory for the spawned Shepherd service.
You can refer to the
-@url{https://docs.docker.com/engine/reference/run/#workdir,upstream}
-documentation for semantics.")
+@url{https://docs.docker.com/engine/reference/run/#workdir,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#workdir-w-dir,Podman}
+upstream documentation for semantics.")
(extra-arguments
(list '())
"A list of strings, gexps or file-like objects that will be directly passed
-to the @command{docker run} invokation."
+to the @command{docker run} or @command{podman run} invokation."
(sanitizer oci-sanitize-extra-arguments)))
-(define oci-container-configuration->options
- (lambda (config)
- (let ((entrypoint
- (oci-container-configuration-entrypoint config))
- (network
- (oci-container-configuration-network config))
- (user
- (oci-container-configuration-container-user config))
- (workdir
- (oci-container-configuration-workdir config)))
- (apply append
- (filter (compose not unspecified?)
- `(,(if (maybe-value-set? entrypoint)
- `("--entrypoint" ,entrypoint)
- '())
- ,(append-map
- (lambda (spec)
- (list "--env" spec))
- (oci-container-configuration-environment config))
- ,(if (maybe-value-set? network)
- `("--network" ,network)
- '())
- ,(if (maybe-value-set? user)
- `("--user" ,user)
- '())
- ,(if (maybe-value-set? workdir)
- `("--workdir" ,workdir)
- '())
- ,(append-map
- (lambda (spec)
- (list "-p" spec))
- (oci-container-configuration-ports config))
- ,(append-map
- (lambda (spec)
- (list "-v" spec))
- (oci-container-configuration-volumes config))))))))
-
-(define* (get-keyword-value args keyword #:key (default #f))
- (let ((kv (memq keyword args)))
- (if (and kv (>= (length kv) 2))
- (cadr kv)
- default)))
+(define (list-of-oci-containers? value)
+ (list-of-oci-records? "containers" oci-container-configuration? value))
+
+(define-configuration/no-serialization oci-volume-configuration
+ (name
+ (string)
+ "The name of the OCI volume to provision.")
+ (labels
+ (list '())
+ "The list of labels that will be used to tag the current volume."
+ (sanitizer oci-sanitize-labels))
+ (extra-arguments
+ (list '())
+ "A list of strings, gexps or file-like objects that will be directly passed
+to the @command{docker volume create} or @command{podman volume create}
+invokation."
+ (sanitizer oci-sanitize-extra-arguments)))
+
+(define (list-of-oci-volumes? value)
+ (list-of-oci-records? "volumes" oci-volume-configuration? value))
+
+(define-configuration/no-serialization oci-network-configuration
+ (name
+ (string)
+ "The name of the OCI network to provision.")
+ (driver
+ (maybe-string)
+ "The driver to manage the network.")
+ (gateway
+ (maybe-string)
+ "IPv4 or IPv6 gateway for the subnet.")
+ (internal?
+ (boolean #f)
+ "Restrict external access to the network")
+ (ip-range
+ (maybe-string)
+ "Allocate container ip from a sub-range in CIDR format.")
+ (ipam-driver
+ (maybe-string)
+ "IP Address Management Driver.")
+ (ipv6?
+ (boolean #f)
+ "Enable IPv6 networking.")
+ (subnet
+ (maybe-string)
+ "Subnet in CIDR format that represents a network segment.")
+ (labels
+ (list '())
+ "The list of labels that will be used to tag the current volume."
+ (sanitizer oci-sanitize-labels))
+ (extra-arguments
+ (list '())
+ "A list of strings, gexps or file-like objects that will be directly passed
+to the @command{docker network create} or @command{podman network create}
+invokation."
+ (sanitizer oci-sanitize-extra-arguments)))
+
+(define (list-of-oci-networks? value)
+ (list-of-oci-records? "networks" oci-network-configuration? value))
+
+(define-configuration/no-serialization oci-configuration
+ (runtime
+ (symbol 'docker)
+ "The OCI runtime to use to run commands. It can be either @code{'docker} or
+@code{'podman}."
+ (sanitizer oci-sanitize-runtime))
+ (runtime-cli
+ (maybe-package)
+ "The OCI runtime command line to be installed in the system profile and used
+to provision OCI resources. When unset it will default to @code{docker-cli}
+package for the @code{'docker} runtime or to @code{podman} package for the
+@code{'podman} runtime.")
+ (runtime-extra-arguments
+ (list '())
+ "A list of strings, gexps or file-like objects that will be placed
+after each @command{docker} or @command{podman} invokation.")
+ (user
+ (string "oci-container")
+ "The user name under whose authority OCI runtime commands will be run.")
+ (group
+ (maybe-string)
+ "The group name under whose authority OCI commands will be run. When
+using the @code{'podman} OCI runtime, this field will be ignored and the
+default group of the user configured in the @code{user} field will be used.")
+ (subuids-range
+ (maybe-subid-range)
+ "An optional @code{subid-range} record allocating subuids for the user from
+the @code{user} field. When unset, with the rootless Podman OCI runtime, it
+defaults to @code{(subid-range (name \"oci-container\"))}.")
+ (subgids-range
+ (maybe-subid-range)
+ "An optional @code{subid-range} record allocating subgids for the user from
+the @code{user} field. When unset, with the rootless Podman OCI runtime, it
+defaults to @code{(subid-range (name \"oci-container\"))}.")
+ (containers
+ (list-of-oci-containers '())
+ "The list of @code{oci-container-configuration} records representing the
+containers to provision. Most users are supposed not to use this field and use
+the @code{oci-extension} record instead.")
+ (networks
+ (list-of-oci-networks '())
+ "The list of @code{oci-network-configuration} records representing the
+networks to provision. Most users are supposed not to use this field and use
+the @code{oci-extension} record instead.")
+ (volumes
+ (list-of-oci-volumes '())
+ "The list of @code{oci-volume-configuration} records representing the
+volumes to provision. Most users are supposed not to use this field and use
+the @code{oci-extension} record instead.")
+ (verbose?
+ (boolean #f)
+ "When true, additional output will be printed, allowing to better follow the
+flow of execution."))
+
+(define (oci-runtime-system-environment runtime user)
+ (if (eq? runtime 'podman)
+ (list
+ #~(string-append
+ "HOME=" (passwd:dir (getpwnam #$user))))
+ #~()))
+
+(define (oci-runtime-system-group runtime user group)
+ (if (eq? runtime 'podman)
+ #~(group:name
+ (getgrgid
+ (passwd:gid
+ (getpwnam #$user))))
+ group))
+
+(define (oci-runtime-cli runtime runtime-cli path)
+ "Return a gexp that, when lowered, evaluates to the file system path of the OCI
+runtime command requested by the user."
+ (if (string? runtime-cli)
+ ;; It is a user defined absolute path
+ runtime-cli
+ #~(string-append
+ #$(if (maybe-value-set? runtime-cli)
+ runtime-cli
+ path)
+ #$(if (eq? 'podman runtime)
+ "/bin/podman"
+ "/bin/docker"))))
+
+(define* (oci-runtime-system-cli config #:key (path "/run/current-system/profile"))
+ (let ((runtime-cli
+ (oci-configuration-runtime-cli config))
+ (runtime
+ (oci-configuration-runtime config)))
+ (oci-runtime-cli runtime runtime-cli path)))
+
+(define-configuration/no-serialization oci-extension
+ (containers
+ (list-of-oci-containers '())
+ "The list of @code{oci-container-configuration} records representing the
+containers to add.")
+ (networks
+ (list-of-oci-networks '())
+ "The list of @code{oci-network-configuration} records representing the
+networks to add.")
+ (volumes
+ (list-of-oci-volumes '())
+ "The list of @code{oci-volume-configuration} records representing the
+volumes to add."))
+
+(define (oci-image->container-name image)
+ "Infer the name of an OCI backed Shepherd service from its OCI image."
+ (basename
+ (if (string? image)
+ (first (string-split image #\:))
+ (oci-image-repository image))))
+
+(define (oci-object-command-shepherd-action object-name invokation)
+ "Return a Shepherd action printing a given INVOKATION of an OCI command for the
+given OBJECT-NAME."
+ (shepherd-action
+ (name 'command-line)
+ (documentation
+ (format #f "Prints ~a's OCI runtime command line invokation."
+ object-name))
+ (procedure
+ #~(lambda _
+ (format #t "~a~%" #$invokation)))))
+
+(define (oci-container-shepherd-name runtime config)
+ "Return the name of an OCI backed Shepherd service based on CONFIG.
+The name configured in the configuration record is returned when
+CONFIG's name field has a value, otherwise a name is inferred from CONFIG's
+image field."
+ (define name (oci-container-configuration-provision config))
+ (define image (oci-container-configuration-image config))
+
+ (if (maybe-value-set? name)
+ name
+ (string-append (symbol->string runtime) "-"
+ (oci-image->container-name image))))
+
+(define (oci-networks-shepherd-name runtime)
+ "Return the name of the OCI networks provisioning Shepherd service based on
+RUNTIME."
+ (string-append (symbol->string runtime) "-networks"))
+
+(define (oci-volumes-shepherd-name runtime)
+ "Return the name of the OCI volumes provisioning Shepherd service based on
+RUNTIME."
+ (string-append (symbol->string runtime) "-volumes"))
+
+(define (oci-container-configuration->options config)
+ "Map CONFIG, an oci-container-configuration record, to a gexp that, upon
+lowering, will be evaluated to a list of strings containing command line options
+for the OCI runtime run command."
+ (let ((entrypoint
+ (oci-container-configuration-entrypoint config))
+ (network
+ (oci-container-configuration-network config))
+ (user
+ (oci-container-configuration-container-user config))
+ (workdir
+ (oci-container-configuration-workdir config)))
+ (apply append
+ (filter (compose not unspecified?)
+ `(,(if (maybe-value-set? entrypoint)
+ `("--entrypoint" ,entrypoint)
+ '())
+ ,(append-map
+ (lambda (spec)
+ (list "--env" spec))
+ (oci-container-configuration-environment config))
+ ,(if (maybe-value-set? network)
+ `("--network" ,network)
+ '())
+ ,(if (maybe-value-set? user)
+ `("--user" ,user)
+ '())
+ ,(if (maybe-value-set? workdir)
+ `("--workdir" ,workdir)
+ '())
+ ,(append-map
+ (lambda (spec)
+ (list "-p" spec))
+ (oci-container-configuration-ports config))
+ ,(append-map
+ (lambda (spec)
+ (list "-v" spec))
+ (oci-container-configuration-volumes config)))))))
+
+(define (oci-network-configuration->options config)
+ "Map CONFIG, an oci-network-configuration record, to a gexp that, upon
+lowering, will be evaluated to a list of strings containing command line options
+for the OCI runtime network create command."
+ (let ((driver (oci-network-configuration-driver config))
+ (gateway
+ (oci-network-configuration-gateway config))
+ (internal?
+ (oci-network-configuration-internal? config))
+ (ip-range
+ (oci-network-configuration-ip-range config))
+ (ipam-driver
+ (oci-network-configuration-ipam-driver config))
+ (ipv6?
+ (oci-network-configuration-ipv6? config))
+ (subnet
+ (oci-network-configuration-subnet config)))
+ (apply append
+ (filter (compose not unspecified?)
+ `(,(if (maybe-value-set? driver)
+ `("--driver" ,driver)
+ '())
+ ,(if (maybe-value-set? gateway)
+ `("--gateway" ,gateway)
+ '())
+ ,(if internal?
+ `("--internal")
+ '())
+ ,(if (maybe-value-set? ip-range)
+ `("--ip-range" ,ip-range)
+ '())
+ ,(if (maybe-value-set? ipam-driver)
+ `("--ipam-driver" ,ipam-driver)
+ '())
+ ,(if ipv6?
+ `("--ipv6")
+ '())
+ ,(if (maybe-value-set? subnet)
+ `("--subnet" ,subnet)
+ '())
+ ,(append-map
+ (lambda (spec)
+ (list "--label" spec))
+ (oci-network-configuration-labels config)))))))
+
+(define (oci-volume-configuration->options config)
+ "Map CONFIG, an oci-volume-configuration record, to a gexp that, upon
+lowering, will be evaluated to a list of strings containing command line options
+for the OCI runtime volume create command."
+ (append-map
+ (lambda (spec)
+ (list "--label" spec))
+ (oci-volume-configuration-labels config)))
(define (lower-operating-system os target system)
+ "Lower OS, an operating-system record, into a tarball containing an OCI image."
(mlet* %store-monad
((tarball
(lower-object
@@ -612,24 +999,11 @@ (define (lower-operating-system os target system)
#:target target)))
(return tarball)))
-(define (lower-manifest name image target system)
- (define value (oci-image-value image))
- (define options (oci-image-pack-options image))
- (define image-reference
- (oci-image-reference image))
- (define image-tag
- (let* ((extra-options
- (get-keyword-value options #:extra-options))
- (image-tag-option
- (and extra-options
- (get-keyword-value extra-options #:image-tag))))
- (if image-tag-option
- '()
- `(#:extra-options (#:image-tag ,image-reference)))))
-
+(define (lower-manifest name value options image-reference
+ target system grafts?)
+ "Lower VALUE, a manifest record, into a tarball containing an OCI image."
(mlet* %store-monad
- ((_ (set-grafting
- (oci-image-grafts? image)))
+ ((_ (set-grafting grafts?))
(guile (set-guile-for-build (default-guile)))
(profile
(profile-derivation value
@@ -640,14 +1014,11 @@ (define (lower-manifest name image target system)
(tarball (apply pack:docker-image
`(,name ,profile
,@options
- ,@image-tag
#:localstatedir? #t))))
(return tarball)))
-(define (lower-oci-image name image)
- (define value (oci-image-value image))
- (define image-target (oci-image-target image))
- (define image-system (oci-image-system image))
+(define (lower-oci-image-state name value options reference
+ image-target image-system grafts?)
(define target
(if (maybe-value-set? image-target)
image-target
@@ -660,7 +1031,8 @@ (define (lower-oci-image name image)
(run-with-store store
(match value
((? manifest? value)
- (lower-manifest name image target system))
+ (lower-manifest name value options reference
+ target system grafts?))
((? operating-system? value)
(lower-operating-system value target system))
((or (? gexp? value)
@@ -675,113 +1047,622 @@ (define (lower-oci-image name image)
#:target target
#:system system)))
-(define (%oci-image-loader name image tag)
- (let ((docker (file-append docker-cli "/bin/docker"))
- (tarball (lower-oci-image name image)))
+(define (lower-oci-image name image)
+ "Lower IMAGE, a oci-image record, into a tarball containing an OCI image."
+ (lower-oci-image-state
+ name
+ (oci-image-value image)
+ (oci-image-pack-options image)
+ (oci-image-reference image)
+ (oci-image-target image)
+ (oci-image-system image)
+ (oci-image-grafts? image)))
+
+(define (oci-object-exists? runtime runtime-cli object verbose?)
+ #~(lambda* (name #:key (format-string "{{.Name}}"))
+ (use-modules (ice-9 format)
+ (ice-9 match)
+ (ice-9 popen)
+ (ice-9 rdelim)
+ (srfi srfi-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)))
+
+ #$(if (eq? runtime 'podman)
+ #~(let ((command
+ (list #$runtime-cli
+ #$object "exists" name)))
+ (when #$verbose?
+ (format #t "Running~{ ~a~}~%" command))
+ (define exit-code (status:exit-val (apply system* command)))
+ (when #$verbose?
+ (format #t "Exit code: ~a~%" exit-code))
+ (equal? EXIT_SUCCESS exit-code))
+ #~(let ((command
+ (string-append #$runtime-cli
+ " " #$object " ls --format "
+ "\"" format-string "\"")))
+ (when #$verbose?
+ (format #t "Running ~a~%" command))
+ (member name (read-lines (open-input-pipe command)))))))
+
+(define* (oci-image-loader runtime runtime-cli name image tag #:key (verbose? #f))
+ "Return a file-like object that, once lowered, will evaluate to a program able
+to load IMAGE through RUNTIME-CLI and to tag it with TAG afterwards."
+ (let ((tarball (lower-oci-image name image)))
(with-imported-modules '((guix build utils))
- (program-file (format #f "~a-image-loader" name)
+ (program-file
+ (format #f "~a-image-loader" name)
#~(begin
(use-modules (guix build utils)
+ (ice-9 match)
(ice-9 popen)
- (ice-9 rdelim))
-
- (format #t "Loading image for ~a from ~a...~%" #$name #$tarball)
- (define line
- (read-line
- (open-input-pipe
- (string-append #$docker " load -i " #$tarball))))
-
- (unless (or (eof-object? line)
- (string-null? line))
- (format #t "~a~%" line)
- (let ((repository&tag
- (string-drop line
- (string-length
- "Loaded image: "))))
-
- (invoke #$docker "tag" repository&tag #$tag)
- (format #t "Tagged ~a with ~a...~%" #$tarball #$tag))))))))
-
-(define (oci-container-shepherd-service config)
- (define (guess-name name image)
- (if (maybe-value-set? name)
- name
- (string-append "docker-"
- (basename
- (if (string? image)
- (first (string-split image #\:))
- (oci-image-repository image))))))
-
- (let* ((docker (file-append docker-cli "/bin/docker"))
- (actions (oci-container-configuration-shepherd-actions config))
+ (ice-9 rdelim)
+ (srfi srfi-1))
+ (define object-exists?
+ #$(oci-object-exists? runtime runtime-cli "image" verbose?))
+ (define load-command
+ (string-append #$runtime-cli
+ " load -i " #$tarball))
+
+ (if (object-exists? #$tag #:format-string "{{.Repository}}:{{.Tag}}")
+ (format #t "~a image already exists, skipping.~%" #$tag)
+ (begin
+ (format #t "Loading image for ~a from ~a...~%" #$name #$tarball)
+ (when #$verbose?
+ (format #t "Running ~a~%" load-command))
+ (let ((line (read-line
+ (open-input-pipe load-command))))
+ (unless (or (eof-object? line)
+ (string-null? line))
+ (format #t "~a~%" line)
+ (let* ((repository&tag
+ (string-drop line
+ (string-length
+ "Loaded image: ")))
+ (tag-command
+ (list #$runtime-cli "tag" repository&tag #$tag))
+ (drop-old-tag-command
+ (list #$runtime-cli "image" "rm" "-f" repository&tag)))
+
+ (unless (string=? repository&tag #$tag)
+ (when #$verbose?
+ (format #t "Running~{ ~a~}~%" tag-command))
+
+ (let ((exit-code
+ (status:exit-val (apply system* tag-command))))
+ (format #t "Tagged ~a with ~a...~%" #$tarball #$tag)
+
+ (when #$verbose?
+ (format #t "Exit code: ~a~%" exit-code))
+
+ (when (equal? EXIT_SUCCESS exit-code)
+ (when #$verbose?
+ (format #t "Running~{ ~a~}~%" drop-old-tag-command))
+ (let ((drop-exit-code
+ (status:exit-val (apply system* drop-old-tag-command))))
+ (when #$verbose?
+ (format #t "Exit code: ~a~%" drop-exit-code))))))))))))))))
+
+(define (oci-container-run-invokation runtime-cli name command image-reference
+ options runtime-extra-arguments run-extra-arguments)
+ "Return a list representing the OCI runtime
+invokation for running containers."
+ ;; run [OPTIONS] IMAGE [COMMAND] [ARG...]
+ `(,runtime-cli ,@runtime-extra-arguments "run"
+ "--rm" "--name" ,name
+ ,@options ,@run-extra-arguments
+ ,image-reference ,@command))
+
+(define* (oci-container-entrypoint runtime runtime-cli name image image-reference
+ invokation #:key (verbose? #f))
+ "Return a file-like object that, once lowered, will evaluate to the entrypoint
+for the Shepherd service that will run IMAGE through RUNTIME-CLI."
+ (program-file
+ (string-append "oci-entrypoint-" name)
+ #~(begin
+ (use-modules (ice-9 format)
+ (srfi srfi-1))
+ (when #$verbose?
+ (format #t "Running in verbose mode...~%"))
+ (define invokation (list #$@invokation))
+ #$@(if (oci-image? image)
+ #~((system*
+ #$(oci-image-loader
+ runtime runtime-cli name image
+ image-reference #:verbose? verbose?)))
+ #~())
+ (when #$verbose?
+ (format #t "Running~{ ~a~}~%" invokation))
+ (apply execlp `(,(first invokation) ,@invokation)))))
+
+(define* (oci-container-shepherd-service runtime runtime-cli config
+ #:key
+ (runtime-environment #~())
+ (runtime-extra-arguments '())
+ (oci-requirement '())
+ (user #f)
+ (group #f)
+ (verbose? #f))
+ "Return a Shepherd service object that will run the OCI container represented
+by CONFIG through RUNTIME-CLI."
+ (let* ((actions (oci-container-configuration-shepherd-actions config))
(auto-start?
(oci-container-configuration-auto-start? config))
- (user (oci-container-configuration-user config))
- (group (oci-container-configuration-group config))
+ (maybe-user (oci-container-configuration-user config))
+ (maybe-group (oci-container-configuration-group config))
+ (user (if (maybe-value-set? maybe-user)
+ maybe-user
+ user))
+ (group (if (maybe-value-set? maybe-group)
+ maybe-group
+ group))
(host-environment
(oci-container-configuration-host-environment config))
(command (oci-container-configuration-command config))
(log-file (oci-container-configuration-log-file config))
- (provision (oci-container-configuration-provision config))
(requirement (oci-container-configuration-requirement config))
(respawn?
(oci-container-configuration-respawn? config))
(image (oci-container-configuration-image config))
(image-reference (oci-image-reference image))
(options (oci-container-configuration->options config))
- (name (guess-name provision image))
+ (name
+ (oci-container-shepherd-name runtime config))
(extra-arguments
- (oci-container-configuration-extra-arguments config)))
+ (oci-container-configuration-extra-arguments config))
+ (invokation
+ (oci-container-run-invokation
+ runtime-cli name command image-reference
+ options runtime-extra-arguments extra-arguments)))
(shepherd-service (provision `(,(string->symbol name)))
- (requirement `(dockerd user-processes ,@requirement))
+ (requirement `(,@oci-requirement
+ ,@requirement))
(respawn? respawn?)
(auto-start? auto-start?)
(documentation
(string-append
- "Docker backed Shepherd service for "
+ (oci-runtime-name runtime) " backed Shepherd service for "
(if (oci-image? image) name image) "."))
(start
#~(lambda ()
- #$@(if (oci-image? image)
- #~((invoke #$(%oci-image-loader
- name image image-reference)))
- #~())
(fork+exec-command
- ;; docker run [OPTIONS] IMAGE [COMMAND] [ARG...]
- (list #$docker "run" "--rm" "--name" #$name
- #$@options #$@extra-arguments
- #$image-reference #$@command)
- #:user #$user
- #:group #$group
+ (list
+ #$(oci-container-entrypoint
+ runtime runtime-cli name image image-reference
+ invokation #:verbose? verbose?))
+ #$@(if user (list #:user user) '())
+ #$@(if group (list #:group group) '())
#$@(if (maybe-value-set? log-file)
(list #:log-file log-file)
'())
+ #$@(if (and user (eq? runtime 'podman))
+ (list #:directory
+ #~(passwd:dir (getpwnam #$user)))
+ '())
#:environment-variables
- (list #$@host-environment))))
+ (append
+ (list #$@host-environment)
+ (list #$@runtime-environment)))))
(stop
#~(lambda _
- (invoke #$docker "rm" "-f" #$name)))
+ (invoke #$runtime-cli "rm" "-f" #$name)))
(actions
- (if (oci-image? image)
- '()
- (append
+ (append
+ (list
+ (oci-object-command-shepherd-action
+ name #~(string-join (list #$@invokation) " ")))
+ (if (oci-image? image)
+ '()
(list
- (shepherd-action
- (name 'pull)
- (documentation
- (format #f "Pull ~a's image (~a)."
- name image))
- (procedure
- #~(lambda _
- (invoke #$docker "pull" #$image)))))
- actions))))))
-
-(define %oci-container-accounts
+ (let ((service-name name))
+ (shepherd-action
+ (name 'pull)
+ (documentation
+ (format #f "Pull ~a's image (~a)."
+ service-name image))
+ (procedure
+ #~(lambda _
+ (invoke #$runtime-cli "pull" #$image)))))))
+ actions)))))
+
+(define (oci-object-create-invokation object runtime-cli name options
+ runtime-extra-arguments
+ create-extra-arguments)
+ "Return a gexp that, upon lowering, will evaluate to the OCI runtime
+invokation for creating networks and volumes."
+ ;; network|volume create [options] [NAME]
+ #~(list #$runtime-cli #$@runtime-extra-arguments #$object "create"
+ #$@options #$@create-extra-arguments #$name))
+
+(define (format-oci-invokations invokations)
+ "Return a gexp that, upon lowering, will evaluate to a formatted message
+containing the INVOKATIONS that the OCI runtime will execute to provision
+networks or volumes."
+ #~(string-join (map (lambda (i) (string-join i " "))
+ (list #$@invokations))
+ "\n"))
+
+(define* (oci-object-create-script object runtime runtime-cli invokations
+ #:key (verbose? #f))
+ "Return a file-like object that, once lowered, will evaluate to a program able
+to create OCI networks and volumes through RUNTIME-CLI."
+ (define runtime-string (symbol->string runtime))
+ (program-file
+ (string-append runtime-string "-" object "s-create.scm")
+ #~(begin
+ (use-modules (ice-9 format)
+ (ice-9 match)
+ (ice-9 popen)
+ (ice-9 rdelim)
+ (srfi srfi-1))
+
+ (define object-exists?
+ #$(oci-object-exists? runtime runtime-cli object verbose?))
+
+ (for-each
+ (lambda (invokation)
+ (define name (last invokation))
+ (if (object-exists? name)
+ (format #t "~a ~a ~a already exists, skipping creation.~%"
+ #$(oci-runtime-name runtime) name #$object)
+ (begin
+ (when #$verbose?
+ (format #t "Running~{ ~a~}~%" invokation))
+ (let ((exit-code (status:exit-val (apply system* invokation))))
+ (when #$verbose?
+ (format #t "Exit code: ~a~%" exit-code))))))
+ (list #$@invokations)))))
+
+(define* (oci-object-shepherd-service object runtime runtime-cli name requirement invokations
+ #:key
+ (runtime-environment #~())
+ (user #f)
+ (group #f)
+ (verbose? #f))
+ "Return a Shepherd service object that will create the OBJECTs represented
+by INVOKATIONS through RUNTIME-CLI."
+ (shepherd-service (provision `(,(string->symbol name)))
+ (requirement requirement)
+ (one-shot? #t)
+ (documentation
+ (string-append
+ (oci-runtime-name runtime) " " object
+ " provisioning service"))
+ (start
+ #~(lambda _
+ (fork+exec-command
+ (list
+ #$(oci-object-create-script
+ object runtime runtime-cli
+ invokations
+ #:verbose? verbose?))
+ #$@(if user (list #:user user) '())
+ #$@(if group (list #:group group) '())
+ #:environment-variables
+ (list #$@runtime-environment))))
+ (actions
+ (list
+ (oci-object-command-shepherd-action
+ name (format-oci-invokations invokations))))))
+
+(define* (oci-networks-shepherd-service runtime runtime-cli name networks
+ #:key (user #f) (group #f) (verbose? #f)
+ (runtime-extra-arguments '())
+ (runtime-environment #~())
+ (runtime-requirement '()))
+ "Return a Shepherd service object that will create the networks represented
+in CONFIG."
+ (let ((invokations
+ (map
+ (lambda (network)
+ (oci-object-create-invokation
+ "network" runtime-cli
+ (oci-network-configuration-name network)
+ (oci-network-configuration->options network)
+ runtime-extra-arguments
+ (oci-network-configuration-extra-arguments network)))
+ networks)))
+
+ (oci-object-shepherd-service
+ "network" runtime runtime-cli name
+ runtime-requirement invokations
+ #:user user #:group group #:runtime-environment runtime-environment
+ #:verbose? verbose?)))
+
+(define* (oci-volumes-shepherd-service runtime runtime-cli name volumes
+ #:key (user #f) (group #f) (verbose? #f)
+ (runtime-extra-arguments '())
+ (runtime-environment #~())
+ (runtime-requirement '()))
+ "Return a Shepherd service object that will create the volumes represented
+in CONFIG."
+ (let ((invokations
+ (map
+ (lambda (volume)
+ (oci-object-create-invokation
+ "volume" runtime-cli
+ (oci-volume-configuration-name volume)
+ (oci-volume-configuration->options volume)
+ runtime-extra-arguments
+ (oci-volume-configuration-extra-arguments volume)))
+ volumes)))
+
+ (oci-object-shepherd-service
+ "volume" runtime runtime-cli name runtime-requirement invokations
+ #:user user #:group group #:runtime-environment runtime-environment
+ #:verbose? verbose?)))
+
+(define (oci-service-accounts config)
+ (define user (oci-configuration-user config))
+ (define maybe-group (oci-configuration-group config))
+ (define runtime (oci-configuration-runtime config))
(list (user-account
- (name "oci-container")
+ (name user)
(comment "OCI services account")
- (group "docker")
- (system? #t)
- (home-directory "/var/empty")
+ (group "users")
+ (supplementary-groups
+ (list (oci-runtime-group runtime maybe-group)))
+ (system? (eq? 'docker runtime))
+ (home-directory (if (eq? 'podman runtime)
+ (string-append "/home/" user)
+ "/var/empty"))
+ (create-home-directory? (eq? 'podman runtime))
(shell (file-append shadow "/sbin/nologin")))))
+
+(define* (oci-state->shepherd-services runtime runtime-cli containers networks volumes
+ #:key (user #f) (group #f) (verbose? #f)
+ (networks-name #f) (volumes-name #f)
+ (runtime-extra-arguments '())
+ (runtime-environment #~())
+ (runtime-requirement '())
+ (containers-requirement '())
+ (networks-requirement '())
+ (volumes-requirement '()))
+ (let* ((networks?
+ (> (length networks) 0))
+ (networks-service
+ (if networks?
+ (list
+ (string->symbol
+ (oci-networks-shepherd-name runtime)))
+ '()))
+ (volumes?
+ (> (length volumes) 0))
+ (volumes-service
+ (if volumes?
+ (list
+ (string->symbol
+ (oci-volumes-shepherd-name runtime)))
+ '())))
+ (append
+ (map
+ (lambda (c)
+ (oci-container-shepherd-service
+ runtime runtime-cli c
+ #:user user
+ #:group group
+ #:runtime-environment runtime-environment
+ #:runtime-extra-arguments runtime-extra-arguments
+ #:oci-requirement
+ (append containers-requirement
+ runtime-requirement
+ networks-service
+ volumes-service)
+ #:verbose? verbose?))
+ containers)
+ (if networks?
+ (list
+ (oci-networks-shepherd-service
+ runtime runtime-cli
+ (if (string? networks-name)
+ networks-name
+ (oci-networks-shepherd-name runtime))
+ networks
+ #:user user #:group group
+ #:runtime-extra-arguments runtime-extra-arguments
+ #:runtime-environment runtime-environment
+ #:runtime-requirement (append networks-requirement
+ runtime-requirement)
+ #:verbose? verbose?))
+ '())
+ (if volumes?
+ (list
+ (oci-volumes-shepherd-service
+ runtime runtime-cli
+ (if (string? volumes-name)
+ volumes-name
+ (oci-volumes-shepherd-name runtime))
+ volumes
+ #:user user #:group group
+ #:runtime-extra-arguments runtime-extra-arguments
+ #:runtime-environment runtime-environment
+ #:runtime-requirement (append runtime-requirement
+ volumes-requirement)
+ #:verbose? verbose?))
+ '()))))
+
+(define (oci-configuration->shepherd-services config)
+ (let* ((runtime (oci-configuration-runtime config))
+ (runtime-cli
+ (oci-runtime-system-cli config))
+ (runtime-extra-arguments
+ (oci-configuration-runtime-extra-arguments config))
+ (containers (oci-configuration-containers config))
+ (networks (oci-configuration-networks config))
+ (volumes (oci-configuration-volumes config))
+ (user (oci-configuration-user config))
+ (group (oci-runtime-group
+ runtime (oci-configuration-group config)))
+ (verbose? (oci-configuration-verbose? config)))
+ (oci-state->shepherd-services runtime runtime-cli containers networks volumes
+ #:user user
+ #:group
+ (oci-runtime-system-group runtime user group)
+ #:verbose? verbose?
+ #:runtime-extra-arguments
+ runtime-extra-arguments
+ #:runtime-environment
+ (oci-runtime-system-environment runtime user)
+ #:runtime-requirement
+ (oci-runtime-system-requirement runtime)
+ #:networks-requirement '(networking))))
+
+(define (oci-service-subids config)
+ "Return a subids-extension record representing subuids and subgids required by
+the rootless Podman backend."
+ (define (delete-duplicate-ranges ranges)
+ (delete-duplicates ranges
+ (lambda args
+ (apply string=? (map subid-range-name ranges)))))
+ (define runtime
+ (oci-configuration-runtime config))
+ (define user
+ (oci-configuration-user config))
+ (define subgids (oci-configuration-subgids-range config))
+ (define subuids (oci-configuration-subuids-range config))
+ (define container-users
+ (filter (lambda (range)
+ (and (maybe-value-set?
+ (subid-range-name range))
+ (not (string=? (subid-range-name range) user))))
+ (map (lambda (container)
+ (subid-range
+ (name
+ (oci-container-configuration-user container))))
+ (oci-configuration-containers config))))
+ (define subgid-ranges
+ (delete-duplicate-ranges
+ (cons
+ (if (maybe-value-set? subgids)
+ subgids
+ (subid-range (name user)))
+ container-users)))
+ (define subuid-ranges
+ (delete-duplicate-ranges
+ (cons
+ (if (maybe-value-set? subuids)
+ subuids
+ (subid-range (name user)))
+ container-users)))
+
+ (if (eq? 'podman runtime)
+ (subids-extension
+ (subgids
+ subgid-ranges)
+ (subuids
+ subuid-ranges))
+ (subids-extension)))
+
+(define (oci-objects-merge-lst a b object get-name)
+ (define (contains? value lst)
+ (member value (map get-name lst)))
+ (let loop ((merged '())
+ (lst (append a b)))
+ (if (null? lst)
+ merged
+ (loop
+ (let ((element (car lst)))
+ (when (contains? element merged)
+ (raise
+ (formatted-message
+ (G_ "Duplicated ~a: ~a. ~as names should be unique, please
+remove the duplicate.") object (get-name element) object)))
+ (cons element merged))
+ (cdr lst)))))
+
+(define (oci-extension-merge a b)
+ (oci-extension
+ (containers (oci-objects-merge-lst
+ (oci-extension-containers a)
+ (oci-extension-containers b)
+ "container"
+ (lambda (config)
+ (define maybe-name (oci-container-configuration-provision config))
+ (if (maybe-value-set? maybe-name)
+ maybe-name
+ (oci-image->container-name
+ (oci-container-configuration-image config))))))
+ (networks (oci-objects-merge-lst
+ (oci-extension-networks a)
+ (oci-extension-networks b)
+ "network"
+ oci-network-configuration-name))
+ (volumes (oci-objects-merge-lst
+ (oci-extension-volumes a)
+ (oci-extension-volumes b)
+ "volume"
+ oci-volume-configuration-name))))
+
+(define (oci-service-profile runtime runtime-cli)
+ (list bash-minimal
+ (cond
+ ((maybe-value-set? runtime-cli)
+ runtime-cli)
+ ((eq? 'podman runtime)
+ podman)
+ (else
+ docker-cli))))
+
+(define oci-service-type
+ (service-type (name 'oci)
+ (extensions
+ (list
+ (service-extension profile-service-type
+ (lambda (config)
+ (let ((runtime-cli
+ (oci-configuration-runtime-cli config))
+ (runtime
+ (oci-configuration-runtime config)))
+ (oci-service-profile runtime runtime-cli))))
+ (service-extension subids-service-type
+ oci-service-subids)
+ (service-extension account-service-type
+ oci-service-accounts)
+ (service-extension shepherd-root-service-type
+ oci-configuration->shepherd-services)))
+ ;; Concatenate OCI object lists.
+ (compose (lambda (args)
+ (fold oci-extension-merge
+ (oci-extension)
+ args)))
+ (extend
+ (lambda (config extension)
+ (oci-configuration
+ (inherit config)
+ (containers
+ (oci-objects-merge-lst
+ (oci-configuration-containers config)
+ (oci-extension-containers extension)
+ "container"
+ (lambda (oci-config)
+ (define runtime
+ (oci-configuration-runtime config))
+ (oci-container-shepherd-name runtime oci-config))))
+ (networks (oci-objects-merge-lst
+ (oci-configuration-networks config)
+ (oci-extension-networks extension)
+ "network"
+ oci-network-configuration-name))
+ (volumes (oci-objects-merge-lst
+ (oci-configuration-volumes config)
+ (oci-extension-volumes extension)
+ "volume"
+ oci-volume-configuration-name)))))
+ (default-value (oci-configuration))
+ (description
+ "This service implements the provisioning of OCI object such
+as containers, networks and volumes.")))
diff --git a/gnu/services/docker.scm b/gnu/services/docker.scm
index 69ff9f1d9e4..98ee175873d 100644
--- a/gnu/services/docker.scm
+++ b/gnu/services/docker.scm
@@ -31,7 +31,10 @@ (define-module (gnu services docker)
#:use-module (gnu system shadow)
#:use-module (gnu packages docker)
#:use-module (gnu packages linux) ;singularity
+ #:use-module (guix deprecation)
+ #:use-module (guix diagnostics)
#:use-module (guix gexp)
+ #:use-module (guix i18n)
#:use-module (guix records)
#:use-module (srfi srfi-1)
#:use-module (ice-9 format)
@@ -67,16 +70,18 @@ (define-module (gnu services docker)
oci-container-configuration-volumes
oci-container-configuration-container-user
oci-container-configuration-workdir
- oci-container-configuration-extra-arguments
- oci-container-shepherd-service
- %oci-container-accounts)
+ oci-container-configuration-extra-arguments)
#:export (containerd-configuration
containerd-service-type
docker-configuration
docker-service-type
singularity-service-type
- oci-container-service-type))
+ ;; for backwards compatibility, until the
+ ;; oci-container-service-type is fully deprecated
+ oci-container-shepherd-service
+ oci-container-service-type
+ %oci-container-accounts))
(define-maybe file-like)
@@ -295,17 +300,25 @@ (define singularity-service-type
;;; OCI container.
;;;
-(define (configs->shepherd-services configs)
- (map oci-container-shepherd-service configs))
+;; for backwards compatibility, until the
+;; oci-container-service-type is fully deprecated
+(define-deprecated (oci-container-shepherd-service config)
+ oci-service-type
+ ((@ (gnu services containers) oci-container-shepherd-service)
+ 'docker config))
+(define %oci-container-accounts
+ (filter user-account? (oci-service-accounts (oci-configuration))))
(define oci-container-service-type
(service-type (name 'oci-container)
- (extensions (list (service-extension profile-service-type
- (lambda _ (list docker-cli)))
- (service-extension account-service-type
- (const %oci-container-accounts))
- (service-extension shepherd-root-service-type
- configs->shepherd-services)))
+ (extensions
+ (list (service-extension oci-service-type
+ (lambda (containers)
+ (warning
+ (G_
+ "'oci-container-service-type' is deprecated, use 'oci-service-type' instead~%"))
+ (oci-extension
+ (containers containers))))))
(default-value '())
(extend append)
(compose concatenate)
diff --git a/gnu/tests/containers.scm b/gnu/tests/containers.scm
index 0ecc8ddb126..bac1f47bd34 100644
--- a/gnu/tests/containers.scm
+++ b/gnu/tests/containers.scm
@@ -27,6 +27,9 @@ (define-module (gnu tests containers)
#:use-module (gnu services)
#:use-module (gnu services containers)
#:use-module (gnu services desktop)
+ #:use-module ((gnu services docker)
+ #:select (containerd-service-type
+ docker-service-type))
#:use-module (gnu services dbus)
#:use-module (gnu services networking)
#:use-module (gnu system)
@@ -39,7 +42,9 @@ (define-module (gnu tests containers)
#:use-module (guix profiles)
#:use-module ((guix scripts pack) #:prefix pack:)
#:use-module (guix store)
- #:export (%test-rootless-podman))
+ #:export (%test-rootless-podman
+ %test-oci-service-rootless-podman
+ %test-oci-service-docker))
(define %rootless-podman-os
@@ -345,3 +350,995 @@ (define %test-rootless-podman
(name "rootless-podman")
(description "Test rootless Podman service.")
(value (build-tarball&run-rootless-podman-test))))
+
+
+(define %oci-rootless-podman-os
+ (simple-operating-system
+ (service dhcp-client-service-type)
+ (service dbus-root-service-type)
+ (service polkit-service-type)
+ (service elogind-service-type)
+ (service iptables-service-type)
+ (service rootless-podman-service-type)
+ (extra-special-file "/shared.txt"
+ (plain-file "shared.txt" "hello"))
+ (service oci-service-type
+ (oci-configuration
+ (runtime 'podman)
+ (verbose? #t)))
+ (simple-service 'oci-provisioning
+ oci-service-type
+ (oci-extension
+ (networks
+ (list (oci-network-configuration (name "my-network"))))
+ (volumes
+ (list (oci-volume-configuration (name "my-volume"))))
+ (containers
+ (list
+ (oci-container-configuration
+ (provision "first")
+ (image
+ (oci-image
+ (repository "guile")
+ (value
+ (specifications->manifest '("guile")))
+ (pack-options
+ '(#:symlinks (("/bin" -> "bin"))))))
+ (entrypoint "/bin/guile")
+ (network "my-network")
+ (command
+ '("-c" "(use-modules (web server))
+(define (handler request request-body)
+ (values '((content-type . (text/plain))) \"out of office\"))
+(run-server handler 'http `(#:addr ,(inet-pton AF_INET \"0.0.0.0\")))"))
+ (host-environment
+ '(("VARIABLE" . "value")))
+ (volumes
+ '(("my-volume" . "/my-volume")))
+ (extra-arguments
+ '("--env" "VARIABLE")))
+ (oci-container-configuration
+ (provision "second")
+ (image
+ (oci-image
+ (repository "guile")
+ (value
+ (specifications->manifest '("guile")))
+ (pack-options
+ '(#:symlinks (("/bin" -> "bin"))))))
+ (entrypoint "/bin/guile")
+ (network "my-network")
+ (command
+ '("-c" "(let l ((c 300))(display c)(sleep 1)(when(positive? c)(l (- c 1))))"))
+ (volumes
+ '(("my-volume" . "/my-volume")
+ ("/shared.txt" . "/shared.txt:ro"))))))))))
+
+(define (run-rootless-podman-oci-service-test)
+ (define os
+ (marionette-operating-system
+ (operating-system-with-gc-roots
+ %oci-rootless-podman-os
+ (list))
+ #: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))
+ #~(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-oci-service")
+
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (wait-for-service 'user-processes))
+ marionette)
+
+ (test-assert "rootless-podman services started successfully"
+ (begin
+ (define (run-test)
+ (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))
+ ;; Allow services to come up on slower machines
+ (let loop ((attempts 0))
+ (if (= attempts 60)
+ (error "Services didn't come up after more than 60 seconds")
+ (if (equal? '("cgroup" "cgroup")
+ (run-test))
+ #t
+ (begin
+ (sleep 1)
+ (format #t "Services didn't come up yet, retrying with attempt ~a~%"
+ (+ 1 attempts))
+ (loop (+ 1 attempts))))))))
+
+ (test-assert "podman-volumes running"
+ (begin
+ (define (run-test)
+ (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 6))
+ (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 "oci-container")))
+ (setuid (passwd:uid (getpw "oci-container")))
+
+ (let ((response (slurp
+ "/run/current-system/profile/bin/podman"
+ "volume" "ls" "-n" "--format" "\"{{.Name}}\""
+ "|" "tr" "' '" "'\n'")))
+
+ (call-with-output-file (string-append ,out-dir "/response")
+ (lambda (port)
+ (display (string-join response "\n") port)))))
+ (lambda ()
+ (primitive-exit 127))))
+ (pid
+ (cdr (waitpid pid))))
+
+ (wait-for-file (string-append ,out-dir "/response"))
+
+ (stable-sort
+ (slurp "cat" (string-append ,out-dir "/response"))
+ string<=?))
+ marionette))
+ ;; Allow services to come up on slower machines
+ (let loop ((attempts 0))
+ (if (= attempts 80)
+ (error "Service didn't come up after more than 80 seconds")
+ (if (equal? '("my-volume")
+ (run-test))
+ #t
+ (begin
+ (sleep 1)
+ (loop (+ 1 attempts))))))))
+
+ (test-assert "podman-networks running"
+ (begin
+ (define (run-test)
+ (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 6))
+ (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 "oci-container")))
+ (setuid (passwd:uid (getpw "oci-container")))
+
+ (let ((response (slurp
+ "/run/current-system/profile/bin/podman"
+ "network" "ls" "-n" "--format" "\"{{.Name}}\""
+ "|" "tr" "' '" "'\n'")))
+
+ (call-with-output-file (string-append ,out-dir "/response")
+ (lambda (port)
+ (display (string-join response "\n") port)))))
+ (lambda ()
+ (primitive-exit 127))))
+ (pid
+ (cdr (waitpid pid))))
+
+ (wait-for-file (string-append ,out-dir "/response"))
+
+ (stable-sort
+ (slurp "cat" (string-append ,out-dir "/response"))
+ string<=?))
+ marionette))
+ ;; Allow services to come up on slower machines
+ (let loop ((attempts 0))
+ (if (= attempts 80)
+ (error "Service didn't come up after more than 80 seconds")
+ (if (equal? '("my-network" "podman")
+ (run-test))
+ #t
+ (begin
+ (sleep 1)
+ (loop (+ 1 attempts))))))))
+
+ (test-assert "first container running"
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (wait-for-service 'first #:timeout 120)
+ #t)
+ marionette))
+
+ (test-assert "second container running"
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (wait-for-service 'second #:timeout 120)
+ #t)
+ marionette))
+
+ (test-assert "passing host environment variables"
+ (begin
+ (define (run-test)
+ (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 "oci-container")))
+ (setuid (passwd:uid (getpw "oci-container")))
+
+ (let ((response (slurp
+ "/run/current-system/profile/bin/podman"
+ "exec" "first"
+ "/bin/guile" "-c" "'(display (getenv \"VARIABLE\"))'")))
+ (call-with-output-file (string-append ,out-dir "/response")
+ (lambda (port)
+ (display (string-join response "\n") port)))))
+ (lambda ()
+ (primitive-exit 127))))
+ (pid
+ (cdr (waitpid pid))))
+
+ (wait-for-file (string-append ,out-dir "/response"))
+ (slurp "cat" (string-append ,out-dir "/response")))
+ marionette))
+ ;; Allow image to be loaded on slower machines
+ (let loop ((attempts 0))
+ (if (= attempts 180)
+ (error "Service didn't come up after more than 180 seconds")
+ (if (equal? (list "value")
+ (run-test))
+ #t
+ (begin
+ (sleep 1)
+ (loop (+ 1 attempts))))))))
+
+ (test-equal "mounting host files"
+ '("hello")
+ (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 "oci-container")))
+ (setuid (passwd:uid (getpw "oci-container")))
+
+ (let ((response (slurp
+ "/run/current-system/profile/bin/podman"
+ "exec" "second"
+ "/bin/guile" "-c" "'(begin (use-modules (ice-9 popen) (ice-9 rdelim))
+(display (call-with-input-file \"/shared.txt\" read-line)))'")))
+ (call-with-output-file (string-append ,out-dir "/response")
+ (lambda (port)
+ (display (string-join response " ") port)))))
+ (lambda ()
+ (primitive-exit 127))))
+ (pid
+ (cdr (waitpid pid))))
+
+ (wait-for-file (string-append ,out-dir "/response"))
+ (slurp "cat" (string-append ,out-dir "/response")))
+ marionette))
+
+ (test-equal "write to volumes"
+ '("world")
+ (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 "oci-container")))
+ (setuid (passwd:uid (getpw "oci-container")))
+
+ (slurp
+ "/run/current-system/profile/bin/podman"
+ "exec" "first"
+ "/bin/guile" "-c" "'(begin (use-modules (ice-9 popen) (ice-9 rdelim))
+(call-with-output-file \"/my-volume/out.txt\" (lambda (p) (display \"world\" p))))'")
+
+ (let ((response (slurp
+ "/run/current-system/profile/bin/podman"
+ "exec" "second"
+ "/bin/guile" "-c" "'(begin (use-modules (ice-9 popen) (ice-9 rdelim))
+(display (call-with-input-file \"/my-volume/out.txt\" read-line)))'")))
+ (call-with-output-file (string-append ,out-dir "/response")
+ (lambda (port)
+ (display (string-join response " ") port)))))
+ (lambda ()
+ (primitive-exit 127))))
+ (pid
+ (cdr (waitpid pid))))
+
+ (wait-for-file (string-append ,out-dir "/response"))
+ (slurp "cat" (string-append ,out-dir "/response")))
+ marionette))
+
+ (test-equal "can read ports over network"
+ '("out of office")
+ (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 "oci-container")))
+ (setuid (passwd:uid (getpw "oci-container")))
+
+ (let ((response (slurp
+ "/run/current-system/profile/bin/podman"
+ "exec" "second"
+ "/bin/guile" "-c" "'(begin (use-modules (web client))
+(define-values (response out)
+ (http-get \"http://first:8080\"))
+(display out))'")))
+ (call-with-output-file (string-append ,out-dir "/response")
+ (lambda (port)
+ (display (string-join response " ") port)))))
+ (lambda ()
+ (primitive-exit 127))))
+ (pid
+ (cdr (waitpid pid))))
+
+ (wait-for-file (string-append ,out-dir "/response"))
+ (slurp "cat" (string-append ,out-dir "/response")))
+ marionette))
+
+ (test-end))))
+
+ (gexp->derivation "rootless-podman-oci-service-test" test))
+
+(define %test-oci-service-rootless-podman
+ (system-test
+ (name "oci-service-rootless-podman")
+ (description "Test Rootless-Podman backed OCI provisioning service.")
+ (value (run-rootless-podman-oci-service-test))))
+
+(define %oci-docker-os
+ (simple-operating-system
+ (service dhcp-client-service-type)
+ (service dbus-root-service-type)
+ (service polkit-service-type)
+ (service elogind-service-type)
+ (service containerd-service-type)
+ (service docker-service-type)
+ (extra-special-file "/shared.txt"
+ (plain-file "shared.txt" "hello"))
+ (service oci-service-type
+ (oci-configuration
+ (verbose? #t)))
+ (simple-service 'oci-provisioning
+ oci-service-type
+ (oci-extension
+ (networks
+ (list (oci-network-configuration (name "my-network"))))
+ (volumes
+ (list (oci-volume-configuration (name "my-volume"))))
+ (containers
+ (list
+ (oci-container-configuration
+ (provision "first")
+ (image
+ (oci-image
+ (repository "guile")
+ (value
+ (specifications->manifest '("guile")))
+ (pack-options
+ '(#:symlinks (("/bin" -> "bin"))))))
+ (entrypoint "/bin/guile")
+ (network "my-network")
+ (command
+ '("-c" "(use-modules (web server))
+(define (handler request request-body)
+ (values '((content-type . (text/plain))) \"out of office\"))
+(run-server handler 'http `(#:addr ,(inet-pton AF_INET \"0.0.0.0\")))"))
+ (host-environment
+ '(("VARIABLE" . "value")))
+ (volumes
+ '(("my-volume" . "/my-volume")))
+ (extra-arguments
+ '("--env" "VARIABLE")))
+ (oci-container-configuration
+ (provision "second")
+ (image
+ (oci-image
+ (repository "guile")
+ (value
+ (specifications->manifest '("guile")))
+ (pack-options
+ '(#:symlinks (("/bin" -> "bin"))))))
+ (entrypoint "/bin/guile")
+ (network "my-network")
+ (command
+ '("-c" "(let l ((c 300))(display c)(sleep 1)(when(positive? c)(l (- c 1))))"))
+ (volumes
+ '(("my-volume" . "/my-volume")
+ ("/shared.txt" . "/shared.txt:ro"))))))))))
+
+(define (run-docker-oci-service-test)
+ (define os
+ (marionette-operating-system
+ (operating-system-with-gc-roots
+ %oci-docker-os
+ (list))
+ #: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))
+ #~(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))
+
+ (test-runner-current (system-test-runner #$output))
+ (test-begin "docker-oci-service")
+
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (wait-for-service 'dockerd))
+ marionette)
+
+ (test-assert "docker-volumes running"
+ (begin
+ (define (run-test)
+ (marionette-eval
+ `(begin
+ (use-modules (ice-9 popen)
+ (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
+ (list "sh" "-l" "-c"
+ (string-join
+ args
+ " "))))
+ (output (read-lines port))
+ (status (close-pipe port)))
+ output)))
+
+ (stable-sort
+ (slurp
+ "/run/current-system/profile/bin/docker"
+ "volume" "ls" "--format" "\"{{.Name}}\"")
+ string<=?))
+
+ marionette))
+ ;; Allow services to come up on slower machines
+ (let loop ((attempts 0))
+ (if (= attempts 80)
+ (error "Service didn't come up after more than 80 seconds")
+ (if (equal? '("my-volume")
+ (run-test))
+ #t
+ (begin
+ (sleep 1)
+ (loop (+ 1 attempts))))))))
+
+ (test-assert "docker-networks running"
+ (begin
+ (define (run-test)
+ (marionette-eval
+ `(begin
+ (use-modules (ice-9 popen)
+ (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
+ (list "sh" "-l" "-c"
+ (string-join
+ args
+ " "))))
+ (output (read-lines port))
+ (status (close-pipe port)))
+ output)))
+
+ (stable-sort
+ (slurp
+ "/run/current-system/profile/bin/docker"
+ "network" "ls" "--format" "\"{{.Name}}\"")
+ string<=?))
+
+ marionette))
+ ;; Allow services to come up on slower machines
+ (let loop ((attempts 0))
+ (if (= attempts 80)
+ (error "Service didn't come up after more than 80 seconds")
+ (if (equal? '("bridge" "host" "my-network" "none")
+ (run-test))
+ #t
+ (begin
+ (sleep 1)
+ (loop (+ 1 attempts))))))))
+
+ (test-assert "first container running"
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (wait-for-service 'first #:timeout 120)
+ #t)
+ marionette))
+
+ (test-assert "second container running"
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (wait-for-service 'second #:timeout 120)
+ #t)
+ marionette))
+
+ (test-assert "passing host environment variables"
+ (begin
+ (define (run-test)
+ (marionette-eval
+ `(begin
+ (use-modules (ice-9 popen)
+ (ice-9 rdelim))
+
+ (define slurp
+ (lambda args
+ (let* ((port (apply open-pipe* OPEN_READ args))
+ (output (let ((line (read-line port)))
+ (if (eof-object? line)
+ ""
+ line)))
+ (status (close-pipe port)))
+ output)))
+
+ (slurp
+ "/run/current-system/profile/bin/docker"
+ "exec" "first"
+ "/bin/guile" "-c" "(display (getenv \"VARIABLE\"))"))
+ marionette))
+ ;; Allow image to be loaded on slower machines
+ (let loop ((attempts 0))
+ (if (= attempts 180)
+ (error "Service didn't come up after more than 180 seconds")
+ (if (equal? "value"
+ (run-test))
+ #t
+ (begin
+ (sleep 1)
+ (loop (+ 1 attempts))))))))
+
+ (test-equal "mounting host files"
+ "hello"
+ (marionette-eval
+ `(begin
+ (use-modules (ice-9 popen)
+ (ice-9 rdelim))
+
+ (define slurp
+ (lambda args
+ (let* ((port (apply open-pipe* OPEN_READ args))
+ (output (let ((line (read-line port)))
+ (if (eof-object? line)
+ ""
+ line)))
+ (status (close-pipe port)))
+ output)))
+
+ (slurp
+ "/run/current-system/profile/bin/docker"
+ "exec" "second"
+ "/bin/guile" "-c" "(begin (use-modules (ice-9 popen) (ice-9 rdelim))
+(display (call-with-input-file \"/shared.txt\" read-line)))"))
+ marionette))
+
+ (test-equal "write to volumes"
+ "world"
+ (marionette-eval
+ `(begin
+ (use-modules (ice-9 popen)
+ (ice-9 rdelim))
+
+ (define slurp
+ (lambda args
+ (let* ((port (apply open-pipe* OPEN_READ args))
+ (output (let ((line (read-line port)))
+ (if (eof-object? line)
+ ""
+ line)))
+ (status (close-pipe port)))
+ output)))
+
+ (slurp
+ "/run/current-system/profile/bin/docker"
+ "exec" "first"
+ "/bin/guile" "-c" "(begin (use-modules (ice-9 popen) (ice-9 rdelim))
+(call-with-output-file \"/my-volume/out.txt\" (lambda (p) (display \"world\" p))))")
+ (slurp
+ "/run/current-system/profile/bin/docker"
+ "exec" "second"
+ "/bin/guile" "-c" "(begin (use-modules (ice-9 popen) (ice-9 rdelim))
+(display (call-with-input-file \"/my-volume/out.txt\" read-line)))"))
+ marionette))
+
+ (test-equal "can read ports over network"
+ "out of office"
+ (marionette-eval
+ `(begin
+ (use-modules (ice-9 popen)
+ (ice-9 rdelim))
+
+ (define slurp
+ (lambda args
+ (let* ((port (apply open-pipe* OPEN_READ args))
+ (output (let ((line (read-line port)))
+ (if (eof-object? line)
+ ""
+ line)))
+ (status (close-pipe port)))
+ output)))
+
+ (slurp
+ "/run/current-system/profile/bin/docker"
+ "exec" "second"
+ "/bin/guile" "-c" "(begin (use-modules (web client))
+(define-values (response out)
+ (http-get \"http://first:8080\"))
+(display out))"))
+ marionette))
+
+ (test-end))))
+
+ (gexp->derivation "docker-oci-service-test" test))
+
+(define %test-oci-service-docker
+ (system-test
+ (name "oci-service-docker")
+ (description "Test Docker backed OCI provisioning service.")
+ (value (run-docker-oci-service-test))))
--
2.48.1
guix-patches <at> gnu.org:bug#76081; Package guix-patches.
(Wed, 12 Feb 2025 01:11:03 GMT) Full text and rfc822 format available.Message #56 received at 76081 <at> debbugs.gnu.org (full text, mbox):
From: Giacomo Leidi <goodoldpaul <at> autistici.org> To: 76081 <at> debbugs.gnu.org Cc: Giacomo Leidi <goodoldpaul <at> autistici.org> Subject: [PATCH v4 4/4] tests: Use lower-oci-image-state in container tests. Date: Wed, 12 Feb 2025 02:10:37 +0100
This patch replaces boilerplate in container related tests with
oci-image plumbing from (gnu services containers).
* gnu/services/containers.scm: Export lower-oci-image-state.
* gnu/tests/containers.scm (%oci-tarball): New variable;
(run-rootless-podman-test): use %oci-tarball;
(build-tarball&run-rootless-podman-test): drop procedure.
* gnu/tests/docker.scm (%docker-tarball): New variable;
(build-tarball&run-docker-test): use %docker-tarball;
(%docker-system-tarball): New variable;
(build-tarball&run-docker-system-test): new procedure.
Change-Id: Iad6f0704aee188d89464c83722dea0bb7adb084a
---
gnu/services/containers.scm | 2 +
gnu/tests/containers.scm | 80 ++++++++++++++---------------
gnu/tests/docker.scm | 100 ++++++++++++++++++++----------------
3 files changed, 95 insertions(+), 87 deletions(-)
diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm
index 018dfa60f48..63e9cb37b53 100644
--- a/gnu/services/containers.scm
+++ b/gnu/services/containers.scm
@@ -74,6 +74,8 @@ (define-module (gnu services containers)
oci-image-system
oci-image-grafts?
+ lower-oci-image-state
+
oci-container-configuration
oci-container-configuration?
oci-container-configuration-fields
diff --git a/gnu/tests/containers.scm b/gnu/tests/containers.scm
index bac1f47bd34..1fcf6be7ace 100644
--- a/gnu/tests/containers.scm
+++ b/gnu/tests/containers.scm
@@ -69,13 +69,47 @@ (define %rootless-podman-os
(supplementary-groups '("wheel" "netdev" "cgroup"
"audio" "video")))))))
-(define (run-rootless-podman-test oci-tarball)
+(define %oci-tarball
+ (lower-oci-image-state
+ "guile-guest"
+ (packages->manifest
+ (list
+ guile-3.0 guile-json-3
+ (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))))
+ '(#:entry-point "bin/guile"
+ #:localstatedir? #t
+ #:extra-options (#:image-tag "guile-guest")
+ #:symlinks (("/bin/Guile" -> "bin/guile")
+ ("aa.scm" -> "a.scm")))
+ "guile-guest"
+ (%current-target-system)
+ (%current-system)
+ #f))
+
+(define (run-rootless-podman-test)
(define os
(marionette-operating-system
(operating-system-with-gc-roots
%rootless-podman-os
- (list oci-tarball))
+ (list %oci-tarball))
#:imported-modules '((gnu services herd)
(guix combinators))))
@@ -254,7 +288,7 @@ (define (run-rootless-podman-test oci-tarball)
(let* ((loaded (slurp ,(string-append #$podman
"/bin/podman")
"load" "-i"
- ,#$oci-tarball))
+ ,#$%oci-tarball))
(repository&tag "localhost/guile-guest:latest")
(response1 (slurp
,(string-append #$podman "/bin/podman")
@@ -307,49 +341,11 @@ (define (run-rootless-podman-test oci-tarball)
(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))))
+ (value (run-rootless-podman-test))))
(define %oci-rootless-podman-os
diff --git a/gnu/tests/docker.scm b/gnu/tests/docker.scm
index 5dcf05a17e3..07edd9d5341 100644
--- a/gnu/tests/docker.scm
+++ b/gnu/tests/docker.scm
@@ -26,6 +26,7 @@ (define-module (gnu tests docker)
#:use-module (gnu system image)
#:use-module (gnu system vm)
#:use-module (gnu services)
+ #:use-module (gnu services containers)
#:use-module (gnu services dbus)
#:use-module (gnu services networking)
#:use-module (gnu services docker)
@@ -57,6 +58,40 @@ (define %docker-os
(service containerd-service-type)
(service docker-service-type)))
+(define %docker-tarball
+ (lower-oci-image-state
+ "guile-guest"
+ (packages->manifest
+ (list
+ guile-3.0 guile-json-3
+ (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))))
+ '(#:entry-point "bin/guile"
+ #:localstatedir? #t
+ #:extra-options (#:image-tag "guile-guest")
+ #:symlinks (("/bin/Guile" -> "bin/guile")
+ ("aa.scm" -> "a.scm")))
+ "guile-guest"
+ (%current-target-system)
+ (%current-system)
+ #f))
+
(define (run-docker-test docker-tarball)
"Load DOCKER-TARBALL as Docker image and run it in a Docker container,
inside %DOCKER-OS."
@@ -173,40 +208,7 @@ (define (run-docker-test docker-tarball)
(gexp->derivation "docker-test" test))
(define (build-tarball&run-docker-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"))
- #:entry-point "bin/guile"
- #:localstatedir? #t)))
- (run-docker-test tarball)))
+ (run-docker-test %docker-tarball))
(define %test-docker
(system-test
@@ -215,8 +217,22 @@ (define %test-docker
(value (build-tarball&run-docker-test))))
+(define %docker-system-tarball
+ (lower-oci-image-state
+ "guix-system-guest"
+ (operating-system
+ (inherit (simple-operating-system))
+ ;; Use locales for a single libc to
+ ;; reduce space requirements.
+ (locale-libcs (list glibc)))
+ '()
+ "guix-system-guest"
+ (%current-target-system)
+ (%current-system)
+ #f))
+
(define (run-docker-system-test tarball)
- "Load DOCKER-TARBALL as Docker image and run it in a Docker container,
+ "Load TARBALL as Docker image and run it in a Docker container,
inside %DOCKER-OS."
(define os
(marionette-operating-system
@@ -333,21 +349,15 @@ (define (run-docker-system-test tarball)
(gexp->derivation "docker-system-test" test))
+(define (build-tarball&run-docker-system-test)
+ (run-docker-system-test %docker-system-tarball))
+
(define %test-docker-system
(system-test
(name "docker-system")
(description "Run a system image as produced by @command{guix system
docker-image} inside Docker.")
- (value (with-monad %store-monad
- (>>= (lower-object
- (system-image (os->image
- (operating-system
- (inherit (simple-operating-system))
- ;; Use locales for a single libc to
- ;; reduce space requirements.
- (locale-libcs (list glibc)))
- #:type docker-image-type)))
- run-docker-system-test)))))
+ (value (build-tarball&run-docker-system-test))))
(define %oci-os
--
2.48.1
guix-patches <at> gnu.org:bug#76081; Package guix-patches.
(Wed, 12 Feb 2025 01:11:03 GMT) Full text and rfc822 format available.Message #59 received at 76081 <at> debbugs.gnu.org (full text, mbox):
From: Giacomo Leidi <goodoldpaul <at> autistici.org> To: 76081 <at> debbugs.gnu.org Cc: Giacomo Leidi <goodoldpaul <at> autistici.org> Subject: [PATCH v4 1/4] services: rootless-podman: Use login shell. Date: Wed, 12 Feb 2025 02:10:34 +0100
This commit allows for having PATH set when changing the owner of
/sys/fs/group.
* gnu/services/containers.scm (crgroups-fs-owner): Use login shell.
Change-Id: I9510c637a5332325e05ca5ebc9dfd4de32685c50
---
gnu/services/containers.scm | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm
index 19d35ccbcb6..dc66ac4f967 100644
--- a/gnu/services/containers.scm
+++ b/gnu/services/containers.scm
@@ -140,7 +140,7 @@ (define (cgroups-fs-owner-entrypoint config)
(rootless-podman-configuration-group-name config))
(program-file "cgroups2-fs-owner-entrypoint"
#~(system*
- (string-append #+bash-minimal "/bin/bash") "-c"
+ (string-append #+bash-minimal "/bin/bash") "-l" "-c"
(string-append "echo Setting /sys/fs/cgroup "
"group ownership to " #$group " && chown -v "
"root:" #$group " /sys/fs/cgroup && "
base-commit: f650fc3e15e0ba04b3998daf13db8666fcfd9627
--
2.48.1
guix-patches <at> gnu.org:bug#76081; Package guix-patches.
(Wed, 12 Feb 2025 01:11:04 GMT) Full text and rfc822 format available.Message #62 received at 76081 <at> debbugs.gnu.org (full text, mbox):
From: Giacomo Leidi <goodoldpaul <at> autistici.org> To: 76081 <at> debbugs.gnu.org Cc: Giacomo Leidi <goodoldpaul <at> autistici.org> Subject: [PATCH v4 2/4] services: oci-container-configuration: Move to (gnu services containers). Date: Wed, 12 Feb 2025 02:10:35 +0100
This patch moves the oci-container-configuration and related
configuration records to (gnu services containers).
Public symbols are still exported for backwards
compatibility but since the oci-container-service-type will be
deprecated in favor of the more general oci-service-type, everything is
moved outside of the docker related module.
* gnu/services/docker.scm: Move everything related to oci-container-configuration
to...
* gnu/services/containers.scm: ...here.scm.
* gnu/tests/docker.scm: Simplify %test-oci-container test case.
Change-Id: Iae599dd5cc7442eb632f0c1b3b12f6b928397ae7
---
gnu/services/containers.scm | 549 +++++++++++++++++++++++++++++++++-
gnu/services/docker.scm | 577 +++---------------------------------
gnu/tests/docker.scm | 99 +++----
3 files changed, 625 insertions(+), 600 deletions(-)
diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm
index dc66ac4f967..50bf6c05549 100644
--- a/gnu/services/containers.scm
+++ b/gnu/services/containers.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2024 Giacomo Leidi <goodoldpaul <at> autistici.org>
+;;; Copyright © 2024, 2025 Giacomo Leidi <goodoldpaul <at> autistici.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -17,19 +17,31 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu services containers)
+ #:use-module (gnu image)
+ #:use-module (gnu packages admin)
#:use-module (gnu packages bash)
#:use-module (gnu packages containers)
+ #:use-module (gnu packages docker)
#: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)
#:use-module (gnu system accounts)
+ #:use-module (gnu system image)
#:use-module (gnu system shadow)
#:use-module (gnu system pam)
+ #:use-module (guix diagnostics)
#:use-module (guix gexp)
+ #:use-module (guix i18n)
+ #:use-module (guix monads)
#:use-module (guix packages)
+ #:use-module (guix profiles)
+ #:use-module ((guix scripts pack) #:prefix pack:)
+ #:use-module (guix store)
#:use-module (srfi srfi-1)
+ #:use-module (ice-9 match)
#:export (rootless-podman-configuration
rootless-podman-configuration?
rootless-podman-configuration-fields
@@ -48,7 +60,44 @@ (define-module (gnu services containers)
rootless-podman-shepherd-services
rootless-podman-service-etc
- rootless-podman-service-type))
+ rootless-podman-service-type
+
+ oci-image
+ oci-image?
+ oci-image-fields
+ oci-image-repository
+ oci-image-tag
+ oci-image-value
+ oci-image-pack-options
+ oci-image-target
+ oci-image-system
+ oci-image-grafts?
+
+ oci-container-configuration
+ oci-container-configuration?
+ oci-container-configuration-fields
+ oci-container-configuration-user
+ oci-container-configuration-group
+ oci-container-configuration-command
+ oci-container-configuration-entrypoint
+ oci-container-configuration-host-environment
+ oci-container-configuration-environment
+ oci-container-configuration-image
+ oci-container-configuration-provision
+ oci-container-configuration-requirement
+ oci-container-configuration-log-file
+ oci-container-configuration-auto-start?
+ oci-container-configuration-respawn?
+ oci-container-configuration-shepherd-actions
+ oci-container-configuration-network
+ oci-container-configuration-ports
+ oci-container-configuration-volumes
+ oci-container-configuration-container-user
+ oci-container-configuration-workdir
+ oci-container-configuration-extra-arguments
+
+ oci-container-shepherd-service
+ %oci-container-accounts))
(define (gexp-or-string? value)
(or (gexp? value)
@@ -188,7 +237,7 @@ (define (rootless-podman-cgroups-limits-service config)
rootless-podman-shared-root-fs))
(one-shot? #t)
(documentation
- "Allow setting cgroups limits: cpu, cpuset, memory and
+ "Allow setting cgroups limits: cpu, cpuset, io, memory and
pids.")
(start
#~(make-forkexec-constructor
@@ -242,3 +291,497 @@ (define rootless-podman-service-type
(default-value (rootless-podman-configuration))
(description
"This service configures rootless @code{podman} on the Guix System.")))
+
+
+;;;
+;;; OCI container.
+;;;
+
+(define (oci-sanitize-pair pair delimiter)
+ (define (valid? member)
+ (or (string? member)
+ (gexp? member)
+ (file-like? member)))
+ (match pair
+ (((? valid? key) . (? valid? value))
+ #~(string-append #$key #$delimiter #$value))
+ (_
+ (raise
+ (formatted-message
+ (G_ "pair members must contain only strings, gexps or file-like objects
+but ~a was found")
+ pair)))))
+
+(define (oci-sanitize-mixed-list name value delimiter)
+ (map
+ (lambda (el)
+ (cond ((string? el) el)
+ ((pair? el) (oci-sanitize-pair el delimiter))
+ (else
+ (raise
+ (formatted-message
+ (G_ "~a members must be either a string or a pair but ~a was
+found!")
+ name el)))))
+ value))
+
+(define (oci-sanitize-host-environment value)
+ ;; Expected spec format:
+ ;; '(("HOME" . "/home/nobody") "JAVA_HOME=/java")
+ (oci-sanitize-mixed-list "host-environment" value "="))
+
+(define (oci-sanitize-environment value)
+ ;; Expected spec format:
+ ;; '(("HOME" . "/home/nobody") "JAVA_HOME=/java")
+ (oci-sanitize-mixed-list "environment" value "="))
+
+(define (oci-sanitize-ports value)
+ ;; Expected spec format:
+ ;; '(("8088" . "80") "2022:22")
+ (oci-sanitize-mixed-list "ports" value ":"))
+
+(define (oci-sanitize-volumes value)
+ ;; Expected spec format:
+ ;; '(("/mnt/dir" . "/dir") "/run/current-system/profile:/java")
+ (oci-sanitize-mixed-list "volumes" value ":"))
+
+(define (oci-sanitize-shepherd-actions value)
+ (map
+ (lambda (el)
+ (if (shepherd-action? el)
+ el
+ (raise
+ (formatted-message
+ (G_ "shepherd-actions may only be shepherd-action records
+but ~a was found") el))))
+ value))
+
+(define (oci-sanitize-extra-arguments value)
+ (define (valid? member)
+ (or (string? member)
+ (gexp? member)
+ (file-like? member)))
+ (map
+ (lambda (el)
+ (if (valid? el)
+ el
+ (raise
+ (formatted-message
+ (G_ "extra arguments may only be strings, gexps or file-like objects
+but ~a was found") el))))
+ value))
+
+(define (oci-image-reference image)
+ (if (string? image)
+ image
+ (string-append (oci-image-repository image)
+ ":" (oci-image-tag image))))
+
+(define (oci-lowerable-image? image)
+ (or (manifest? image)
+ (operating-system? image)
+ (gexp? image)
+ (file-like? image)))
+
+(define (string-or-oci-image? image)
+ (or (string? image)
+ (oci-image? image)))
+
+(define list-of-symbols?
+ (list-of symbol?))
+
+(define-maybe/no-serialization string)
+
+(define-configuration/no-serialization oci-image
+ (repository
+ (string)
+ "A string like @code{myregistry.local:5000/testing/test-image} that names
+the OCI image.")
+ (tag
+ (string "latest")
+ "A string representing the OCI image tag. Defaults to @code{latest}.")
+ (value
+ (oci-lowerable-image)
+ "A @code{manifest} or @code{operating-system} record that will be lowered
+into an OCI compatible tarball. Otherwise this field's value can be a gexp
+or a file-like object that evaluates to an OCI compatible tarball.")
+ (pack-options
+ (list '())
+ "An optional set of keyword arguments that will be passed to the
+@code{docker-image} procedure from @code{guix scripts pack}. They can be used
+to replicate @command{guix pack} behavior:
+
+@lisp
+(oci-image
+ (repository \"guile\")
+ (tag \"3\")
+ (manifest (specifications->manifest '(\"guile\")))
+ (pack-options
+ '(#:symlinks ((\"/bin/guile\" -> \"bin/guile\"))
+ #:max-layers 2)))
+@end lisp
+
+If the @code{value} field is an @code{operating-system} record, this field's
+value will be ignored.")
+ (system
+ (maybe-string)
+ "Attempt to build for a given system, e.g. \"i686-linux\"")
+ (target
+ (maybe-string)
+ "Attempt to cross-build for a given triple, e.g. \"aarch64-linux-gnu\"")
+ (grafts?
+ (boolean #f)
+ "Whether to allow grafting or not in the pack build."))
+
+(define-configuration/no-serialization oci-container-configuration
+ (user
+ (string "oci-container")
+ "The user under whose authority docker commands will be run.")
+ (group
+ (string "docker")
+ "The group under whose authority docker commands will be run.")
+ (command
+ (list-of-strings '())
+ "Overwrite the default command (@code{CMD}) of the image.")
+ (entrypoint
+ (maybe-string)
+ "Overwrite the default entrypoint (@code{ENTRYPOINT}) of the image.")
+ (host-environment
+ (list '())
+ "Set environment variables in the host environment where @command{docker run}
+is invoked. This is especially useful to pass secrets from the host to the
+container without having them on the @command{docker run}'s command line: by
+setting the @code{MYSQL_PASSWORD} on the host and by passing
+@code{--env MYSQL_PASSWORD} through the @code{extra-arguments} field, it is
+possible to securely set values in the container environment. This field's
+value can be a list of pairs or strings, even mixed:
+
+@lisp
+(list '(\"LANGUAGE\" . \"eo:ca:eu\")
+ \"JAVA_HOME=/opt/java\")
+@end lisp
+
+Pair members can be strings, gexps or file-like objects. Strings are passed
+directly to @code{make-forkexec-constructor}."
+ (sanitizer oci-sanitize-host-environment))
+ (environment
+ (list '())
+ "Set environment variables inside the container. This can be a list of pairs
+or strings, even mixed:
+
+@lisp
+(list '(\"LANGUAGE\" . \"eo:ca:eu\")
+ \"JAVA_HOME=/opt/java\")
+@end lisp
+
+Pair members can be strings, gexps or file-like objects. Strings are passed
+directly to the Docker CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#env,upstream}
+documentation for semantics."
+ (sanitizer oci-sanitize-environment))
+ (image
+ (string-or-oci-image)
+ "The image used to build the container. It can be a string or an
+@code{oci-image} record. Strings are resolved by the Docker
+Engine, and follow the usual format
+@code{myregistry.local:5000/testing/test-image:tag}.")
+ (provision
+ (maybe-string)
+ "Set the name of the provisioned Shepherd service.")
+ (requirement
+ (list-of-symbols '())
+ "Set additional Shepherd services dependencies to the provisioned Shepherd
+service.")
+ (log-file
+ (maybe-string)
+ "When @code{log-file} is set, it names the file to which the service’s
+standard output and standard error are redirected. @code{log-file} is created
+if it does not exist, otherwise it is appended to.")
+ (auto-start?
+ (boolean #t)
+ "Whether this service should be started automatically by the Shepherd. If it
+is @code{#f} the service has to be started manually with @command{herd start}.")
+ (respawn?
+ (boolean #f)
+ "Whether to restart the service when it stops, for instance when the
+underlying process dies.")
+ (shepherd-actions
+ (list '())
+ "This is a list of @code{shepherd-action} records defining actions supported
+by the service."
+ (sanitizer oci-sanitize-shepherd-actions))
+ (network
+ (maybe-string)
+ "Set a Docker network for the spawned container.")
+ (ports
+ (list '())
+ "Set the port or port ranges to expose from the spawned container. This can
+be a list of pairs or strings, even mixed:
+
+@lisp
+(list '(\"8080\" . \"80\")
+ \"10443:443\")
+@end lisp
+
+Pair members can be strings, gexps or file-like objects. Strings are passed
+directly to the Docker CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#publish,upstream}
+documentation for semantics."
+ (sanitizer oci-sanitize-ports))
+ (volumes
+ (list '())
+ "Set volume mappings for the spawned container. This can be a
+list of pairs or strings, even mixed:
+
+@lisp
+(list '(\"/root/data/grafana\" . \"/var/lib/grafana\")
+ \"/gnu/store:/gnu/store\")
+@end lisp
+
+Pair members can be strings, gexps or file-like objects. Strings are passed
+directly to the Docker CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#volume,upstream}
+documentation for semantics."
+ (sanitizer oci-sanitize-volumes))
+ (container-user
+ (maybe-string)
+ "Set the current user inside the spawned container. You can refer to the
+@url{https://docs.docker.com/engine/reference/run/#user,upstream}
+documentation for semantics.")
+ (workdir
+ (maybe-string)
+ "Set the current working for the spawned Shepherd service.
+You can refer to the
+@url{https://docs.docker.com/engine/reference/run/#workdir,upstream}
+documentation for semantics.")
+ (extra-arguments
+ (list '())
+ "A list of strings, gexps or file-like objects that will be directly passed
+to the @command{docker run} invokation."
+ (sanitizer oci-sanitize-extra-arguments)))
+
+(define oci-container-configuration->options
+ (lambda (config)
+ (let ((entrypoint
+ (oci-container-configuration-entrypoint config))
+ (network
+ (oci-container-configuration-network config))
+ (user
+ (oci-container-configuration-container-user config))
+ (workdir
+ (oci-container-configuration-workdir config)))
+ (apply append
+ (filter (compose not unspecified?)
+ `(,(if (maybe-value-set? entrypoint)
+ `("--entrypoint" ,entrypoint)
+ '())
+ ,(append-map
+ (lambda (spec)
+ (list "--env" spec))
+ (oci-container-configuration-environment config))
+ ,(if (maybe-value-set? network)
+ `("--network" ,network)
+ '())
+ ,(if (maybe-value-set? user)
+ `("--user" ,user)
+ '())
+ ,(if (maybe-value-set? workdir)
+ `("--workdir" ,workdir)
+ '())
+ ,(append-map
+ (lambda (spec)
+ (list "-p" spec))
+ (oci-container-configuration-ports config))
+ ,(append-map
+ (lambda (spec)
+ (list "-v" spec))
+ (oci-container-configuration-volumes config))))))))
+
+(define* (get-keyword-value args keyword #:key (default #f))
+ (let ((kv (memq keyword args)))
+ (if (and kv (>= (length kv) 2))
+ (cadr kv)
+ default)))
+
+(define (lower-operating-system os target system)
+ (mlet* %store-monad
+ ((tarball
+ (lower-object
+ (system-image (os->image os #:type docker-image-type))
+ system
+ #:target target)))
+ (return tarball)))
+
+(define (lower-manifest name image target system)
+ (define value (oci-image-value image))
+ (define options (oci-image-pack-options image))
+ (define image-reference
+ (oci-image-reference image))
+ (define image-tag
+ (let* ((extra-options
+ (get-keyword-value options #:extra-options))
+ (image-tag-option
+ (and extra-options
+ (get-keyword-value extra-options #:image-tag))))
+ (if image-tag-option
+ '()
+ `(#:extra-options (#:image-tag ,image-reference)))))
+
+ (mlet* %store-monad
+ ((_ (set-grafting
+ (oci-image-grafts? image)))
+ (guile (set-guile-for-build (default-guile)))
+ (profile
+ (profile-derivation value
+ #:target target
+ #:system system
+ #:hooks '()
+ #:locales? #f))
+ (tarball (apply pack:docker-image
+ `(,name ,profile
+ ,@options
+ ,@image-tag
+ #:localstatedir? #t))))
+ (return tarball)))
+
+(define (lower-oci-image name image)
+ (define value (oci-image-value image))
+ (define image-target (oci-image-target image))
+ (define image-system (oci-image-system image))
+ (define target
+ (if (maybe-value-set? image-target)
+ image-target
+ (%current-target-system)))
+ (define system
+ (if (maybe-value-set? image-system)
+ image-system
+ (%current-system)))
+ (with-store store
+ (run-with-store store
+ (match value
+ ((? manifest? value)
+ (lower-manifest name image target system))
+ ((? operating-system? value)
+ (lower-operating-system value target system))
+ ((or (? gexp? value)
+ (? file-like? value))
+ value)
+ (_
+ (raise
+ (formatted-message
+ (G_ "oci-image value must contain only manifest,
+operating-system, gexp or file-like records but ~a was found")
+ value))))
+ #:target target
+ #:system system)))
+
+(define (%oci-image-loader name image tag)
+ (let ((docker (file-append docker-cli "/bin/docker"))
+ (tarball (lower-oci-image name image)))
+ (with-imported-modules '((guix build utils))
+ (program-file (format #f "~a-image-loader" name)
+ #~(begin
+ (use-modules (guix build utils)
+ (ice-9 popen)
+ (ice-9 rdelim))
+
+ (format #t "Loading image for ~a from ~a...~%" #$name #$tarball)
+ (define line
+ (read-line
+ (open-input-pipe
+ (string-append #$docker " load -i " #$tarball))))
+
+ (unless (or (eof-object? line)
+ (string-null? line))
+ (format #t "~a~%" line)
+ (let ((repository&tag
+ (string-drop line
+ (string-length
+ "Loaded image: "))))
+
+ (invoke #$docker "tag" repository&tag #$tag)
+ (format #t "Tagged ~a with ~a...~%" #$tarball #$tag))))))))
+
+(define (oci-container-shepherd-service config)
+ (define (guess-name name image)
+ (if (maybe-value-set? name)
+ name
+ (string-append "docker-"
+ (basename
+ (if (string? image)
+ (first (string-split image #\:))
+ (oci-image-repository image))))))
+
+ (let* ((docker (file-append docker-cli "/bin/docker"))
+ (actions (oci-container-configuration-shepherd-actions config))
+ (auto-start?
+ (oci-container-configuration-auto-start? config))
+ (user (oci-container-configuration-user config))
+ (group (oci-container-configuration-group config))
+ (host-environment
+ (oci-container-configuration-host-environment config))
+ (command (oci-container-configuration-command config))
+ (log-file (oci-container-configuration-log-file config))
+ (provision (oci-container-configuration-provision config))
+ (requirement (oci-container-configuration-requirement config))
+ (respawn?
+ (oci-container-configuration-respawn? config))
+ (image (oci-container-configuration-image config))
+ (image-reference (oci-image-reference image))
+ (options (oci-container-configuration->options config))
+ (name (guess-name provision image))
+ (extra-arguments
+ (oci-container-configuration-extra-arguments config)))
+
+ (shepherd-service (provision `(,(string->symbol name)))
+ (requirement `(dockerd user-processes ,@requirement))
+ (respawn? respawn?)
+ (auto-start? auto-start?)
+ (documentation
+ (string-append
+ "Docker backed Shepherd service for "
+ (if (oci-image? image) name image) "."))
+ (start
+ #~(lambda ()
+ #$@(if (oci-image? image)
+ #~((invoke #$(%oci-image-loader
+ name image image-reference)))
+ #~())
+ (fork+exec-command
+ ;; docker run [OPTIONS] IMAGE [COMMAND] [ARG...]
+ (list #$docker "run" "--rm" "--name" #$name
+ #$@options #$@extra-arguments
+ #$image-reference #$@command)
+ #:user #$user
+ #:group #$group
+ #$@(if (maybe-value-set? log-file)
+ (list #:log-file log-file)
+ '())
+ #:environment-variables
+ (list #$@host-environment))))
+ (stop
+ #~(lambda _
+ (invoke #$docker "rm" "-f" #$name)))
+ (actions
+ (if (oci-image? image)
+ '()
+ (append
+ (list
+ (shepherd-action
+ (name 'pull)
+ (documentation
+ (format #f "Pull ~a's image (~a)."
+ name image))
+ (procedure
+ #~(lambda _
+ (invoke #$docker "pull" #$image)))))
+ actions))))))
+
+(define %oci-container-accounts
+ (list (user-account
+ (name "oci-container")
+ (comment "OCI services account")
+ (group "docker")
+ (system? #t)
+ (home-directory "/var/empty")
+ (shell (file-append shadow "/sbin/nologin")))))
diff --git a/gnu/services/docker.scm b/gnu/services/docker.scm
index 3af0f792701..69ff9f1d9e4 100644
--- a/gnu/services/docker.scm
+++ b/gnu/services/docker.scm
@@ -5,7 +5,7 @@
;;; Copyright © 2020 Efraim Flashner <efraim <at> flashner.co.il>
;;; Copyright © 2020 Jesse Dowell <jessedowell <at> gmail.com>
;;; Copyright © 2021 Brice Waegeneire <brice <at> waegenei.re>
-;;; Copyright © 2023, 2024 Giacomo Leidi <goodoldpaul <at> autistici.org>
+;;; Copyright © 2023, 2024, 2025 Giacomo Leidi <goodoldpaul <at> autistici.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -23,72 +23,60 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu services docker)
- #:use-module (gnu image)
#:use-module (gnu services)
#:use-module (gnu services configuration)
- #:use-module (gnu services base)
- #:use-module (gnu services dbus)
+ #:use-module (gnu services containers)
#:use-module (gnu services shepherd)
- #:use-module (gnu system)
- #:use-module (gnu system image)
#:use-module (gnu system privilege)
#:use-module (gnu system shadow)
- #:use-module (gnu packages admin) ;shadow
#:use-module (gnu packages docker)
#:use-module (gnu packages linux) ;singularity
- #:use-module (guix records)
- #:use-module (guix diagnostics)
#:use-module (guix gexp)
- #:use-module (guix i18n)
- #:use-module (guix monads)
- #:use-module (guix packages)
- #:use-module (guix profiles)
- #:use-module ((guix scripts pack) #:prefix pack:)
- #:use-module (guix store)
+ #:use-module (guix records)
#:use-module (srfi srfi-1)
#:use-module (ice-9 format)
#:use-module (ice-9 match)
+ #:re-export (oci-image ;for backwards compatibility, until the
+ oci-image? ;oci-container-service-type is fully deprecated
+ oci-image-fields
+ oci-image-repository
+ oci-image-tag
+ oci-image-value
+ oci-image-pack-options
+ oci-image-target
+ oci-image-system
+ oci-image-grafts?
+ oci-container-configuration
+ oci-container-configuration?
+ oci-container-configuration-fields
+ oci-container-configuration-user
+ oci-container-configuration-group
+ oci-container-configuration-command
+ oci-container-configuration-entrypoint
+ oci-container-configuration-host-environment
+ oci-container-configuration-environment
+ oci-container-configuration-image
+ oci-container-configuration-provision
+ oci-container-configuration-requirement
+ oci-container-configuration-log-file
+ oci-container-configuration-auto-start?
+ oci-container-configuration-respawn?
+ oci-container-configuration-shepherd-actions
+ oci-container-configuration-network
+ oci-container-configuration-ports
+ oci-container-configuration-volumes
+ oci-container-configuration-container-user
+ oci-container-configuration-workdir
+ oci-container-configuration-extra-arguments
+ oci-container-shepherd-service
+ %oci-container-accounts)
#:export (containerd-configuration
containerd-service-type
docker-configuration
docker-service-type
singularity-service-type
- oci-image
- oci-image?
- oci-image-fields
- oci-image-repository
- oci-image-tag
- oci-image-value
- oci-image-pack-options
- oci-image-target
- oci-image-system
- oci-image-grafts?
- oci-container-configuration
- oci-container-configuration?
- oci-container-configuration-fields
- oci-container-configuration-user
- oci-container-configuration-group
- oci-container-configuration-command
- oci-container-configuration-entrypoint
- oci-container-configuration-host-environment
- oci-container-configuration-environment
- oci-container-configuration-image
- oci-container-configuration-provision
- oci-container-configuration-requirement
- oci-container-configuration-log-file
- oci-container-configuration-auto-start?
- oci-container-configuration-respawn?
- oci-container-configuration-shepherd-actions
- oci-container-configuration-network
- oci-container-configuration-ports
- oci-container-configuration-volumes
- oci-container-configuration-container-user
- oci-container-configuration-workdir
- oci-container-configuration-extra-arguments
- oci-container-service-type
- oci-container-shepherd-service
- %oci-container-accounts))
+ oci-container-service-type))
(define-maybe file-like)
@@ -307,495 +295,6 @@ (define singularity-service-type
;;; OCI container.
;;;
-(define (oci-sanitize-pair pair delimiter)
- (define (valid? member)
- (or (string? member)
- (gexp? member)
- (file-like? member)))
- (match pair
- (((? valid? key) . (? valid? value))
- #~(string-append #$key #$delimiter #$value))
- (_
- (raise
- (formatted-message
- (G_ "pair members must contain only strings, gexps or file-like objects
-but ~a was found")
- pair)))))
-
-(define (oci-sanitize-mixed-list name value delimiter)
- (map
- (lambda (el)
- (cond ((string? el) el)
- ((pair? el) (oci-sanitize-pair el delimiter))
- (else
- (raise
- (formatted-message
- (G_ "~a members must be either a string or a pair but ~a was
-found!")
- name el)))))
- value))
-
-(define (oci-sanitize-host-environment value)
- ;; Expected spec format:
- ;; '(("HOME" . "/home/nobody") "JAVA_HOME=/java")
- (oci-sanitize-mixed-list "host-environment" value "="))
-
-(define (oci-sanitize-environment value)
- ;; Expected spec format:
- ;; '(("HOME" . "/home/nobody") "JAVA_HOME=/java")
- (oci-sanitize-mixed-list "environment" value "="))
-
-(define (oci-sanitize-ports value)
- ;; Expected spec format:
- ;; '(("8088" . "80") "2022:22")
- (oci-sanitize-mixed-list "ports" value ":"))
-
-(define (oci-sanitize-volumes value)
- ;; Expected spec format:
- ;; '(("/mnt/dir" . "/dir") "/run/current-system/profile:/java")
- (oci-sanitize-mixed-list "volumes" value ":"))
-
-(define (oci-sanitize-shepherd-actions value)
- (map
- (lambda (el)
- (if (shepherd-action? el)
- el
- (raise
- (formatted-message
- (G_ "shepherd-actions may only be shepherd-action records
-but ~a was found") el))))
- value))
-
-(define (oci-sanitize-extra-arguments value)
- (define (valid? member)
- (or (string? member)
- (gexp? member)
- (file-like? member)))
- (map
- (lambda (el)
- (if (valid? el)
- el
- (raise
- (formatted-message
- (G_ "extra arguments may only be strings, gexps or file-like objects
-but ~a was found") el))))
- value))
-
-(define (oci-image-reference image)
- (if (string? image)
- image
- (string-append (oci-image-repository image)
- ":" (oci-image-tag image))))
-
-(define (oci-lowerable-image? image)
- (or (manifest? image)
- (operating-system? image)
- (gexp? image)
- (file-like? image)))
-
-(define (string-or-oci-image? image)
- (or (string? image)
- (oci-image? image)))
-
-(define list-of-symbols?
- (list-of symbol?))
-
-(define-maybe/no-serialization string)
-
-(define-configuration/no-serialization oci-image
- (repository
- (string)
- "A string like @code{myregistry.local:5000/testing/test-image} that names
-the OCI image.")
- (tag
- (string "latest")
- "A string representing the OCI image tag. Defaults to @code{latest}.")
- (value
- (oci-lowerable-image)
- "A @code{manifest} or @code{operating-system} record that will be lowered
-into an OCI compatible tarball. Otherwise this field's value can be a gexp
-or a file-like object that evaluates to an OCI compatible tarball.")
- (pack-options
- (list '())
- "An optional set of keyword arguments that will be passed to the
-@code{docker-image} procedure from @code{guix scripts pack}. They can be used
-to replicate @command{guix pack} behavior:
-
-@lisp
-(oci-image
- (repository \"guile\")
- (tag \"3\")
- (manifest (specifications->manifest '(\"guile\")))
- (pack-options
- '(#:symlinks ((\"/bin/guile\" -> \"bin/guile\"))
- #:max-layers 2)))
-@end lisp
-
-If the @code{value} field is an @code{operating-system} record, this field's
-value will be ignored.")
- (system
- (maybe-string)
- "Attempt to build for a given system, e.g. \"i686-linux\"")
- (target
- (maybe-string)
- "Attempt to cross-build for a given triple, e.g. \"aarch64-linux-gnu\"")
- (grafts?
- (boolean #f)
- "Whether to allow grafting or not in the pack build."))
-
-(define-configuration/no-serialization oci-container-configuration
- (user
- (string "oci-container")
- "The user under whose authority docker commands will be run.")
- (group
- (string "docker")
- "The group under whose authority docker commands will be run.")
- (command
- (list-of-strings '())
- "Overwrite the default command (@code{CMD}) of the image.")
- (entrypoint
- (maybe-string)
- "Overwrite the default entrypoint (@code{ENTRYPOINT}) of the image.")
- (host-environment
- (list '())
- "Set environment variables in the host environment where @command{docker run}
-is invoked. This is especially useful to pass secrets from the host to the
-container without having them on the @command{docker run}'s command line: by
-setting the @code{MYSQL_PASSWORD} on the host and by passing
-@code{--env MYSQL_PASSWORD} through the @code{extra-arguments} field, it is
-possible to securely set values in the container environment. This field's
-value can be a list of pairs or strings, even mixed:
-
-@lisp
-(list '(\"LANGUAGE\" . \"eo:ca:eu\")
- \"JAVA_HOME=/opt/java\")
-@end lisp
-
-Pair members can be strings, gexps or file-like objects. Strings are passed
-directly to @code{make-forkexec-constructor}."
- (sanitizer oci-sanitize-host-environment))
- (environment
- (list '())
- "Set environment variables inside the container. This can be a list of pairs
-or strings, even mixed:
-
-@lisp
-(list '(\"LANGUAGE\" . \"eo:ca:eu\")
- \"JAVA_HOME=/opt/java\")
-@end lisp
-
-Pair members can be strings, gexps or file-like objects. Strings are passed
-directly to the Docker CLI. You can refer to the
-@url{https://docs.docker.com/engine/reference/commandline/run/#env,upstream}
-documentation for semantics."
- (sanitizer oci-sanitize-environment))
- (image
- (string-or-oci-image)
- "The image used to build the container. It can be a string or an
-@code{oci-image} record. Strings are resolved by the Docker
-Engine, and follow the usual format
-@code{myregistry.local:5000/testing/test-image:tag}.")
- (provision
- (maybe-string)
- "Set the name of the provisioned Shepherd service.")
- (requirement
- (list-of-symbols '())
- "Set additional Shepherd services dependencies to the provisioned Shepherd
-service.")
- (log-file
- (maybe-string)
- "When @code{log-file} is set, it names the file to which the service’s
-standard output and standard error are redirected. @code{log-file} is created
-if it does not exist, otherwise it is appended to.")
- (auto-start?
- (boolean #t)
- "Whether this service should be started automatically by the Shepherd. If it
-is @code{#f} the service has to be started manually with @command{herd start}.")
- (respawn?
- (boolean #f)
- "Whether to restart the service when it stops, for instance when the
-underlying process dies.")
- (shepherd-actions
- (list '())
- "This is a list of @code{shepherd-action} records defining actions supported
-by the service."
- (sanitizer oci-sanitize-shepherd-actions))
- (network
- (maybe-string)
- "Set a Docker network for the spawned container.")
- (ports
- (list '())
- "Set the port or port ranges to expose from the spawned container. This can
-be a list of pairs or strings, even mixed:
-
-@lisp
-(list '(\"8080\" . \"80\")
- \"10443:443\")
-@end lisp
-
-Pair members can be strings, gexps or file-like objects. Strings are passed
-directly to the Docker CLI. You can refer to the
-@url{https://docs.docker.com/engine/reference/commandline/run/#publish,upstream}
-documentation for semantics."
- (sanitizer oci-sanitize-ports))
- (volumes
- (list '())
- "Set volume mappings for the spawned container. This can be a
-list of pairs or strings, even mixed:
-
-@lisp
-(list '(\"/root/data/grafana\" . \"/var/lib/grafana\")
- \"/gnu/store:/gnu/store\")
-@end lisp
-
-Pair members can be strings, gexps or file-like objects. Strings are passed
-directly to the Docker CLI. You can refer to the
-@url{https://docs.docker.com/engine/reference/commandline/run/#volume,upstream}
-documentation for semantics."
- (sanitizer oci-sanitize-volumes))
- (container-user
- (maybe-string)
- "Set the current user inside the spawned container. You can refer to the
-@url{https://docs.docker.com/engine/reference/run/#user,upstream}
-documentation for semantics.")
- (workdir
- (maybe-string)
- "Set the current working for the spawned Shepherd service.
-You can refer to the
-@url{https://docs.docker.com/engine/reference/run/#workdir,upstream}
-documentation for semantics.")
- (extra-arguments
- (list '())
- "A list of strings, gexps or file-like objects that will be directly passed
-to the @command{docker run} invokation."
- (sanitizer oci-sanitize-extra-arguments)))
-
-(define oci-container-configuration->options
- (lambda (config)
- (let ((entrypoint
- (oci-container-configuration-entrypoint config))
- (network
- (oci-container-configuration-network config))
- (user
- (oci-container-configuration-container-user config))
- (workdir
- (oci-container-configuration-workdir config)))
- (apply append
- (filter (compose not unspecified?)
- `(,(if (maybe-value-set? entrypoint)
- `("--entrypoint" ,entrypoint)
- '())
- ,(append-map
- (lambda (spec)
- (list "--env" spec))
- (oci-container-configuration-environment config))
- ,(if (maybe-value-set? network)
- `("--network" ,network)
- '())
- ,(if (maybe-value-set? user)
- `("--user" ,user)
- '())
- ,(if (maybe-value-set? workdir)
- `("--workdir" ,workdir)
- '())
- ,(append-map
- (lambda (spec)
- (list "-p" spec))
- (oci-container-configuration-ports config))
- ,(append-map
- (lambda (spec)
- (list "-v" spec))
- (oci-container-configuration-volumes config))))))))
-
-(define* (get-keyword-value args keyword #:key (default #f))
- (let ((kv (memq keyword args)))
- (if (and kv (>= (length kv) 2))
- (cadr kv)
- default)))
-
-(define (lower-operating-system os target system)
- (mlet* %store-monad
- ((tarball
- (lower-object
- (system-image (os->image os #:type docker-image-type))
- system
- #:target target)))
- (return tarball)))
-
-(define (lower-manifest name image target system)
- (define value (oci-image-value image))
- (define options (oci-image-pack-options image))
- (define image-reference
- (oci-image-reference image))
- (define image-tag
- (let* ((extra-options
- (get-keyword-value options #:extra-options))
- (image-tag-option
- (and extra-options
- (get-keyword-value extra-options #:image-tag))))
- (if image-tag-option
- '()
- `(#:extra-options (#:image-tag ,image-reference)))))
-
- (mlet* %store-monad
- ((_ (set-grafting
- (oci-image-grafts? image)))
- (guile (set-guile-for-build (default-guile)))
- (profile
- (profile-derivation value
- #:target target
- #:system system
- #:hooks '()
- #:locales? #f))
- (tarball (apply pack:docker-image
- `(,name ,profile
- ,@options
- ,@image-tag
- #:localstatedir? #t))))
- (return tarball)))
-
-(define (lower-oci-image name image)
- (define value (oci-image-value image))
- (define image-target (oci-image-target image))
- (define image-system (oci-image-system image))
- (define target
- (if (maybe-value-set? image-target)
- image-target
- (%current-target-system)))
- (define system
- (if (maybe-value-set? image-system)
- image-system
- (%current-system)))
- (with-store store
- (run-with-store store
- (match value
- ((? manifest? value)
- (lower-manifest name image target system))
- ((? operating-system? value)
- (lower-operating-system value target system))
- ((or (? gexp? value)
- (? file-like? value))
- value)
- (_
- (raise
- (formatted-message
- (G_ "oci-image value must contain only manifest,
-operating-system, gexp or file-like records but ~a was found")
- value))))
- #:target target
- #:system system)))
-
-(define (%oci-image-loader name image tag)
- (let ((docker (file-append docker-cli "/bin/docker"))
- (tarball (lower-oci-image name image)))
- (with-imported-modules '((guix build utils))
- (program-file (format #f "~a-image-loader" name)
- #~(begin
- (use-modules (guix build utils)
- (ice-9 popen)
- (ice-9 rdelim))
-
- (format #t "Loading image for ~a from ~a...~%" #$name #$tarball)
- (define line
- (read-line
- (open-input-pipe
- (string-append #$docker " load -i " #$tarball))))
-
- (unless (or (eof-object? line)
- (string-null? line))
- (format #t "~a~%" line)
- (let ((repository&tag
- (string-drop line
- (string-length
- "Loaded image: "))))
-
- (invoke #$docker "tag" repository&tag #$tag)
- (format #t "Tagged ~a with ~a...~%" #$tarball #$tag))))))))
-
-(define (oci-container-shepherd-service config)
- (define (guess-name name image)
- (if (maybe-value-set? name)
- name
- (string-append "docker-"
- (basename
- (if (string? image)
- (first (string-split image #\:))
- (oci-image-repository image))))))
-
- (let* ((docker (file-append docker-cli "/bin/docker"))
- (actions (oci-container-configuration-shepherd-actions config))
- (auto-start?
- (oci-container-configuration-auto-start? config))
- (user (oci-container-configuration-user config))
- (group (oci-container-configuration-group config))
- (host-environment
- (oci-container-configuration-host-environment config))
- (command (oci-container-configuration-command config))
- (log-file (oci-container-configuration-log-file config))
- (provision (oci-container-configuration-provision config))
- (requirement (oci-container-configuration-requirement config))
- (respawn?
- (oci-container-configuration-respawn? config))
- (image (oci-container-configuration-image config))
- (image-reference (oci-image-reference image))
- (options (oci-container-configuration->options config))
- (name (guess-name provision image))
- (extra-arguments
- (oci-container-configuration-extra-arguments config)))
-
- (shepherd-service (provision `(,(string->symbol name)))
- (requirement `(dockerd user-processes ,@requirement))
- (respawn? respawn?)
- (auto-start? auto-start?)
- (documentation
- (string-append
- "Docker backed Shepherd service for "
- (if (oci-image? image) name image) "."))
- (start
- #~(lambda ()
- #$@(if (oci-image? image)
- #~((invoke #$(%oci-image-loader
- name image image-reference)))
- #~())
- (fork+exec-command
- ;; docker run [OPTIONS] IMAGE [COMMAND] [ARG...]
- (list #$docker "run" "--rm" "--name" #$name
- #$@options #$@extra-arguments
- #$image-reference #$@command)
- #:user #$user
- #:group #$group
- #$@(if (maybe-value-set? log-file)
- (list #:log-file log-file)
- '())
- #:environment-variables
- (list #$@host-environment))))
- (stop
- #~(lambda _
- (invoke #$docker "rm" "-f" #$name)))
- (actions
- (if (oci-image? image)
- '()
- (append
- (list
- (shepherd-action
- (name 'pull)
- (documentation
- (format #f "Pull ~a's image (~a)."
- name image))
- (procedure
- #~(lambda _
- (invoke #$docker "pull" #$image)))))
- actions))))))
-
-(define %oci-container-accounts
- (list (user-account
- (name "oci-container")
- (comment "OCI services account")
- (group "docker")
- (system? #t)
- (home-directory "/var/empty")
- (shell (file-append shadow "/sbin/nologin")))))
-
(define (configs->shepherd-services configs)
(map oci-container-shepherd-service configs))
diff --git a/gnu/tests/docker.scm b/gnu/tests/docker.scm
index 90c8d0f8508..5dcf05a17e3 100644
--- a/gnu/tests/docker.scm
+++ b/gnu/tests/docker.scm
@@ -1,7 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019 Danny Milosavljevic <dannym <at> scratchpost.org>
;;; Copyright © 2019-2023 Ludovic Courtès <ludo <at> gnu.org>
-;;; Copyright © 2024 Giacomo Leidi <goodoldpaul <at> autistici.org>
+;;; Copyright © 2024, 2025 Giacomo Leidi <goodoldpaul <at> autistici.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -414,71 +414,54 @@ (define (run-oci-container-test)
(test-runner-current (system-test-runner #$output))
(test-begin "oci-container")
- (test-assert "containerd service running"
- (marionette-eval
- '(begin
- (use-modules (gnu services herd))
- (match (start-service 'containerd)
- (#f #f)
- (('service response-parts ...)
- (match (assq-ref response-parts 'running)
- ((pid) pid)))))
- marionette))
-
- (test-assert "containerd PID file present"
- (wait-for-file "/run/containerd/containerd.pid" marionette))
-
- (test-assert "dockerd running"
- (marionette-eval
- '(begin
- (use-modules (gnu services herd))
- (match (start-service 'dockerd)
- (#f #f)
- (('service response-parts ...)
- (match (assq-ref response-parts 'running)
- ((pid) pid)))))
- marionette))
-
- (sleep 10) ; let service start
+ (wait-for-file "/run/containerd/containerd.pid" marionette)
(test-assert "docker-guile running"
(marionette-eval
'(begin
(use-modules (gnu services herd))
- (match (start-service 'docker-guile)
- (#f #f)
- (('service response-parts ...)
- (match (assq-ref response-parts 'running)
- ((pid) pid)))))
+ (wait-for-service 'docker-guile #:timeout 120)
+ #t)
marionette))
- (test-equal "passing host environment variables and volumes"
- '("value" "hello")
- (marionette-eval
- `(begin
- (use-modules (ice-9 popen)
- (ice-9 rdelim))
-
- (define slurp
- (lambda args
- (let* ((port (apply open-pipe* OPEN_READ args))
- (output (let ((line (read-line port)))
- (if (eof-object? line)
- ""
- line)))
- (status (close-pipe port)))
- output)))
- (let* ((response1 (slurp
- ,(string-append #$docker-cli "/bin/docker")
- "exec" "docker-guile"
- "/bin/guile" "-c" "(display (getenv \"VARIABLE\"))"))
- (response2 (slurp
- ,(string-append #$docker-cli "/bin/docker")
- "exec" "docker-guile"
- "/bin/guile" "-c" "(begin (use-modules (ice-9 popen) (ice-9 rdelim))
+ (test-assert "passing host environment variables and volumes"
+ (begin
+ (define (run-test)
+ (marionette-eval
+ `(begin
+ (use-modules (ice-9 popen)
+ (ice-9 rdelim))
+
+ (define slurp
+ (lambda args
+ (let* ((port (apply open-pipe* OPEN_READ args))
+ (output (let ((line (read-line port)))
+ (if (eof-object? line)
+ ""
+ line)))
+ (status (close-pipe port)))
+ output)))
+ (let* ((response1 (slurp
+ ,(string-append #$docker-cli "/bin/docker")
+ "exec" "docker-guile"
+ "/bin/guile" "-c" "(display (getenv \"VARIABLE\"))"))
+ (response2 (slurp
+ ,(string-append #$docker-cli "/bin/docker")
+ "exec" "docker-guile"
+ "/bin/guile" "-c" "(begin (use-modules (ice-9 popen) (ice-9 rdelim))
(display (call-with-input-file \"/shared.txt\" read-line)))")))
- (list response1 response2)))
- marionette))
+ (list response1 response2)))
+ marionette))
+ ;; Allow services to come up on slower machines
+ (let loop ((attempts 0))
+ (if (= attempts 60)
+ (error "Service didn't come up after more than 60 seconds")
+ (if (equal? '("value" "hello")
+ (run-test))
+ #t
+ (begin
+ (sleep 1)
+ (loop (+ 1 attempts))))))))
(test-end))))
--
2.48.1
guix-patches <at> gnu.org:bug#76081; Package guix-patches.
(Tue, 18 Feb 2025 01:21:02 GMT) Full text and rfc822 format available.Message #65 received at 76081 <at> debbugs.gnu.org (full text, mbox):
From: paul <goodoldpaul <at> autistici.org> To: 76081 <at> debbugs.gnu.org Subject: Re: OCI provisioning service Date: Tue, 18 Feb 2025 02:20:12 +0100
Hi, On 2/12/25 02:09, paul wrote: > Hi guix, > > On 2/9/25 21:38, paul wrote: >> I'm sending a v3 fixing a bug in the merge algorithm for volumes and >> networks. >> >> On 2/9/25 20:14, paul wrote: >>> Hi, >>> >>> I'm about to send a v2. v2 compared to the first revision features: >>> >>> >>> - it actually compiles all the times :) (rev 1 referenced oci-image >>> too early for it to be working and generated a compile time error, >>> if you recompiled it sometimes went away so I thought it was a >>> problem of my setup. CI caught this) >>> - it allows more values to be overridden by eventual users of the >>> Scheme API >>> - it allows passing extra arguments directly after each podman or >>> docker invokation, allowing for example for overriding podman --root >>> and similar options. >>> >>> All of these tests should pass: >>> >>> guix shell -D guix -CPW -- make check-system TESTS="oci-container >>> oci-service-rootless-podman docker docker-system rootless-podman >>> oci-service-docker" >>> > I'm sending a v4 changing slightly the image loader, the same tests as > before are supposed to pass. Now the Home service [0] is working for > me with rootless podman. I'll try it on different distros if I manage to. I'm sending a v5 implementing a Home service. The changes compared to v4 are pretty trivial as the plumbing was already there, the only downside is that I'm not able to use for-home? in define-configuration, so I had to reimplement oci-configuration with (guix records) and had to reimplement some validation (gnu services configuration) would figure out magically. Thank you for your work and time, cheers giacomo
ludo <at> gnu.org, maxim.cournoyer <at> gmail.com, guix-patches <at> gnu.org:bug#76081; Package guix-patches.
(Wed, 19 Feb 2025 00:10:02 GMT) Full text and rfc822 format available.Message #68 received at 76081 <at> debbugs.gnu.org (full text, mbox):
From: Giacomo Leidi <goodoldpaul <at> autistici.org> To: 76081 <at> debbugs.gnu.org Cc: Giacomo Leidi <goodoldpaul <at> autistici.org> Subject: [PATCH v5 3/5] services: Add oci-service-type. Date: Wed, 19 Feb 2025 01:09:20 +0100
This patch implements a generalization of the
oci-container-service-type, which consequently is made deprecated. The
oci-service-type, in addition to all the features from the
oci-container-service-type, can now provision OCI networks and volumes.
It only handles OCI objects creation, the user is supposed to handle
state once the objects are provsioned.
It currently supports two different OCI runtimes: Docker and rootless
Podman. Both runtimes are tested to make sure provisioned containers
can connect to each other through provisioned networks and can
read/write data with provisioned volumes.
At last the Scheme API is thought to facilitate the implementation of a
Guix Home service in the future.
* gnu/services/containers.scm (%oci-supported-runtimes): New variable;
(oci-runtime-cli): new variable;
(oci-runtime-name): new variable;
(oci-network-configuration): new variable;
(oci-volume-configuration): new variable;
(oci-configuration): new variable;
(oci-extension): new variable;
(oci-networks-shepherd-name): new variable;
(oci-service-type): new variable;
(oci-state->shepherd-services): new variable.
* doc/guix.texi: Document it.
* gnu/tests/containers.scm: Test it.
* gnu/services/docker.scm: Deprecate the oci-container-service-type.
Change-Id: I656b3db85832e42d53072fcbfb91d1226f39ef38
---
doc/guix.texi | 306 +++++++--
gnu/services/containers.scm | 1283 ++++++++++++++++++++++++++++++-----
gnu/services/docker.scm | 37 +-
gnu/tests/containers.scm | 999 ++++++++++++++++++++++++++-
4 files changed, 2380 insertions(+), 245 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index 54a736c518c..0dfec66a52b 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -42282,59 +42282,162 @@ Miscellaneous Services
@cindex OCI-backed, Shepherd services
@subsubheading OCI backed services
-Should you wish to manage your Docker containers with the same consistent
-interface you use for your other Shepherd services,
-@var{oci-container-service-type} is the tool to use: given an
-@acronym{Open Container Initiative, OCI} container image, it will run it in a
+Should you wish to manage your @acronym{Open Container Initiative, OCI} containers
+with the same consistent interface you use for your other Shepherd services,
+@var{oci-service-type} is the tool to use: given an
+OCI container image, it will run it in a
Shepherd service. One example where this is useful: it lets you run services
-that are available as Docker/OCI images but not yet packaged for Guix.
+that are available as OCI images but not yet packaged for Guix.
-@defvar oci-container-service-type
+@defvar oci-service-type
-This is a thin wrapper around Docker's CLI that executes OCI images backed
+This is a thin wrapper around Docker's or Podman's CLI that executes OCI images backed
processes as Shepherd Services.
@lisp
-(service oci-container-service-type
- (list
- (oci-container-configuration
- (network "host")
- (image
- (oci-image
- (repository "guile")
- (tag "3")
- (value (specifications->manifest '("guile")))
- (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile"))
- #:max-layers 2))))
- (entrypoint "/bin/guile")
- (command
- '("-c" "(display \"hello!\n\")")))
- (oci-container-configuration
- (image "prom/prometheus")
- (ports
- '(("9000" . "9000")
- ("9090" . "9090"))))
- (oci-container-configuration
- (image "grafana/grafana:10.0.1")
- (network "host")
- (volumes
- '("/var/lib/grafana:/var/lib/grafana")))))
+(simple-service 'oci-provisioning
+ oci-service-type
+ (oci-extension
+ (networks
+ (list
+ (oci-network-configuration (name "monitoring"))))
+ (containers
+ (list
+ (oci-container-configuration
+ (network "monitoring")
+ (image
+ (oci-image
+ (repository "guile")
+ (tag "3")
+ (value (specifications->manifest '("guile")))
+ (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile"))
+ #:max-layers 2))))
+ (entrypoint "/bin/guile")
+ (command
+ '("-c" "(display \"hello!\n\")")))
+ (oci-container-configuration
+ (image "prom/prometheus")
+ (network "host")
+ (ports
+ '(("9000" . "9000")
+ ("9090" . "9090"))))
+ (oci-container-configuration
+ (image "grafana/grafana:10.0.1")
+ (network "host")
+ (volumes
+ '("/var/lib/grafana:/var/lib/grafana")))))))
@end lisp
In this example three different Shepherd services are going to be added to the
system. Each @code{oci-container-configuration} record translates to a
-@code{docker run} invocation and its fields directly map to options. You can
-refer to the
-@url{https://docs.docker.com/engine/reference/commandline/run,upstream}
-documentation for the semantics of each value. If the images are not found,
-they will be
-@url{https://docs.docker.com/engine/reference/commandline/pull/,pulled}. The
+@command{docker run} or @command{podman run} invocation and its fields directly
+map to options. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html,Podman}
+upstream documentation for semantics of each value. If the images are not found,
+they will be pulled. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/pull/,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-pull.1.html,Podman}
+upstream documentation for semantics. The
services with @code{(network "host")} are going to be attached to the
host network and are supposed to behave like native processes with regard to
networking.
@end defvar
+@c %start of fragment
+
+@deftp {Data Type} oci-configuration
+Available @code{oci-configuration} fields are:
+
+@table @asis
+@item @code{runtime} (default: @code{'docker}) (type: symbol)
+The OCI runtime to use to run commands. It can be either @code{'docker} or
+@code{'podman}.
+
+@item @code{runtime-cli} (type: maybe-package-or-string)
+The OCI runtime command line to be installed in the system profile and used
+to provision OCI resources. When unset it will default to @code{docker-cli}
+package for the @code{'docker} runtime or to @code{podman} package for the
+@code{'podman} runtime. When a string is passed it will be interpreted as the
+absolute file-system path of the selected OCI runtime command.
+
+@item @code{runtime-extra-arguments} (default: @code{'()}) (type: list)
+A list of strings, gexps or file-like objects that will be placed
+after each @command{docker} or @command{podman} invokation.
+
+@item @code{user} (type: maybe-string)
+The user name under whose authority OCI commands will be run. This field will
+override the @code{user} field of @code{oci-configuration}.
+
+@item @code{group} (type: maybe-string)
+The group name under whose authority OCI commands will be run. When
+using the @code{'podman} OCI runtime, this field will be ignored and the
+default group of the user configured in the @code{user} field will be used.
+This field will override the @code{group} field of @code{oci-configuration}.
+
+@item @code{subuids-range} (type: maybe-subid-range)
+An optional @code{subid-range} record allocating subuids for the user from
+the @code{user} field. When unset, with the rootless Podman OCI runtime, it
+defaults to @code{(subid-range (name "oci-container"))}.
+
+@item @code{subgids-range} (type: maybe-subid-range)
+An optional @code{subid-range} record allocating subgids for the user from
+the @code{user} field. When unset, with the rootless Podman OCI runtime, it
+defaults to @code{(subid-range (name "oci-container"))}.
+
+@item @code{containers} (default: @code{'()}) (type: list-of-oci-containers)
+The list of @code{oci-container-configuration} records representing the
+containers to provision. Most users are supposed not to use this field and use
+the @code{oci-extension} record instead.
+
+@item @code{networks} (default: @code{'()}) (type: list-of-oci-networks)
+The list of @code{oci-network-configuration} records representing the
+containers to provision. Most users are supposed not to use this field and use
+the @code{oci-extension} record instead.
+
+@item @code{volumes} (default: @code{'()}) (type: list-of-oci-volumes)
+The list of @code{oci-volumes-configuration} records representing the
+containers to provision. Most users are supposed not to use this field and use
+the @code{oci-extension} record instead.
+
+@item @code{verbose?} (default: @code{#f}) (type: boolean)
+When true, additional output will be printed, allowing to better follow the
+flow of execution.
+
+@end table
+
+@end deftp
+
+
+@c %end of fragment
+
+@c %start of fragment
+
+@deftp {Data Type} oci-extension
+Available @code{oci-extension} fields are:
+
+@table @asis
+@item @code{containers} (default: @code{'()}) (type: list-of-oci-containers)
+The list of @code{oci-container-configuration} records representing the
+containers to provision.
+
+@item @code{networks} (default: @code{'()}) (type: list-of-oci-networks)
+The list of @code{oci-network-configuration} records representing the
+containers to provision.
+
+@item @code{volumes} (default: @code{'()}) (type: list-of-oci-volumes)
+The list of @code{oci-volumes-configuration} records representing the
+containers to provision.
+
+@end table
+
+@end deftp
+
+
+@c %end of fragment
+
+
@c %start of fragment
@deftp {Data Type} oci-container-configuration
@@ -42354,16 +42457,16 @@ Miscellaneous Services
Overwrite the default entrypoint (@code{ENTRYPOINT}) of the image.
@item @code{host-environment} (default: @code{'()}) (type: list)
-Set environment variables in the host environment where @command{docker
-run} is invoked. This is especially useful to pass secrets from the
-host to the container without having them on the @command{docker run}'s
-command line: by setting the @code{MYSQL_PASSWORD} on the host and by passing
+Set environment variables in the host environment where @command{docker run}
+or @command{podman run} are invoked. This is especially useful to pass secrets
+from the host to the container without having them on the OCI runtime command line,
+for example: by setting the @code{MYSQL_PASSWORD} on the host and by passing
@code{--env MYSQL_PASSWORD} through the @code{extra-arguments} field, it is
possible to securely set values in the container environment. This field's
value can be a list of pairs or strings, even mixed:
@lisp
-(list '("LANGUAGE\" . "eo:ca:eu")
+(list '("LANGUAGE" . "eo:ca:eu")
"JAVA_HOME=/opt/java")
@end lisp
@@ -42371,22 +42474,24 @@ Miscellaneous Services
directly to @code{make-forkexec-constructor}.
@item @code{environment} (default: @code{'()}) (type: list)
-Set environment variables. This can be a list of pairs or strings, even mixed:
+Set environment variables inside the container. This can be a list of pairs
+or strings, even mixed:
@lisp
(list '("LANGUAGE" . "eo:ca:eu")
"JAVA_HOME=/opt/java")
@end lisp
-Pair members can be strings, gexps or file-like objects.
-Strings are passed directly to the Docker CLI. You can refer to the
-@uref{https://docs.docker.com/engine/reference/commandline/run/#env,upstream}
-documentation for semantics.
+Pair members can be strings, gexps or file-like objects. Strings are passed
+directly to the OCI runtime CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#env,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#env-e-env,Podman}
+upstream documentation for semantics.
@item @code{image} (type: string-or-oci-image)
The image used to build the container. It can be a string or an
-@code{oci-image} record. Strings are resolved by the Docker Engine, and
-follow the usual format
+@code{oci-image} record. Strings are resolved by the OCI runtime,
+and follow the usual format
@code{myregistry.local:5000/testing/test-image:tag}.
@item @code{provision} (default: @code{""}) (type: string)
@@ -42414,7 +42519,7 @@ Miscellaneous Services
by the service.
@item @code{network} (default: @code{""}) (type: string)
-Set a Docker network for the spawned container.
+Set an OCI network for the spawned container.
@item @code{ports} (default: @code{'()}) (type: list)
Set the port or port ranges to expose from the spawned container. This can be a
@@ -42425,10 +42530,11 @@ Miscellaneous Services
"10443:443")
@end lisp
-Pair members can be strings, gexps or file-like objects.
-Strings are passed directly to the Docker CLI. You can refer to the
-@uref{https://docs.docker.com/engine/reference/commandline/run/#publish,upstream}
-documentation for semantics.
+Pair members can be strings, gexps or file-like objects. Strings are passed
+directly to the OCI runtime CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#publish,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#publish-p-ip-hostport-containerport-protocol,Podman}
+upstream documentation for semantics.
@item @code{volumes} (default: @code{'()}) (type: list)
Set volume mappings for the spawned container. This can be a
@@ -42439,25 +42545,97 @@ Miscellaneous Services
"/gnu/store:/gnu/store")
@end lisp
-Pair members can be strings, gexps or file-like objects.
-Strings are passed directly to the Docker CLI. You can refer to the
-@uref{https://docs.docker.com/engine/reference/commandline/run/#volume,upstream}
-documentation for semantics.
+Pair members can be strings, gexps or file-like objects. Strings are passed
+directly to the OCI runtime CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#volume,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#volume-v-source-volume-host-dir-container-dir-options,Podman}
+upstream documentation for semantics.
@item @code{container-user} (default: @code{""}) (type: string)
Set the current user inside the spawned container. You can refer to the
-@url{https://docs.docker.com/engine/reference/run/#user,upstream}
-documentation for semantics.
+@url{https://docs.docker.com/engine/reference/run/#user,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#user-u-user-group,Podman}
+upstream documentation for semantics.
@item @code{workdir} (default: @code{""}) (type: string)
Set the current working directory for the spawned Shepherd service.
You can refer to the
-@url{https://docs.docker.com/engine/reference/run/#workdir,upstream}
-documentation for semantics.
+@url{https://docs.docker.com/engine/reference/run/#workdir,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#workdir-w-dir,Podman}
+upstream documentation for semantics.
@item @code{extra-arguments} (default: @code{'()}) (type: list)
-A list of strings, gexps or file-like objects that will be directly
-passed to the @command{docker run} invocation.
+A list of strings, gexps or file-like objects that will be directly passed
+to the @command{docker run} or @command{podman run} invokation.
+
+@end table
+
+@end deftp
+
+
+@c %end of fragment
+
+@c %start of fragment
+
+@deftp {Data Type} oci-network-configuration
+Available @code{oci-network-configuration} fields are:
+
+@table @asis
+@item @code{name} (type: string)
+The name of the OCI network to provision.
+
+@item @code{driver} (type: maybe-string)
+The driver to manage the network.
+
+@item @code{gateway} (type: maybe-string)
+IPv4 or IPv6 gateway for the subnet.
+
+@item @code{internal?} (default: @code{#f}) (type: boolean)
+Restrict external access to the network
+
+@item @code{ip-range} (type: maybe-string)
+Allocate container ip from a sub-range in CIDR format.
+
+@item @code{ipam-driver} (type: maybe-string)
+IP Address Management Driver.
+
+@item @code{ipv6?} (default: @code{#f}) (type: boolean)
+Enable IPv6 networking.
+
+@item @code{subnet} (type: maybe-string)
+Subnet in CIDR format that represents a network segment.
+
+@item @code{labels} (default: @code{'()}) (type: list)
+The list of labels that will be used to tag the current volume.
+
+@item @code{extra-arguments} (default: @code{'()}) (type: list)
+A list of strings, gexps or file-like objects that will be directly passed
+to the @command{docker network create} or @command{podman network create}
+invokation.
+
+@end table
+
+@end deftp
+
+
+@c %end of fragment
+
+@c %start of fragment
+
+@deftp {Data Type} oci-volume-configuration
+Available @code{oci-volume-configuration} fields are:
+
+@table @asis
+@item @code{name} (type: string)
+The name of the OCI volume to provision.
+
+@item @code{labels} (default: @code{'()}) (type: list)
+The list of labels that will be used to tag the current volume.
+
+@item @code{extra-arguments} (default: @code{'()}) (type: list)
+A list of strings, gexps or file-like objects that will be directly passed
+to the @command{docker volume create} or @command{podman volume create}
+invokation.
@end table
diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm
index 50bf6c05549..bd1b6f14356 100644
--- a/gnu/services/containers.scm
+++ b/gnu/services/containers.scm
@@ -39,8 +39,10 @@ (define-module (gnu services containers)
#:use-module (guix packages)
#:use-module (guix profiles)
#:use-module ((guix scripts pack) #:prefix pack:)
+ #:use-module (guix records)
#:use-module (guix store)
#:use-module (srfi srfi-1)
+ #:use-module (ice-9 format)
#:use-module (ice-9 match)
#:export (rootless-podman-configuration
rootless-podman-configuration?
@@ -96,8 +98,80 @@ (define-module (gnu services containers)
oci-container-configuration-workdir
oci-container-configuration-extra-arguments
+ list-of-oci-containers?
+ list-of-oci-networks?
+ list-of-oci-volumes?
+
+ %oci-supported-runtimes
+ oci-sanitize-runtime
+ oci-runtime-system-environment
+ oci-runtime-system-extra-arguments
+ oci-runtime-system-group
+ oci-runtime-system-requirement
+ oci-runtime-cli
+ oci-runtime-system-cli
+ oci-runtime-home-cli
+ oci-runtime-name
+ oci-runtime-group
+
+ oci-network-configuration
+ oci-network-configuration?
+ oci-network-configuration-fields
+ oci-network-configuration-name
+ oci-network-configuration-driver
+ oci-network-configuration-gateway
+ oci-network-configuration-internal?
+ oci-network-configuration-ip-range
+ oci-network-configuration-ipam-driver
+ oci-network-configuration-ipv6?
+ oci-network-configuration-subnet
+ oci-network-configuration-labels
+ oci-network-configuration-extra-arguments
+
+ oci-volume-configuration
+ oci-volume-configuration?
+ oci-volume-configuration-fields
+ oci-volume-configuration-name
+ oci-volume-configuration-labels
+ oci-volume-configuration-extra-arguments
+
+ oci-configuration
+ oci-configuration?
+ oci-configuration-runtime
+ oci-configuration-runtime-cli
+ oci-configuration-runtime-extra-arguments
+ oci-configuration-user
+ oci-configuration-group
+ oci-configuration-containers
+ oci-configuration-networks
+ oci-configuration-volumes
+ oci-configuration-verbose?
+ oci-configuration-valid?
+
+ oci-extension
+ oci-extension?
+ oci-extension-fields
+ oci-extension-containers
+ oci-extension-networks
+ oci-extension-volumes
+
+ oci-container-shepherd-name
+ oci-networks-shepherd-name
+ oci-networks-home-shepherd-name
+ oci-volumes-shepherd-name
+ oci-volumes-home-shepherd-name
+
oci-container-shepherd-service
- %oci-container-accounts))
+ oci-objects-merge-lst
+ oci-extension-merge
+ oci-service-extension-wrap-validate
+ oci-service-type
+ oci-service-accounts
+ oci-service-profile
+ oci-service-subids
+ oci-state->shepherd-services
+ oci-configuration->shepherd-services
+ oci-configuration-extend))
(define (gexp-or-string? value)
(or (gexp? value)
@@ -294,9 +368,42 @@ (define rootless-podman-service-type
;;;
-;;; OCI container.
+;;; OCI provisioning service.
;;;
+(define %oci-supported-runtimes
+ '(docker podman))
+
+(define (oci-runtime-system-requirement runtime)
+ "Return a list of Shepherd service names required by a given OCI runtime,
+before it is able to run containers."
+ (if (eq? 'podman runtime)
+ '(cgroups2-fs-owner cgroups2-limits
+ rootless-podman-shared-root-fs user-processes)
+ '(dockerd user-processes)))
+
+(define (oci-runtime-name runtime)
+ "Return a human readable name for a given OCI runtime."
+ (if (eq? 'podman runtime)
+ "Podman" "Docker"))
+
+(define (oci-runtime-group runtime maybe-group)
+ "Implement the logic behind selection of the group that is to be used by
+Shepherd to execute OCI commands."
+ (if (eq? maybe-group #f)
+ (if (eq? 'podman runtime)
+ "cgroup"
+ "docker")
+ maybe-group))
+
+(define (oci-sanitize-runtime value)
+ (unless (member value %oci-supported-runtimes)
+ (raise
+ (formatted-message
+ (G_ "OCI runtime must be a symbol and one of ~a,
+but ~a was found") %oci-supported-runtimes value)))
+ value)
+
(define (oci-sanitize-pair pair delimiter)
(define (valid? member)
(or (string? member)
@@ -345,6 +452,11 @@ (define (oci-sanitize-volumes value)
;; '(("/mnt/dir" . "/dir") "/run/current-system/profile:/java")
(oci-sanitize-mixed-list "volumes" value ":"))
+(define (oci-sanitize-labels value)
+ ;; Expected spec format:
+ ;; '(("foo" . "bar") "foo=bar")
+ (oci-sanitize-mixed-list "labels" value "="))
+
(define (oci-sanitize-shepherd-actions value)
(map
(lambda (el)
@@ -372,10 +484,15 @@ (define (oci-sanitize-extra-arguments value)
value))
(define (oci-image-reference image)
- (if (string? image)
- image
- (string-append (oci-image-repository image)
- ":" (oci-image-tag image))))
+ "Return a string OCI image reference representing IMAGE."
+ (define reference
+ (if (string? image)
+ image
+ (string-append (oci-image-repository image)
+ ":" (oci-image-tag image))))
+ (if (> (length (string-split reference #\/)) 1)
+ reference
+ (string-append "localhost/" reference)))
(define (oci-lowerable-image? image)
(or (manifest? image)
@@ -390,7 +507,19 @@ (define (string-or-oci-image? image)
(define list-of-symbols?
(list-of symbol?))
+(define (list-of-oci-records? name predicate value)
+ (map
+ (lambda (el)
+ (if (predicate el)
+ el
+ (raise
+ (formatted-message
+ (G_ "~a contains an illegal value: ~a") name el))))
+ value))
+
(define-maybe/no-serialization string)
+(define-maybe/no-serialization package)
+(define-maybe/no-serialization subid-range)
(define-configuration/no-serialization oci-image
(repository
@@ -435,11 +564,15 @@ (define-configuration/no-serialization oci-image
(define-configuration/no-serialization oci-container-configuration
(user
- (string "oci-container")
- "The user under whose authority docker commands will be run.")
+ (maybe-string)
+ "The user name under whose authority OCI commands will be run. This field will
+override the @code{user} field of @code{oci-configuration}.")
(group
- (string "docker")
- "The group under whose authority docker commands will be run.")
+ (maybe-string)
+ "The group name under whose authority OCI commands will be run. When
+using the @code{'podman} OCI runtime, this field will be ignored and the
+default group of the user configured in the @code{user} field will be used.
+This field will override the @code{group} field of @code{oci-configuration}.")
(command
(list-of-strings '())
"Overwrite the default command (@code{CMD}) of the image.")
@@ -449,9 +582,9 @@ (define-configuration/no-serialization oci-container-configuration
(host-environment
(list '())
"Set environment variables in the host environment where @command{docker run}
-is invoked. This is especially useful to pass secrets from the host to the
-container without having them on the @command{docker run}'s command line: by
-setting the @code{MYSQL_PASSWORD} on the host and by passing
+or @command{podman run} are invoked. This is especially useful to pass secrets
+from the host to the container without having them on the OCI runtime command line,
+for example: by setting the @code{MYSQL_PASSWORD} on the host and by passing
@code{--env MYSQL_PASSWORD} through the @code{extra-arguments} field, it is
possible to securely set values in the container environment. This field's
value can be a list of pairs or strings, even mixed:
@@ -475,15 +608,16 @@ (define-configuration/no-serialization oci-container-configuration
@end lisp
Pair members can be strings, gexps or file-like objects. Strings are passed
-directly to the Docker CLI. You can refer to the
-@url{https://docs.docker.com/engine/reference/commandline/run/#env,upstream}
-documentation for semantics."
+directly to the OCI runtime CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#env,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#env-e-env,Podman}
+upstream documentation for semantics."
(sanitizer oci-sanitize-environment))
(image
(string-or-oci-image)
"The image used to build the container. It can be a string or an
-@code{oci-image} record. Strings are resolved by the Docker
-Engine, and follow the usual format
+@code{oci-image} record. Strings are resolved by the OCI runtime,
+and follow the usual format
@code{myregistry.local:5000/testing/test-image:tag}.")
(provision
(maybe-string)
@@ -512,7 +646,7 @@ (define-configuration/no-serialization oci-container-configuration
(sanitizer oci-sanitize-shepherd-actions))
(network
(maybe-string)
- "Set a Docker network for the spawned container.")
+ "Set an OCI network for the spawned container.")
(ports
(list '())
"Set the port or port ranges to expose from the spawned container. This can
@@ -524,9 +658,10 @@ (define-configuration/no-serialization oci-container-configuration
@end lisp
Pair members can be strings, gexps or file-like objects. Strings are passed
-directly to the Docker CLI. You can refer to the
-@url{https://docs.docker.com/engine/reference/commandline/run/#publish,upstream}
-documentation for semantics."
+directly to the OCI runtime CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#publish,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#publish-p-ip-hostport-containerport-protocol,Podman}
+upstream documentation for semantics."
(sanitizer oci-sanitize-ports))
(volumes
(list '())
@@ -539,71 +674,363 @@ (define-configuration/no-serialization oci-container-configuration
@end lisp
Pair members can be strings, gexps or file-like objects. Strings are passed
-directly to the Docker CLI. You can refer to the
-@url{https://docs.docker.com/engine/reference/commandline/run/#volume,upstream}
-documentation for semantics."
+directly to the OCI runtime CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#volume,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#volume-v-source-volume-host-dir-container-dir-options,Podman}
+upstream documentation for semantics."
(sanitizer oci-sanitize-volumes))
(container-user
(maybe-string)
"Set the current user inside the spawned container. You can refer to the
-@url{https://docs.docker.com/engine/reference/run/#user,upstream}
-documentation for semantics.")
+@url{https://docs.docker.com/engine/reference/run/#user,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#user-u-user-group,Podman}
+upstream documentation for semantics.")
(workdir
(maybe-string)
- "Set the current working for the spawned Shepherd service.
+ "Set the current working directory for the spawned Shepherd service.
You can refer to the
-@url{https://docs.docker.com/engine/reference/run/#workdir,upstream}
-documentation for semantics.")
+@url{https://docs.docker.com/engine/reference/run/#workdir,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#workdir-w-dir,Podman}
+upstream documentation for semantics.")
(extra-arguments
(list '())
"A list of strings, gexps or file-like objects that will be directly passed
-to the @command{docker run} invokation."
+to the @command{docker run} or @command{podman run} invokation."
(sanitizer oci-sanitize-extra-arguments)))
-(define oci-container-configuration->options
- (lambda (config)
- (let ((entrypoint
- (oci-container-configuration-entrypoint config))
- (network
- (oci-container-configuration-network config))
- (user
- (oci-container-configuration-container-user config))
- (workdir
- (oci-container-configuration-workdir config)))
- (apply append
- (filter (compose not unspecified?)
- `(,(if (maybe-value-set? entrypoint)
- `("--entrypoint" ,entrypoint)
- '())
- ,(append-map
- (lambda (spec)
- (list "--env" spec))
- (oci-container-configuration-environment config))
- ,(if (maybe-value-set? network)
- `("--network" ,network)
- '())
- ,(if (maybe-value-set? user)
- `("--user" ,user)
- '())
- ,(if (maybe-value-set? workdir)
- `("--workdir" ,workdir)
- '())
- ,(append-map
- (lambda (spec)
- (list "-p" spec))
- (oci-container-configuration-ports config))
- ,(append-map
- (lambda (spec)
- (list "-v" spec))
- (oci-container-configuration-volumes config))))))))
-
-(define* (get-keyword-value args keyword #:key (default #f))
- (let ((kv (memq keyword args)))
- (if (and kv (>= (length kv) 2))
- (cadr kv)
- default)))
+(define (list-of-oci-containers? value)
+ (list-of-oci-records? "containers" oci-container-configuration? value))
+
+(define-configuration/no-serialization oci-volume-configuration
+ (name
+ (string)
+ "The name of the OCI volume to provision.")
+ (labels
+ (list '())
+ "The list of labels that will be used to tag the current volume."
+ (sanitizer oci-sanitize-labels))
+ (extra-arguments
+ (list '())
+ "A list of strings, gexps or file-like objects that will be directly passed
+to the @command{docker volume create} or @command{podman volume create}
+invokation."
+ (sanitizer oci-sanitize-extra-arguments)))
+
+(define (list-of-oci-volumes? value)
+ (list-of-oci-records? "volumes" oci-volume-configuration? value))
+
+(define-configuration/no-serialization oci-network-configuration
+ (name
+ (string)
+ "The name of the OCI network to provision.")
+ (driver
+ (maybe-string)
+ "The driver to manage the network.")
+ (gateway
+ (maybe-string)
+ "IPv4 or IPv6 gateway for the subnet.")
+ (internal?
+ (boolean #f)
+ "Restrict external access to the network")
+ (ip-range
+ (maybe-string)
+ "Allocate container ip from a sub-range in CIDR format.")
+ (ipam-driver
+ (maybe-string)
+ "IP Address Management Driver.")
+ (ipv6?
+ (boolean #f)
+ "Enable IPv6 networking.")
+ (subnet
+ (maybe-string)
+ "Subnet in CIDR format that represents a network segment.")
+ (labels
+ (list '())
+ "The list of labels that will be used to tag the current volume."
+ (sanitizer oci-sanitize-labels))
+ (extra-arguments
+ (list '())
+ "A list of strings, gexps or file-like objects that will be directly passed
+to the @command{docker network create} or @command{podman network create}
+invokation."
+ (sanitizer oci-sanitize-extra-arguments)))
+
+(define (list-of-oci-networks? value)
+ (list-of-oci-records? "networks" oci-network-configuration? value))
+
+(define-record-type* <oci-configuration>
+ oci-configuration
+ make-oci-configuration
+ oci-configuration?
+ this-oci-configuration
+
+ (runtime oci-configuration-runtime
+ (default 'docker))
+ (runtime-cli oci-configuration-runtime-cli
+ (default #f)) ; package or string
+ (runtime-extra-arguments oci-configuration-runtime-extra-arguments ; strings or gexps
+ (default '())) ; or file-like objects
+ (user oci-configuration-user
+ (default "oci-container"))
+ (group oci-configuration-group ; string
+ (default #f))
+ (subuids-range oci-configuration-subuids-range ; subid-range
+ (default #f))
+ (subgids-range oci-configuration-subgids-range ; subid-range
+ (default #f))
+ (containers oci-configuration-containers ; oci-container-configurations
+ (default '()))
+ (networks oci-configuration-networks ; oci-network-configurations
+ (default '()))
+ (volumes oci-configuration-volumes ; oci-volume-configurations
+ (default '()))
+ (verbose? oci-configuration-verbose?
+ (default #f))
+ (home-service? oci-configuration-home-service?
+ (default for-home?) (innate)))
+
+(define (package-or-string? value)
+ (or (package? value) (string? value)))
+
+(define (oci-configuration-valid? config)
+ (define runtime-cli
+ (oci-configuration-runtime-cli config))
+ (define group
+ (oci-configuration-group config))
+ (define subuids-range
+ (oci-configuration-subuids-range config))
+ (define subgids-range
+ (oci-configuration-subgids-range config))
+ (and
+ (symbol?
+ (oci-sanitize-runtime (oci-configuration-runtime config)))
+ (or (eq? runtime-cli #f)
+ (package-or-string? runtime-cli))
+ (list? (oci-configuration-runtime-extra-arguments config))
+ (string? (oci-configuration-user config))
+ (or (eq? group #f)
+ (string? group))
+ (or (eq? subuids-range #f)
+ (subid-range? subuids-range))
+ (or (eq? subgids-range #f)
+ (subid-range? subgids-range))
+ (list-of-oci-containers?
+ (oci-configuration-containers config))
+ (list-of-oci-networks?
+ (oci-configuration-networks config))
+ (list-of-oci-volumes?
+ (oci-configuration-volumes config))
+ (boolean?
+ (oci-configuration-verbose? config))
+ (boolean?
+ (oci-configuration-home-service? config))))
+
+(define (oci-runtime-system-environment runtime user)
+ (if (eq? runtime 'podman)
+ (list
+ #~(string-append
+ "HOME=" (passwd:dir (getpwnam #$user))))
+ #~()))
+
+(define (oci-runtime-system-group runtime user group)
+ (if (eq? runtime 'podman)
+ #~(group:name
+ (getgrgid
+ (passwd:gid
+ (getpwnam #$user))))
+ group))
+
+(define (oci-runtime-cli runtime runtime-cli path)
+ "Return a gexp that, when lowered, evaluates to the file system path of the OCI
+runtime command requested by the user."
+ (if (string? runtime-cli)
+ ;; It is a user defined absolute path
+ runtime-cli
+ #~(string-append
+ #$(if (eq? runtime-cli #f)
+ path
+ runtime-cli)
+ #$(if (eq? 'podman runtime)
+ "/bin/podman"
+ "/bin/docker"))))
+
+(define* (oci-runtime-system-cli config #:key (path "/run/current-system/profile"))
+ (let ((runtime-cli
+ (oci-configuration-runtime-cli config))
+ (runtime
+ (oci-configuration-runtime config)))
+ (oci-runtime-cli runtime runtime-cli path)))
+
+(define (oci-runtime-home-cli config)
+ (let ((runtime-cli
+ (oci-configuration-runtime-cli config))
+ (runtime
+ (oci-configuration-runtime config)))
+ (oci-runtime-cli runtime runtime-cli
+ (string-append (getenv "HOME")
+ "/.guix-home/profile"))))
+
+(define-configuration/no-serialization oci-extension
+ (containers
+ (list-of-oci-containers '())
+ "The list of @code{oci-container-configuration} records representing the
+containers to add.")
+ (networks
+ (list-of-oci-networks '())
+ "The list of @code{oci-network-configuration} records representing the
+networks to add.")
+ (volumes
+ (list-of-oci-volumes '())
+ "The list of @code{oci-volume-configuration} records representing the
+volumes to add."))
+
+(define (oci-image->container-name image)
+ "Infer the name of an OCI backed Shepherd service from its OCI image."
+ (basename
+ (if (string? image)
+ (first (string-split image #\:))
+ (oci-image-repository image))))
+
+(define (oci-object-command-shepherd-action object-name invokation)
+ "Return a Shepherd action printing a given INVOKATION of an OCI command for the
+given OBJECT-NAME."
+ (shepherd-action
+ (name 'command-line)
+ (documentation
+ (format #f "Prints ~a's OCI runtime command line invokation."
+ object-name))
+ (procedure
+ #~(lambda _
+ (format #t "~a~%" #$invokation)))))
+
+(define (oci-container-shepherd-name runtime config)
+ "Return the name of an OCI backed Shepherd service based on CONFIG.
+The name configured in the configuration record is returned when
+CONFIG's name field has a value, otherwise a name is inferred from CONFIG's
+image field."
+ (define name (oci-container-configuration-provision config))
+ (define image (oci-container-configuration-image config))
+
+ (if (maybe-value-set? name)
+ name
+ (string-append (symbol->string runtime) "-"
+ (oci-image->container-name image))))
+
+(define (oci-networks-shepherd-name runtime)
+ "Return the name of the OCI networks provisioning Shepherd service based on
+RUNTIME."
+ (string-append (symbol->string runtime) "-networks"))
+
+(define (oci-volumes-shepherd-name runtime)
+ "Return the name of the OCI volumes provisioning Shepherd service based on
+RUNTIME."
+ (string-append (symbol->string runtime) "-volumes"))
+
+(define (oci-networks-home-shepherd-name runtime)
+ "Return the name of the OCI volumes provisioning Home Shepherd service based on
+RUNTIME."
+ (string-append "home-" (oci-networks-shepherd-name runtime)))
+
+(define (oci-volumes-home-shepherd-name runtime)
+ "Return the name of the OCI volumes provisioning Home Shepherd service based on
+RUNTIME."
+ (string-append "home-" (oci-volumes-shepherd-name runtime)))
+
+(define (oci-container-configuration->options config)
+ "Map CONFIG, an oci-container-configuration record, to a gexp that, upon
+lowering, will be evaluated to a list of strings containing command line options
+for the OCI runtime run command."
+ (let ((entrypoint
+ (oci-container-configuration-entrypoint config))
+ (network
+ (oci-container-configuration-network config))
+ (user
+ (oci-container-configuration-container-user config))
+ (workdir
+ (oci-container-configuration-workdir config)))
+ (apply append
+ (filter (compose not unspecified?)
+ `(,(if (maybe-value-set? entrypoint)
+ `("--entrypoint" ,entrypoint)
+ '())
+ ,(append-map
+ (lambda (spec)
+ (list "--env" spec))
+ (oci-container-configuration-environment config))
+ ,(if (maybe-value-set? network)
+ `("--network" ,network)
+ '())
+ ,(if (maybe-value-set? user)
+ `("--user" ,user)
+ '())
+ ,(if (maybe-value-set? workdir)
+ `("--workdir" ,workdir)
+ '())
+ ,(append-map
+ (lambda (spec)
+ (list "-p" spec))
+ (oci-container-configuration-ports config))
+ ,(append-map
+ (lambda (spec)
+ (list "-v" spec))
+ (oci-container-configuration-volumes config)))))))
+
+(define (oci-network-configuration->options config)
+ "Map CONFIG, an oci-network-configuration record, to a gexp that, upon
+lowering, will be evaluated to a list of strings containing command line options
+for the OCI runtime network create command."
+ (let ((driver (oci-network-configuration-driver config))
+ (gateway
+ (oci-network-configuration-gateway config))
+ (internal?
+ (oci-network-configuration-internal? config))
+ (ip-range
+ (oci-network-configuration-ip-range config))
+ (ipam-driver
+ (oci-network-configuration-ipam-driver config))
+ (ipv6?
+ (oci-network-configuration-ipv6? config))
+ (subnet
+ (oci-network-configuration-subnet config)))
+ (apply append
+ (filter (compose not unspecified?)
+ `(,(if (maybe-value-set? driver)
+ `("--driver" ,driver)
+ '())
+ ,(if (maybe-value-set? gateway)
+ `("--gateway" ,gateway)
+ '())
+ ,(if internal?
+ `("--internal")
+ '())
+ ,(if (maybe-value-set? ip-range)
+ `("--ip-range" ,ip-range)
+ '())
+ ,(if (maybe-value-set? ipam-driver)
+ `("--ipam-driver" ,ipam-driver)
+ '())
+ ,(if ipv6?
+ `("--ipv6")
+ '())
+ ,(if (maybe-value-set? subnet)
+ `("--subnet" ,subnet)
+ '())
+ ,(append-map
+ (lambda (spec)
+ (list "--label" spec))
+ (oci-network-configuration-labels config)))))))
+
+(define (oci-volume-configuration->options config)
+ "Map CONFIG, an oci-volume-configuration record, to a gexp that, upon
+lowering, will be evaluated to a list of strings containing command line options
+for the OCI runtime volume create command."
+ (append-map
+ (lambda (spec)
+ (list "--label" spec))
+ (oci-volume-configuration-labels config)))
(define (lower-operating-system os target system)
+ "Lower OS, an operating-system record, into a tarball containing an OCI image."
(mlet* %store-monad
((tarball
(lower-object
@@ -612,24 +1039,11 @@ (define (lower-operating-system os target system)
#:target target)))
(return tarball)))
-(define (lower-manifest name image target system)
- (define value (oci-image-value image))
- (define options (oci-image-pack-options image))
- (define image-reference
- (oci-image-reference image))
- (define image-tag
- (let* ((extra-options
- (get-keyword-value options #:extra-options))
- (image-tag-option
- (and extra-options
- (get-keyword-value extra-options #:image-tag))))
- (if image-tag-option
- '()
- `(#:extra-options (#:image-tag ,image-reference)))))
-
+(define (lower-manifest name value options image-reference
+ target system grafts?)
+ "Lower VALUE, a manifest record, into a tarball containing an OCI image."
(mlet* %store-monad
- ((_ (set-grafting
- (oci-image-grafts? image)))
+ ((_ (set-grafting grafts?))
(guile (set-guile-for-build (default-guile)))
(profile
(profile-derivation value
@@ -640,14 +1054,11 @@ (define (lower-manifest name image target system)
(tarball (apply pack:docker-image
`(,name ,profile
,@options
- ,@image-tag
#:localstatedir? #t))))
(return tarball)))
-(define (lower-oci-image name image)
- (define value (oci-image-value image))
- (define image-target (oci-image-target image))
- (define image-system (oci-image-system image))
+(define (lower-oci-image-state name value options reference
+ image-target image-system grafts?)
(define target
(if (maybe-value-set? image-target)
image-target
@@ -660,7 +1071,8 @@ (define (lower-oci-image name image)
(run-with-store store
(match value
((? manifest? value)
- (lower-manifest name image target system))
+ (lower-manifest name value options reference
+ target system grafts?))
((? operating-system? value)
(lower-operating-system value target system))
((or (? gexp? value)
@@ -675,113 +1087,648 @@ (define (lower-oci-image name image)
#:target target
#:system system)))
-(define (%oci-image-loader name image tag)
- (let ((docker (file-append docker-cli "/bin/docker"))
- (tarball (lower-oci-image name image)))
+(define (lower-oci-image name image)
+ "Lower IMAGE, a oci-image record, into a tarball containing an OCI image."
+ (lower-oci-image-state
+ name
+ (oci-image-value image)
+ (oci-image-pack-options image)
+ (oci-image-reference image)
+ (oci-image-target image)
+ (oci-image-system image)
+ (oci-image-grafts? image)))
+
+(define (oci-object-exists? runtime runtime-cli object verbose?)
+ #~(lambda* (name #:key (format-string "{{.Name}}"))
+ (use-modules (ice-9 format)
+ (ice-9 match)
+ (ice-9 popen)
+ (ice-9 rdelim)
+ (srfi srfi-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)))
+
+ #$(if (eq? runtime 'podman)
+ #~(let ((command
+ (list #$runtime-cli
+ #$object "exists" name)))
+ (when #$verbose?
+ (format #t "Running~{ ~a~}~%" command))
+ (define exit-code (status:exit-val (apply system* command)))
+ (when #$verbose?
+ (format #t "Exit code: ~a~%" exit-code))
+ (equal? EXIT_SUCCESS exit-code))
+ #~(let ((command
+ (string-append #$runtime-cli
+ " " #$object " ls --format "
+ "\"" format-string "\"")))
+ (when #$verbose?
+ (format #t "Running ~a~%" command))
+ (member name (read-lines (open-input-pipe command)))))))
+
+(define* (oci-image-loader runtime runtime-cli name image tag #:key (verbose? #f))
+ "Return a file-like object that, once lowered, will evaluate to a program able
+to load IMAGE through RUNTIME-CLI and to tag it with TAG afterwards."
+ (let ((tarball (lower-oci-image name image)))
(with-imported-modules '((guix build utils))
- (program-file (format #f "~a-image-loader" name)
+ (program-file
+ (format #f "~a-image-loader" name)
#~(begin
(use-modules (guix build utils)
+ (ice-9 match)
(ice-9 popen)
- (ice-9 rdelim))
-
- (format #t "Loading image for ~a from ~a...~%" #$name #$tarball)
- (define line
- (read-line
- (open-input-pipe
- (string-append #$docker " load -i " #$tarball))))
-
- (unless (or (eof-object? line)
- (string-null? line))
- (format #t "~a~%" line)
- (let ((repository&tag
- (string-drop line
- (string-length
- "Loaded image: "))))
-
- (invoke #$docker "tag" repository&tag #$tag)
- (format #t "Tagged ~a with ~a...~%" #$tarball #$tag))))))))
-
-(define (oci-container-shepherd-service config)
- (define (guess-name name image)
- (if (maybe-value-set? name)
- name
- (string-append "docker-"
- (basename
- (if (string? image)
- (first (string-split image #\:))
- (oci-image-repository image))))))
-
- (let* ((docker (file-append docker-cli "/bin/docker"))
- (actions (oci-container-configuration-shepherd-actions config))
+ (ice-9 rdelim)
+ (srfi srfi-1))
+ (define object-exists?
+ #$(oci-object-exists? runtime runtime-cli "image" verbose?))
+ (define load-command
+ (string-append #$runtime-cli
+ " load -i " #$tarball))
+
+ (if (object-exists? #$tag #:format-string "{{.Repository}}:{{.Tag}}")
+ (format #t "~a image already exists, skipping.~%" #$tag)
+ (begin
+ (format #t "Loading image for ~a from ~a...~%" #$name #$tarball)
+ (when #$verbose?
+ (format #t "Running ~a~%" load-command))
+ (let ((line (read-line
+ (open-input-pipe load-command))))
+ (unless (or (eof-object? line)
+ (string-null? line))
+ (format #t "~a~%" line)
+ (let* ((repository&tag
+ (string-drop line
+ (string-length
+ "Loaded image: ")))
+ (tag-command
+ (list #$runtime-cli "tag" repository&tag #$tag))
+ (drop-old-tag-command
+ (list #$runtime-cli "image" "rm" "-f" repository&tag)))
+
+ (unless (string=? repository&tag #$tag)
+ (when #$verbose?
+ (format #t "Running~{ ~a~}~%" tag-command))
+
+ (let ((exit-code
+ (status:exit-val (apply system* tag-command))))
+ (format #t "Tagged ~a with ~a...~%" #$tarball #$tag)
+
+ (when #$verbose?
+ (format #t "Exit code: ~a~%" exit-code))
+
+ (when (equal? EXIT_SUCCESS exit-code)
+ (when #$verbose?
+ (format #t "Running~{ ~a~}~%" drop-old-tag-command))
+ (let ((drop-exit-code
+ (status:exit-val (apply system* drop-old-tag-command))))
+ (when #$verbose?
+ (format #t "Exit code: ~a~%" drop-exit-code))))))))))))))))
+
+(define (oci-container-run-invokation runtime-cli name command image-reference
+ options runtime-extra-arguments run-extra-arguments)
+ "Return a list representing the OCI runtime
+invokation for running containers."
+ ;; run [OPTIONS] IMAGE [COMMAND] [ARG...]
+ `(,runtime-cli ,@runtime-extra-arguments "run"
+ "--rm" "--name" ,name
+ ,@options ,@run-extra-arguments
+ ,image-reference ,@command))
+
+(define* (oci-container-entrypoint runtime runtime-cli name image image-reference
+ invokation #:key (verbose? #f))
+ "Return a file-like object that, once lowered, will evaluate to the entrypoint
+for the Shepherd service that will run IMAGE through RUNTIME-CLI."
+ (program-file
+ (string-append "oci-entrypoint-" name)
+ #~(begin
+ (use-modules (ice-9 format)
+ (srfi srfi-1))
+ (when #$verbose?
+ (format #t "Running in verbose mode...~%"))
+ (define invokation (list #$@invokation))
+ #$@(if (oci-image? image)
+ #~((system*
+ #$(oci-image-loader
+ runtime runtime-cli name image
+ image-reference #:verbose? verbose?)))
+ #~())
+ (when #$verbose?
+ (format #t "Running~{ ~a~}~%" invokation))
+ (apply execlp `(,(first invokation) ,@invokation)))))
+
+(define* (oci-container-shepherd-service runtime runtime-cli config
+ #:key
+ (runtime-environment #~())
+ (runtime-extra-arguments '())
+ (oci-requirement '())
+ (user #f)
+ (group #f)
+ (verbose? #f))
+ "Return a Shepherd service object that will run the OCI container represented
+by CONFIG through RUNTIME-CLI."
+ (let* ((actions (oci-container-configuration-shepherd-actions config))
(auto-start?
(oci-container-configuration-auto-start? config))
- (user (oci-container-configuration-user config))
- (group (oci-container-configuration-group config))
+ (maybe-user (oci-container-configuration-user config))
+ (maybe-group (oci-container-configuration-group config))
+ (user (if (maybe-value-set? maybe-user)
+ maybe-user
+ user))
+ (group (if (maybe-value-set? maybe-group)
+ maybe-group
+ group))
(host-environment
(oci-container-configuration-host-environment config))
(command (oci-container-configuration-command config))
(log-file (oci-container-configuration-log-file config))
- (provision (oci-container-configuration-provision config))
(requirement (oci-container-configuration-requirement config))
(respawn?
(oci-container-configuration-respawn? config))
(image (oci-container-configuration-image config))
(image-reference (oci-image-reference image))
(options (oci-container-configuration->options config))
- (name (guess-name provision image))
+ (name
+ (oci-container-shepherd-name runtime config))
(extra-arguments
- (oci-container-configuration-extra-arguments config)))
+ (oci-container-configuration-extra-arguments config))
+ (invokation
+ (oci-container-run-invokation
+ runtime-cli name command image-reference
+ options runtime-extra-arguments extra-arguments)))
(shepherd-service (provision `(,(string->symbol name)))
- (requirement `(dockerd user-processes ,@requirement))
+ (requirement `(,@oci-requirement
+ ,@requirement))
(respawn? respawn?)
(auto-start? auto-start?)
(documentation
(string-append
- "Docker backed Shepherd service for "
+ (oci-runtime-name runtime) " backed Shepherd service for "
(if (oci-image? image) name image) "."))
(start
#~(lambda ()
- #$@(if (oci-image? image)
- #~((invoke #$(%oci-image-loader
- name image image-reference)))
- #~())
(fork+exec-command
- ;; docker run [OPTIONS] IMAGE [COMMAND] [ARG...]
- (list #$docker "run" "--rm" "--name" #$name
- #$@options #$@extra-arguments
- #$image-reference #$@command)
- #:user #$user
- #:group #$group
+ (list
+ #$(oci-container-entrypoint
+ runtime runtime-cli name image image-reference
+ invokation #:verbose? verbose?))
+ #$@(if user (list #:user user) '())
+ #$@(if group (list #:group group) '())
#$@(if (maybe-value-set? log-file)
(list #:log-file log-file)
'())
+ #$@(if (and user (eq? runtime 'podman))
+ (list #:directory
+ #~(passwd:dir (getpwnam #$user)))
+ '())
#:environment-variables
- (list #$@host-environment))))
+ (append
+ (list #$@host-environment)
+ (list #$@runtime-environment)))))
(stop
#~(lambda _
- (invoke #$docker "rm" "-f" #$name)))
+ (invoke #$runtime-cli "rm" "-f" #$name)))
(actions
- (if (oci-image? image)
- '()
- (append
+ (append
+ (list
+ (oci-object-command-shepherd-action
+ name #~(string-join (list #$@invokation) " ")))
+ (if (oci-image? image)
+ '()
(list
- (shepherd-action
- (name 'pull)
- (documentation
- (format #f "Pull ~a's image (~a)."
- name image))
- (procedure
- #~(lambda _
- (invoke #$docker "pull" #$image)))))
- actions))))))
-
-(define %oci-container-accounts
+ (let ((service-name name))
+ (shepherd-action
+ (name 'pull)
+ (documentation
+ (format #f "Pull ~a's image (~a)."
+ service-name image))
+ (procedure
+ #~(lambda _
+ (invoke #$runtime-cli "pull" #$image)))))))
+ actions)))))
+
+(define (oci-object-create-invokation object runtime-cli name options
+ runtime-extra-arguments
+ create-extra-arguments)
+ "Return a gexp that, upon lowering, will evaluate to the OCI runtime
+invokation for creating networks and volumes."
+ ;; network|volume create [options] [NAME]
+ #~(list #$runtime-cli #$@runtime-extra-arguments #$object "create"
+ #$@options #$@create-extra-arguments #$name))
+
+(define (format-oci-invokations invokations)
+ "Return a gexp that, upon lowering, will evaluate to a formatted message
+containing the INVOKATIONS that the OCI runtime will execute to provision
+networks or volumes."
+ #~(string-join (map (lambda (i) (string-join i " "))
+ (list #$@invokations))
+ "\n"))
+
+(define* (oci-object-create-script object runtime runtime-cli invokations
+ #:key (verbose? #f))
+ "Return a file-like object that, once lowered, will evaluate to a program able
+to create OCI networks and volumes through RUNTIME-CLI."
+ (define runtime-string (symbol->string runtime))
+ (program-file
+ (string-append runtime-string "-" object "s-create.scm")
+ #~(begin
+ (use-modules (ice-9 format)
+ (ice-9 match)
+ (ice-9 popen)
+ (ice-9 rdelim)
+ (srfi srfi-1))
+
+ (define object-exists?
+ #$(oci-object-exists? runtime runtime-cli object verbose?))
+
+ (for-each
+ (lambda (invokation)
+ (define name (last invokation))
+ (if (object-exists? name)
+ (format #t "~a ~a ~a already exists, skipping creation.~%"
+ #$(oci-runtime-name runtime) name #$object)
+ (begin
+ (when #$verbose?
+ (format #t "Running~{ ~a~}~%" invokation))
+ (let ((exit-code (status:exit-val (apply system* invokation))))
+ (when #$verbose?
+ (format #t "Exit code: ~a~%" exit-code))))))
+ (list #$@invokations)))))
+
+(define* (oci-object-shepherd-service object runtime runtime-cli name requirement invokations
+ #:key
+ (runtime-environment #~())
+ (user #f)
+ (group #f)
+ (verbose? #f))
+ "Return a Shepherd service object that will create the OBJECTs represented
+by INVOKATIONS through RUNTIME-CLI."
+ (shepherd-service (provision `(,(string->symbol name)))
+ (requirement requirement)
+ (one-shot? #t)
+ (documentation
+ (string-append
+ (oci-runtime-name runtime) " " object
+ " provisioning service"))
+ (start
+ #~(lambda _
+ (fork+exec-command
+ (list
+ #$(oci-object-create-script
+ object runtime runtime-cli
+ invokations
+ #:verbose? verbose?))
+ #$@(if user (list #:user user) '())
+ #$@(if group (list #:group group) '())
+ #:environment-variables
+ (list #$@runtime-environment))))
+ (actions
+ (list
+ (oci-object-command-shepherd-action
+ name (format-oci-invokations invokations))))))
+
+(define* (oci-networks-shepherd-service runtime runtime-cli name networks
+ #:key (user #f) (group #f) (verbose? #f)
+ (runtime-extra-arguments '())
+ (runtime-environment #~())
+ (runtime-requirement '()))
+ "Return a Shepherd service object that will create the networks represented
+in CONFIG."
+ (let ((invokations
+ (map
+ (lambda (network)
+ (oci-object-create-invokation
+ "network" runtime-cli
+ (oci-network-configuration-name network)
+ (oci-network-configuration->options network)
+ runtime-extra-arguments
+ (oci-network-configuration-extra-arguments network)))
+ networks)))
+
+ (oci-object-shepherd-service
+ "network" runtime runtime-cli name
+ runtime-requirement invokations
+ #:user user #:group group #:runtime-environment runtime-environment
+ #:verbose? verbose?)))
+
+(define* (oci-volumes-shepherd-service runtime runtime-cli name volumes
+ #:key (user #f) (group #f) (verbose? #f)
+ (runtime-extra-arguments '())
+ (runtime-environment #~())
+ (runtime-requirement '()))
+ "Return a Shepherd service object that will create the volumes represented
+in CONFIG."
+ (let ((invokations
+ (map
+ (lambda (volume)
+ (oci-object-create-invokation
+ "volume" runtime-cli
+ (oci-volume-configuration-name volume)
+ (oci-volume-configuration->options volume)
+ runtime-extra-arguments
+ (oci-volume-configuration-extra-arguments volume)))
+ volumes)))
+
+ (oci-object-shepherd-service
+ "volume" runtime runtime-cli name runtime-requirement invokations
+ #:user user #:group group #:runtime-environment runtime-environment
+ #:verbose? verbose?)))
+
+(define (oci-service-accounts config)
+ (define user (oci-configuration-user config))
+ (define maybe-group (oci-configuration-group config))
+ (define runtime (oci-configuration-runtime config))
(list (user-account
- (name "oci-container")
+ (name user)
(comment "OCI services account")
- (group "docker")
- (system? #t)
- (home-directory "/var/empty")
+ (group "users")
+ (supplementary-groups
+ (list (oci-runtime-group runtime maybe-group)))
+ (system? (eq? 'docker runtime))
+ (home-directory (if (eq? 'podman runtime)
+ (string-append "/home/" user)
+ "/var/empty"))
+ (create-home-directory? (eq? 'podman runtime))
(shell (file-append shadow "/sbin/nologin")))))
+
+(define* (oci-state->shepherd-services runtime runtime-cli containers networks volumes
+ #:key (user #f) (group #f) (verbose? #f)
+ (networks-name #f) (volumes-name #f)
+ (runtime-extra-arguments '())
+ (runtime-environment #~())
+ (runtime-requirement '())
+ (containers-requirement '())
+ (networks-requirement '())
+ (volumes-requirement '()))
+ (let* ((networks-name
+ (if (string? networks-name)
+ networks-name
+ (oci-networks-shepherd-name runtime)))
+ (networks?
+ (> (length networks) 0))
+ (networks-service
+ (if networks?
+ (list
+ (string->symbol networks-name))
+ '()))
+ (volumes-name
+ (if (string? volumes-name)
+ volumes-name
+ (oci-volumes-shepherd-name runtime)))
+ (volumes?
+ (> (length volumes) 0))
+ (volumes-service
+ (if volumes?
+ (list (string->symbol volumes-name))
+ '())))
+ (append
+ (map
+ (lambda (c)
+ (oci-container-shepherd-service
+ runtime runtime-cli c
+ #:user user
+ #:group group
+ #:runtime-environment runtime-environment
+ #:runtime-extra-arguments runtime-extra-arguments
+ #:oci-requirement
+ (append containers-requirement
+ runtime-requirement
+ networks-service
+ volumes-service)
+ #:verbose? verbose?))
+ containers)
+ (if networks?
+ (list
+ (oci-networks-shepherd-service
+ runtime runtime-cli
+ networks-name networks
+ #:user user #:group group
+ #:runtime-extra-arguments runtime-extra-arguments
+ #:runtime-environment runtime-environment
+ #:runtime-requirement (append networks-requirement
+ runtime-requirement)
+ #:verbose? verbose?))
+ '())
+ (if volumes?
+ (list
+ (oci-volumes-shepherd-service
+ runtime runtime-cli
+ volumes-name volumes
+ #:user user #:group group
+ #:runtime-extra-arguments runtime-extra-arguments
+ #:runtime-environment runtime-environment
+ #:runtime-requirement (append runtime-requirement
+ volumes-requirement)
+ #:verbose? verbose?))
+ '()))))
+
+(define (oci-configuration->shepherd-services config)
+ (let* ((runtime (oci-configuration-runtime config))
+ (system-runtime-cli
+ (oci-runtime-system-cli config))
+ (home-runtime-cli
+ (oci-runtime-home-cli config))
+ (runtime-extra-arguments
+ (oci-configuration-runtime-extra-arguments config))
+ (containers (oci-configuration-containers config))
+ (networks (oci-configuration-networks config))
+ (volumes (oci-configuration-volumes config))
+ (user (oci-configuration-user config))
+ (group (oci-runtime-group
+ runtime (oci-configuration-group config)))
+ (verbose? (oci-configuration-verbose? config))
+ (home-service?
+ (oci-configuration-home-service? config)))
+ (if home-service?
+ (oci-state->shepherd-services runtime home-runtime-cli containers networks volumes
+ #:verbose? verbose?
+ #:networks-name
+ (oci-networks-home-shepherd-name runtime)
+ #:volumes-name
+ (oci-volumes-home-shepherd-name runtime))
+ (oci-state->shepherd-services runtime system-runtime-cli containers networks volumes
+ #:user user
+ #:group
+ (oci-runtime-system-group runtime user group)
+ #:verbose? verbose?
+ #:runtime-extra-arguments
+ runtime-extra-arguments
+ #:runtime-environment
+ (oci-runtime-system-environment runtime user)
+ #:runtime-requirement
+ (oci-runtime-system-requirement runtime)
+ #:networks-requirement '(networking)))))
+
+(define (oci-service-subids config)
+ "Return a subids-extension record representing subuids and subgids required by
+the rootless Podman backend."
+ (define (delete-duplicate-ranges ranges)
+ (delete-duplicates ranges
+ (lambda args
+ (apply string=? (map subid-range-name ranges)))))
+ (define runtime
+ (oci-configuration-runtime config))
+ (define user
+ (oci-configuration-user config))
+ (define subgids (oci-configuration-subgids-range config))
+ (define subuids (oci-configuration-subuids-range config))
+ (define container-users
+ (filter (lambda (range)
+ (and (maybe-value-set?
+ (subid-range-name range))
+ (not (string=? (subid-range-name range) user))))
+ (map (lambda (container)
+ (subid-range
+ (name
+ (oci-container-configuration-user container))))
+ (oci-configuration-containers config))))
+ (define subgid-ranges
+ (delete-duplicate-ranges
+ (cons
+ (if (eq? subgids #f)
+ (subid-range (name user))
+ subgids)
+ container-users)))
+ (define subuid-ranges
+ (delete-duplicate-ranges
+ (cons
+ (if (eq? subuids #f)
+ (subid-range (name user))
+ subuids)
+ container-users)))
+
+ (if (eq? 'podman runtime)
+ (subids-extension
+ (subgids
+ subgid-ranges)
+ (subuids
+ subuid-ranges))
+ (subids-extension)))
+
+(define (oci-objects-merge-lst a b object get-name)
+ (define (contains? value lst)
+ (member value (map get-name lst)))
+ (let loop ((merged '())
+ (lst (append a b)))
+ (if (null? lst)
+ merged
+ (loop
+ (let ((element (car lst)))
+ (when (contains? element merged)
+ (raise
+ (formatted-message
+ (G_ "Duplicated ~a: ~a. ~as names should be unique, please
+remove the duplicate.") object (get-name element) object)))
+ (cons element merged))
+ (cdr lst)))))
+
+(define (oci-extension-merge a b)
+ (oci-extension
+ (containers (oci-objects-merge-lst
+ (oci-extension-containers a)
+ (oci-extension-containers b)
+ "container"
+ (lambda (config)
+ (define maybe-name (oci-container-configuration-provision config))
+ (if (maybe-value-set? maybe-name)
+ maybe-name
+ (oci-image->container-name
+ (oci-container-configuration-image config))))))
+ (networks (oci-objects-merge-lst
+ (oci-extension-networks a)
+ (oci-extension-networks b)
+ "network"
+ oci-network-configuration-name))
+ (volumes (oci-objects-merge-lst
+ (oci-extension-volumes a)
+ (oci-extension-volumes b)
+ "volume"
+ oci-volume-configuration-name))))
+
+(define (oci-service-profile runtime runtime-cli)
+ `(,bash-minimal
+ ,@(if (string? runtime-cli)
+ '()
+ (list
+ (cond
+ ((not (eq? runtime-cli #f))
+ runtime-cli)
+ ((eq? 'podman runtime)
+ podman)
+ (else
+ docker-cli))))))
+
+(define (oci-service-extension-wrap-validate extension)
+ (lambda (config)
+ (if (oci-configuration-valid? config)
+ (extension config)
+ (raise
+ (formatted-message
+ (G_ "Invalide oci-configuration ~a.") config)))))
+
+(define (oci-configuration-extend config extension)
+ (oci-configuration
+ (inherit config)
+ (containers
+ (oci-objects-merge-lst
+ (oci-configuration-containers config)
+ (oci-extension-containers extension)
+ "container"
+ (lambda (oci-config)
+ (define runtime
+ (oci-configuration-runtime config))
+ (oci-container-shepherd-name runtime oci-config))))
+ (networks (oci-objects-merge-lst
+ (oci-configuration-networks config)
+ (oci-extension-networks extension)
+ "network"
+ oci-network-configuration-name))
+ (volumes (oci-objects-merge-lst
+ (oci-configuration-volumes config)
+ (oci-extension-volumes extension)
+ "volume"
+ oci-volume-configuration-name))))
+
+(define oci-service-type
+ (service-type (name 'oci)
+ (extensions
+ (list
+ (service-extension profile-service-type
+ (oci-service-extension-wrap-validate
+ (lambda (config)
+ (let ((runtime-cli
+ (oci-configuration-runtime-cli config))
+ (runtime
+ (oci-configuration-runtime config)))
+ (oci-service-profile runtime runtime-cli)))))
+ (service-extension subids-service-type
+ (oci-service-extension-wrap-validate
+ oci-service-subids))
+ (service-extension account-service-type
+ (oci-service-extension-wrap-validate
+ oci-service-accounts))
+ (service-extension shepherd-root-service-type
+ (oci-service-extension-wrap-validate
+ oci-configuration->shepherd-services))))
+ ;; Concatenate OCI object lists.
+ (compose (lambda (args)
+ (fold oci-extension-merge
+ (oci-extension)
+ args)))
+ (extend oci-configuration-extend)
+ (default-value (oci-configuration))
+ (description
+ "This service implements the provisioning of OCI object such
+as containers, networks and volumes.")))
diff --git a/gnu/services/docker.scm b/gnu/services/docker.scm
index 69ff9f1d9e4..98ee175873d 100644
--- a/gnu/services/docker.scm
+++ b/gnu/services/docker.scm
@@ -31,7 +31,10 @@ (define-module (gnu services docker)
#:use-module (gnu system shadow)
#:use-module (gnu packages docker)
#:use-module (gnu packages linux) ;singularity
+ #:use-module (guix deprecation)
+ #:use-module (guix diagnostics)
#:use-module (guix gexp)
+ #:use-module (guix i18n)
#:use-module (guix records)
#:use-module (srfi srfi-1)
#:use-module (ice-9 format)
@@ -67,16 +70,18 @@ (define-module (gnu services docker)
oci-container-configuration-volumes
oci-container-configuration-container-user
oci-container-configuration-workdir
- oci-container-configuration-extra-arguments
- oci-container-shepherd-service
- %oci-container-accounts)
+ oci-container-configuration-extra-arguments)
#:export (containerd-configuration
containerd-service-type
docker-configuration
docker-service-type
singularity-service-type
- oci-container-service-type))
+ ;; for backwards compatibility, until the
+ ;; oci-container-service-type is fully deprecated
+ oci-container-shepherd-service
+ oci-container-service-type
+ %oci-container-accounts))
(define-maybe file-like)
@@ -295,17 +300,25 @@ (define singularity-service-type
;;; OCI container.
;;;
-(define (configs->shepherd-services configs)
- (map oci-container-shepherd-service configs))
+;; for backwards compatibility, until the
+;; oci-container-service-type is fully deprecated
+(define-deprecated (oci-container-shepherd-service config)
+ oci-service-type
+ ((@ (gnu services containers) oci-container-shepherd-service)
+ 'docker config))
+(define %oci-container-accounts
+ (filter user-account? (oci-service-accounts (oci-configuration))))
(define oci-container-service-type
(service-type (name 'oci-container)
- (extensions (list (service-extension profile-service-type
- (lambda _ (list docker-cli)))
- (service-extension account-service-type
- (const %oci-container-accounts))
- (service-extension shepherd-root-service-type
- configs->shepherd-services)))
+ (extensions
+ (list (service-extension oci-service-type
+ (lambda (containers)
+ (warning
+ (G_
+ "'oci-container-service-type' is deprecated, use 'oci-service-type' instead~%"))
+ (oci-extension
+ (containers containers))))))
(default-value '())
(extend append)
(compose concatenate)
diff --git a/gnu/tests/containers.scm b/gnu/tests/containers.scm
index 0ecc8ddb126..5e6f39387e7 100644
--- a/gnu/tests/containers.scm
+++ b/gnu/tests/containers.scm
@@ -27,6 +27,9 @@ (define-module (gnu tests containers)
#:use-module (gnu services)
#:use-module (gnu services containers)
#:use-module (gnu services desktop)
+ #:use-module ((gnu services docker)
+ #:select (containerd-service-type
+ docker-service-type))
#:use-module (gnu services dbus)
#:use-module (gnu services networking)
#:use-module (gnu system)
@@ -39,7 +42,9 @@ (define-module (gnu tests containers)
#:use-module (guix profiles)
#:use-module ((guix scripts pack) #:prefix pack:)
#:use-module (guix store)
- #:export (%test-rootless-podman))
+ #:export (%test-rootless-podman
+ %test-oci-service-rootless-podman
+ %test-oci-service-docker))
(define %rootless-podman-os
@@ -345,3 +350,995 @@ (define %test-rootless-podman
(name "rootless-podman")
(description "Test rootless Podman service.")
(value (build-tarball&run-rootless-podman-test))))
+
+
+(define %oci-rootless-podman-os
+ (simple-operating-system
+ (service dhcp-client-service-type)
+ (service dbus-root-service-type)
+ (service polkit-service-type)
+ (service elogind-service-type)
+ (service iptables-service-type)
+ (service rootless-podman-service-type)
+ (extra-special-file "/shared.txt"
+ (plain-file "shared.txt" "hello"))
+ (service oci-service-type
+ (oci-configuration
+ (runtime 'podman)
+ (verbose? #t)))
+ (simple-service 'oci-provisioning
+ oci-service-type
+ (oci-extension
+ (networks
+ (list (oci-network-configuration (name "my-network"))))
+ (volumes
+ (list (oci-volume-configuration (name "my-volume"))))
+ (containers
+ (list
+ (oci-container-configuration
+ (provision "first")
+ (image
+ (oci-image
+ (repository "guile")
+ (value
+ (specifications->manifest '("guile")))
+ (pack-options
+ '(#:symlinks (("/bin" -> "bin"))))))
+ (entrypoint "/bin/guile")
+ (network "my-network")
+ (command
+ '("-c" "(use-modules (web server))
+(define (handler request request-body)
+ (values '((content-type . (text/plain))) \"out of office\"))
+(run-server handler 'http `(#:addr ,(inet-pton AF_INET \"0.0.0.0\")))"))
+ (host-environment
+ '(("VARIABLE" . "value")))
+ (volumes
+ '(("my-volume" . "/my-volume")))
+ (extra-arguments
+ '("--env" "VARIABLE")))
+ (oci-container-configuration
+ (provision "second")
+ (image
+ (oci-image
+ (repository "guile")
+ (value
+ (specifications->manifest '("guile")))
+ (pack-options
+ '(#:symlinks (("/bin" -> "bin"))))))
+ (entrypoint "/bin/guile")
+ (network "my-network")
+ (command
+ '("-c" "(let l ((c 300))(display c)(sleep 1)(when(positive? c)(l (- c 1))))"))
+ (volumes
+ '(("my-volume" . "/my-volume")
+ ("/shared.txt" . "/shared.txt:ro"))))))))))
+
+(define (run-rootless-podman-oci-service-test)
+ (define os
+ (marionette-operating-system
+ (operating-system-with-gc-roots
+ %oci-rootless-podman-os
+ (list))
+ #: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))
+ #~(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-oci-service")
+
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (wait-for-service 'user-processes))
+ marionette)
+
+ (test-assert "rootless-podman services started successfully"
+ (begin
+ (define (run-test)
+ (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))
+ ;; Allow services to come up on slower machines
+ (let loop ((attempts 0))
+ (if (= attempts 60)
+ (error "Services didn't come up after more than 60 seconds")
+ (if (equal? '("cgroup" "cgroup")
+ (run-test))
+ #t
+ (begin
+ (sleep 1)
+ (format #t "Services didn't come up yet, retrying with attempt ~a~%"
+ (+ 1 attempts))
+ (loop (+ 1 attempts))))))))
+
+ (test-assert "podman-volumes running"
+ (begin
+ (define (run-test)
+ (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 6))
+ (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 "oci-container")))
+ (setuid (passwd:uid (getpw "oci-container")))
+
+ (let ((response (slurp
+ "/run/current-system/profile/bin/podman"
+ "volume" "ls" "-n" "--format" "\"{{.Name}}\""
+ "|" "tr" "' '" "'\n'")))
+
+ (call-with-output-file (string-append ,out-dir "/response")
+ (lambda (port)
+ (display (string-join response "\n") port)))))
+ (lambda ()
+ (primitive-exit 127))))
+ (pid
+ (cdr (waitpid pid))))
+
+ (wait-for-file (string-append ,out-dir "/response"))
+
+ (stable-sort
+ (slurp "cat" (string-append ,out-dir "/response"))
+ string<=?))
+ marionette))
+ ;; Allow services to come up on slower machines
+ (let loop ((attempts 0))
+ (if (= attempts 80)
+ (error "Service didn't come up after more than 80 seconds")
+ (if (equal? '("my-volume")
+ (run-test))
+ #t
+ (begin
+ (sleep 1)
+ (loop (+ 1 attempts))))))))
+
+ (test-assert "podman-networks running"
+ (begin
+ (define (run-test)
+ (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 6))
+ (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 "oci-container")))
+ (setuid (passwd:uid (getpw "oci-container")))
+
+ (let ((response (slurp
+ "/run/current-system/profile/bin/podman"
+ "network" "ls" "-n" "--format" "\"{{.Name}}\""
+ "|" "tr" "' '" "'\n'")))
+
+ (call-with-output-file (string-append ,out-dir "/response")
+ (lambda (port)
+ (display (string-join response "\n") port)))))
+ (lambda ()
+ (primitive-exit 127))))
+ (pid
+ (cdr (waitpid pid))))
+
+ (wait-for-file (string-append ,out-dir "/response"))
+
+ (stable-sort
+ (slurp "cat" (string-append ,out-dir "/response"))
+ string<=?))
+ marionette))
+ ;; Allow services to come up on slower machines
+ (let loop ((attempts 0))
+ (if (= attempts 80)
+ (error "Service didn't come up after more than 80 seconds")
+ (if (equal? '("my-network" "podman")
+ (run-test))
+ #t
+ (begin
+ (sleep 1)
+ (loop (+ 1 attempts))))))))
+
+ (test-assert "first container running"
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (wait-for-service 'first #:timeout 120)
+ #t)
+ marionette))
+
+ (test-assert "second container running"
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (wait-for-service 'second #:timeout 120)
+ #t)
+ marionette))
+
+ (test-assert "passing host environment variables"
+ (begin
+ (define (run-test)
+ (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 "oci-container")))
+ (setuid (passwd:uid (getpw "oci-container")))
+
+ (let ((response (slurp
+ "/run/current-system/profile/bin/podman"
+ "exec" "first"
+ "/bin/guile" "-c" "'(display (getenv \"VARIABLE\"))'")))
+ (call-with-output-file (string-append ,out-dir "/response")
+ (lambda (port)
+ (display (string-join response "\n") port)))))
+ (lambda ()
+ (primitive-exit 127))))
+ (pid
+ (cdr (waitpid pid))))
+
+ (wait-for-file (string-append ,out-dir "/response"))
+ (slurp "cat" (string-append ,out-dir "/response")))
+ marionette))
+ ;; Allow image to be loaded on slower machines
+ (let loop ((attempts 0))
+ (if (= attempts 180)
+ (error "Service didn't come up after more than 180 seconds")
+ (if (equal? (list "value")
+ (run-test))
+ #t
+ (begin
+ (sleep 1)
+ (loop (+ 1 attempts))))))))
+
+ (test-equal "mounting host files"
+ '("hello")
+ (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 "oci-container")))
+ (setuid (passwd:uid (getpw "oci-container")))
+
+ (let ((response (slurp
+ "/run/current-system/profile/bin/podman"
+ "exec" "second"
+ "/bin/guile" "-c" "'(begin (use-modules (ice-9 popen) (ice-9 rdelim))
+(display (call-with-input-file \"/shared.txt\" read-line)))'")))
+ (call-with-output-file (string-append ,out-dir "/response")
+ (lambda (port)
+ (display (string-join response " ") port)))))
+ (lambda ()
+ (primitive-exit 127))))
+ (pid
+ (cdr (waitpid pid))))
+
+ (wait-for-file (string-append ,out-dir "/response"))
+ (slurp "cat" (string-append ,out-dir "/response")))
+ marionette))
+
+ (test-equal "write to volumes"
+ '("world")
+ (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 "oci-container")))
+ (setuid (passwd:uid (getpw "oci-container")))
+
+ (slurp
+ "/run/current-system/profile/bin/podman"
+ "exec" "first"
+ "/bin/guile" "-c" "'(begin (use-modules (ice-9 popen) (ice-9 rdelim))
+(call-with-output-file \"/my-volume/out.txt\" (lambda (p) (display \"world\" p))))'")
+
+ (let ((response (slurp
+ "/run/current-system/profile/bin/podman"
+ "exec" "second"
+ "/bin/guile" "-c" "'(begin (use-modules (ice-9 popen) (ice-9 rdelim))
+(display (call-with-input-file \"/my-volume/out.txt\" read-line)))'")))
+ (call-with-output-file (string-append ,out-dir "/response")
+ (lambda (port)
+ (display (string-join response " ") port)))))
+ (lambda ()
+ (primitive-exit 127))))
+ (pid
+ (cdr (waitpid pid))))
+
+ (wait-for-file (string-append ,out-dir "/response"))
+ (slurp "cat" (string-append ,out-dir "/response")))
+ marionette))
+
+ (test-equal "can read ports over network"
+ '("out of office")
+ (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 "oci-container")))
+ (setuid (passwd:uid (getpw "oci-container")))
+
+ (let ((response (slurp
+ "/run/current-system/profile/bin/podman"
+ "exec" "second"
+ "/bin/guile" "-c" "'(begin (use-modules (web client))
+(define-values (response out)
+ (http-get \"http://first:8080\"))
+(display out))'")))
+ (call-with-output-file (string-append ,out-dir "/response")
+ (lambda (port)
+ (display (string-join response " ") port)))))
+ (lambda ()
+ (primitive-exit 127))))
+ (pid
+ (cdr (waitpid pid))))
+
+ (wait-for-file (string-append ,out-dir "/response"))
+ (slurp "cat" (string-append ,out-dir "/response")))
+ marionette))
+
+ (test-end))))
+
+ (gexp->derivation "rootless-podman-oci-service-test" test))
+
+(define %test-oci-service-rootless-podman
+ (system-test
+ (name "oci-service-rootless-podman")
+ (description "Test Rootless-Podman backed OCI provisioning service.")
+ (value (run-rootless-podman-oci-service-test))))
+
+(define %oci-docker-os
+ (simple-operating-system
+ (service dhcp-client-service-type)
+ (service dbus-root-service-type)
+ (service polkit-service-type)
+ (service elogind-service-type)
+ (service containerd-service-type)
+ (service docker-service-type)
+ (extra-special-file "/shared.txt"
+ (plain-file "shared.txt" "hello"))
+ (service oci-service-type
+ (oci-configuration
+ (verbose? #t)))
+ (simple-service 'oci-provisioning
+ oci-service-type
+ (oci-extension
+ (networks
+ (list (oci-network-configuration (name "my-network"))))
+ (volumes
+ (list (oci-volume-configuration (name "my-volume"))))
+ (containers
+ (list
+ (oci-container-configuration
+ (provision "first")
+ (image
+ (oci-image
+ (repository "guile")
+ (value
+ (specifications->manifest '("guile")))
+ (pack-options
+ '(#:symlinks (("/bin" -> "bin"))))))
+ (entrypoint "/bin/guile")
+ (network "my-network")
+ (command
+ '("-c" "(use-modules (web server))
+(define (handler request request-body)
+ (values '((content-type . (text/plain))) \"out of office\"))
+(run-server handler 'http `(#:addr ,(inet-pton AF_INET \"0.0.0.0\")))"))
+ (host-environment
+ '(("VARIABLE" . "value")))
+ (volumes
+ '(("my-volume" . "/my-volume")))
+ (extra-arguments
+ '("--env" "VARIABLE")))
+ (oci-container-configuration
+ (provision "second")
+ (image
+ (oci-image
+ (repository "guile")
+ (value
+ (specifications->manifest '("guile")))
+ (pack-options
+ '(#:symlinks (("/bin" -> "bin"))))))
+ (entrypoint "/bin/guile")
+ (network "my-network")
+ (command
+ '("-c" "(let l ((c 300))(display c)(sleep 1)(when(positive? c)(l (- c 1))))"))
+ (volumes
+ '(("my-volume" . "/my-volume")
+ ("/shared.txt" . "/shared.txt:ro"))))))))))
+
+(define (run-docker-oci-service-test)
+ (define os
+ (marionette-operating-system
+ (operating-system-with-gc-roots
+ %oci-docker-os
+ (list))
+ #: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))
+ #~(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))
+
+ (test-runner-current (system-test-runner #$output))
+ (test-begin "docker-oci-service")
+
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (wait-for-service 'dockerd))
+ marionette)
+
+ (test-assert "docker-volumes running"
+ (begin
+ (define (run-test)
+ (marionette-eval
+ `(begin
+ (use-modules (ice-9 popen)
+ (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
+ (list "sh" "-l" "-c"
+ (string-join
+ args
+ " "))))
+ (output (read-lines port))
+ (status (close-pipe port)))
+ output)))
+
+ (stable-sort
+ (slurp
+ "/run/current-system/profile/bin/docker"
+ "volume" "ls" "--format" "\"{{.Name}}\"")
+ string<=?))
+
+ marionette))
+ ;; Allow services to come up on slower machines
+ (let loop ((attempts 0))
+ (if (= attempts 80)
+ (error "Service didn't come up after more than 80 seconds")
+ (if (equal? '("my-volume")
+ (run-test))
+ #t
+ (begin
+ (sleep 1)
+ (loop (+ 1 attempts))))))))
+
+ (test-assert "docker-networks running"
+ (begin
+ (define (run-test)
+ (marionette-eval
+ `(begin
+ (use-modules (ice-9 popen)
+ (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
+ (list "sh" "-l" "-c"
+ (string-join
+ args
+ " "))))
+ (output (read-lines port))
+ (status (close-pipe port)))
+ output)))
+
+ (stable-sort
+ (slurp
+ "/run/current-system/profile/bin/docker"
+ "network" "ls" "--format" "\"{{.Name}}\"")
+ string<=?))
+
+ marionette))
+ ;; Allow services to come up on slower machines
+ (let loop ((attempts 0))
+ (if (= attempts 80)
+ (error "Service didn't come up after more than 80 seconds")
+ (if (equal? '("bridge" "host" "my-network" "none")
+ (run-test))
+ #t
+ (begin
+ (sleep 1)
+ (loop (+ 1 attempts))))))))
+
+ (test-assert "first container running"
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (wait-for-service 'first #:timeout 120)
+ #t)
+ marionette))
+
+ (test-assert "second container running"
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (wait-for-service 'second #:timeout 120)
+ #t)
+ marionette))
+
+ (test-assert "passing host environment variables"
+ (begin
+ (define (run-test)
+ (marionette-eval
+ `(begin
+ (use-modules (ice-9 popen)
+ (ice-9 rdelim))
+
+ (define slurp
+ (lambda args
+ (let* ((port (apply open-pipe* OPEN_READ args))
+ (output (let ((line (read-line port)))
+ (if (eof-object? line)
+ ""
+ line)))
+ (status (close-pipe port)))
+ output)))
+
+ (slurp
+ "/run/current-system/profile/bin/docker"
+ "exec" "first"
+ "/bin/guile" "-c" "(display (getenv \"VARIABLE\"))"))
+ marionette))
+ ;; Allow image to be loaded on slower machines
+ (let loop ((attempts 0))
+ (if (= attempts 180)
+ (error "Service didn't come up after more than 180 seconds")
+ (if (equal? "value"
+ (run-test))
+ #t
+ (begin
+ (sleep 1)
+ (loop (+ 1 attempts))))))))
+
+ (test-equal "mounting host files"
+ "hello"
+ (marionette-eval
+ `(begin
+ (use-modules (ice-9 popen)
+ (ice-9 rdelim))
+
+ (define slurp
+ (lambda args
+ (let* ((port (apply open-pipe* OPEN_READ args))
+ (output (let ((line (read-line port)))
+ (if (eof-object? line)
+ ""
+ line)))
+ (status (close-pipe port)))
+ output)))
+
+ (slurp
+ "/run/current-system/profile/bin/docker"
+ "exec" "second"
+ "/bin/guile" "-c" "(begin (use-modules (ice-9 popen) (ice-9 rdelim))
+(display (call-with-input-file \"/shared.txt\" read-line)))"))
+ marionette))
+
+ (test-equal "write to volumes"
+ "world"
+ (marionette-eval
+ `(begin
+ (use-modules (ice-9 popen)
+ (ice-9 rdelim))
+
+ (define slurp
+ (lambda args
+ (let* ((port (apply open-pipe* OPEN_READ args))
+ (output (let ((line (read-line port)))
+ (if (eof-object? line)
+ ""
+ line)))
+ (status (close-pipe port)))
+ output)))
+
+ (slurp
+ "/run/current-system/profile/bin/docker"
+ "exec" "first"
+ "/bin/guile" "-c" "(begin (use-modules (ice-9 popen) (ice-9 rdelim))
+(call-with-output-file \"/my-volume/out.txt\" (lambda (p) (display \"world\" p))))")
+ (slurp
+ "/run/current-system/profile/bin/docker"
+ "exec" "second"
+ "/bin/guile" "-c" "(begin (use-modules (ice-9 popen) (ice-9 rdelim))
+(display (call-with-input-file \"/my-volume/out.txt\" read-line)))"))
+ marionette))
+
+ (test-equal "can read ports over network"
+ "out of office"
+ (marionette-eval
+ `(begin
+ (use-modules (ice-9 popen)
+ (ice-9 rdelim))
+
+ (define slurp
+ (lambda args
+ (let* ((port (apply open-pipe* OPEN_READ args))
+ (output (let ((line (read-line port)))
+ (if (eof-object? line)
+ ""
+ line)))
+ (status (close-pipe port)))
+ output)))
+
+ (slurp
+ "/run/current-system/profile/bin/docker"
+ "exec" "second"
+ "/bin/guile" "-c" "(begin (use-modules (web client))
+(define-values (response out)
+ (http-get \"http://first:8080\"))
+(display out))"))
+ marionette))
+
+ (test-end))))
+
+ (gexp->derivation "docker-oci-service-test" test))
+
+(define %test-oci-service-docker
+ (system-test
+ (name "oci-service-docker")
+ (description "Test Docker backed OCI provisioning service.")
+ (value (run-docker-oci-service-test))))
--
2.48.1
guix-patches <at> gnu.org:bug#76081; Package guix-patches.
(Wed, 19 Feb 2025 00:10:03 GMT) Full text and rfc822 format available.Message #71 received at 76081 <at> debbugs.gnu.org (full text, mbox):
From: Giacomo Leidi <goodoldpaul <at> autistici.org> To: 76081 <at> debbugs.gnu.org Cc: Giacomo Leidi <goodoldpaul <at> autistici.org> Subject: [PATCH v5 1/5] services: rootless-podman: Use login shell. Date: Wed, 19 Feb 2025 01:09:18 +0100
This commit allows for having PATH set when changing the owner of
/sys/fs/group.
* gnu/services/containers.scm (crgroups-fs-owner): Use login shell.
Change-Id: I9510c637a5332325e05ca5ebc9dfd4de32685c50
---
gnu/services/containers.scm | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm
index 19d35ccbcb6..dc66ac4f967 100644
--- a/gnu/services/containers.scm
+++ b/gnu/services/containers.scm
@@ -140,7 +140,7 @@ (define (cgroups-fs-owner-entrypoint config)
(rootless-podman-configuration-group-name config))
(program-file "cgroups2-fs-owner-entrypoint"
#~(system*
- (string-append #+bash-minimal "/bin/bash") "-c"
+ (string-append #+bash-minimal "/bin/bash") "-l" "-c"
(string-append "echo Setting /sys/fs/cgroup "
"group ownership to " #$group " && chown -v "
"root:" #$group " /sys/fs/cgroup && "
base-commit: 3dc8026d58f9480547a595450a6483e0f13c1ba4
--
2.48.1
guix-patches <at> gnu.org:bug#76081; Package guix-patches.
(Wed, 19 Feb 2025 00:10:04 GMT) Full text and rfc822 format available.Message #74 received at 76081 <at> debbugs.gnu.org (full text, mbox):
From: Giacomo Leidi <goodoldpaul <at> autistici.org> To: 76081 <at> debbugs.gnu.org Cc: Giacomo Leidi <goodoldpaul <at> autistici.org> Subject: [PATCH v5 4/5] tests: Use lower-oci-image-state in container tests. Date: Wed, 19 Feb 2025 01:09:21 +0100
This patch replaces boilerplate in container related tests with
oci-image plumbing from (gnu services containers).
* gnu/services/containers.scm: Export lower-oci-image-state.
* gnu/tests/containers.scm (%oci-tarball): New variable;
(run-rootless-podman-test): use %oci-tarball;
(build-tarball&run-rootless-podman-test): drop procedure.
* gnu/tests/docker.scm (%docker-tarball): New variable;
(build-tarball&run-docker-test): use %docker-tarball;
(%docker-system-tarball): New variable;
(build-tarball&run-docker-system-test): new procedure.
Change-Id: Iad6f0704aee188d89464c83722dea0bb7adb084a
---
gnu/services/containers.scm | 2 +
gnu/tests/containers.scm | 80 ++++++++++++++---------------
gnu/tests/docker.scm | 100 ++++++++++++++++++++----------------
3 files changed, 95 insertions(+), 87 deletions(-)
diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm
index bd1b6f14356..8b57ac57798 100644
--- a/gnu/services/containers.scm
+++ b/gnu/services/containers.scm
@@ -75,6 +75,8 @@ (define-module (gnu services containers)
oci-image-system
oci-image-grafts?
+ lower-oci-image-state
+
oci-container-configuration
oci-container-configuration?
oci-container-configuration-fields
diff --git a/gnu/tests/containers.scm b/gnu/tests/containers.scm
index 5e6f39387e7..8cdd86e7ae3 100644
--- a/gnu/tests/containers.scm
+++ b/gnu/tests/containers.scm
@@ -69,13 +69,47 @@ (define %rootless-podman-os
(supplementary-groups '("wheel" "netdev" "cgroup"
"audio" "video")))))))
-(define (run-rootless-podman-test oci-tarball)
+(define %oci-tarball
+ (lower-oci-image-state
+ "guile-guest"
+ (packages->manifest
+ (list
+ guile-3.0 guile-json-3
+ (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))))
+ '(#:entry-point "bin/guile"
+ #:localstatedir? #t
+ #:extra-options (#:image-tag "guile-guest")
+ #:symlinks (("/bin/Guile" -> "bin/guile")
+ ("aa.scm" -> "a.scm")))
+ "guile-guest"
+ (%current-target-system)
+ (%current-system)
+ #f))
+
+(define (run-rootless-podman-test)
(define os
(marionette-operating-system
(operating-system-with-gc-roots
%rootless-podman-os
- (list oci-tarball))
+ (list %oci-tarball))
#:imported-modules '((gnu services herd)
(guix combinators))))
@@ -254,7 +288,7 @@ (define (run-rootless-podman-test oci-tarball)
(let* ((loaded (slurp ,(string-append #$podman
"/bin/podman")
"load" "-i"
- ,#$oci-tarball))
+ ,#$%oci-tarball))
(repository&tag "localhost/guile-guest:latest")
(response1 (slurp
,(string-append #$podman "/bin/podman")
@@ -307,49 +341,11 @@ (define (run-rootless-podman-test oci-tarball)
(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))))
+ (value (run-rootless-podman-test))))
(define %oci-rootless-podman-os
diff --git a/gnu/tests/docker.scm b/gnu/tests/docker.scm
index 5dcf05a17e3..07edd9d5341 100644
--- a/gnu/tests/docker.scm
+++ b/gnu/tests/docker.scm
@@ -26,6 +26,7 @@ (define-module (gnu tests docker)
#:use-module (gnu system image)
#:use-module (gnu system vm)
#:use-module (gnu services)
+ #:use-module (gnu services containers)
#:use-module (gnu services dbus)
#:use-module (gnu services networking)
#:use-module (gnu services docker)
@@ -57,6 +58,40 @@ (define %docker-os
(service containerd-service-type)
(service docker-service-type)))
+(define %docker-tarball
+ (lower-oci-image-state
+ "guile-guest"
+ (packages->manifest
+ (list
+ guile-3.0 guile-json-3
+ (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))))
+ '(#:entry-point "bin/guile"
+ #:localstatedir? #t
+ #:extra-options (#:image-tag "guile-guest")
+ #:symlinks (("/bin/Guile" -> "bin/guile")
+ ("aa.scm" -> "a.scm")))
+ "guile-guest"
+ (%current-target-system)
+ (%current-system)
+ #f))
+
(define (run-docker-test docker-tarball)
"Load DOCKER-TARBALL as Docker image and run it in a Docker container,
inside %DOCKER-OS."
@@ -173,40 +208,7 @@ (define (run-docker-test docker-tarball)
(gexp->derivation "docker-test" test))
(define (build-tarball&run-docker-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"))
- #:entry-point "bin/guile"
- #:localstatedir? #t)))
- (run-docker-test tarball)))
+ (run-docker-test %docker-tarball))
(define %test-docker
(system-test
@@ -215,8 +217,22 @@ (define %test-docker
(value (build-tarball&run-docker-test))))
+(define %docker-system-tarball
+ (lower-oci-image-state
+ "guix-system-guest"
+ (operating-system
+ (inherit (simple-operating-system))
+ ;; Use locales for a single libc to
+ ;; reduce space requirements.
+ (locale-libcs (list glibc)))
+ '()
+ "guix-system-guest"
+ (%current-target-system)
+ (%current-system)
+ #f))
+
(define (run-docker-system-test tarball)
- "Load DOCKER-TARBALL as Docker image and run it in a Docker container,
+ "Load TARBALL as Docker image and run it in a Docker container,
inside %DOCKER-OS."
(define os
(marionette-operating-system
@@ -333,21 +349,15 @@ (define (run-docker-system-test tarball)
(gexp->derivation "docker-system-test" test))
+(define (build-tarball&run-docker-system-test)
+ (run-docker-system-test %docker-system-tarball))
+
(define %test-docker-system
(system-test
(name "docker-system")
(description "Run a system image as produced by @command{guix system
docker-image} inside Docker.")
- (value (with-monad %store-monad
- (>>= (lower-object
- (system-image (os->image
- (operating-system
- (inherit (simple-operating-system))
- ;; Use locales for a single libc to
- ;; reduce space requirements.
- (locale-libcs (list glibc)))
- #:type docker-image-type)))
- run-docker-system-test)))))
+ (value (build-tarball&run-docker-system-test))))
(define %oci-os
--
2.48.1
andrew <at> trop.in, janneke <at> gnu.org, ludo <at> gnu.org, maxim.cournoyer <at> gmail.com, tanguy <at> bioneland.org, guix-patches <at> gnu.org:bug#76081; Package guix-patches.
(Wed, 19 Feb 2025 00:10:05 GMT) Full text and rfc822 format available.Message #77 received at 76081 <at> debbugs.gnu.org (full text, mbox):
From: Giacomo Leidi <goodoldpaul <at> autistici.org> To: 76081 <at> debbugs.gnu.org Cc: Giacomo Leidi <goodoldpaul <at> autistici.org> Subject: [PATCH v5 5/5] home: Add home-oci-service-type. Date: Wed, 19 Feb 2025 01:09:22 +0100
* gnu/home/service/containers.scm: New file;
* gnu/local.mk (GNU_SYSTEM_MODULES): Add it.
* doc/guix.texi (OCI backed services): Document it.
Change-Id: I8ce5b301e8032d0a7b2a9ca46752738cdee1f030
---
doc/guix.texi | 114 +++++++++++++++++++++++++++++++
gnu/home/services/containers.scm | 50 ++++++++++++++
gnu/local.mk | 1 +
3 files changed, 165 insertions(+)
create mode 100644 gnu/home/services/containers.scm
diff --git a/doc/guix.texi b/doc/guix.texi
index 0dfec66a52b..eacca409473 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -49826,6 +49826,120 @@ Miscellaneous Home Services
(dicod-configuration @dots{})))
@end lisp
+@subsubheading OCI backed services
+
+@cindex OCI-backed, for Home
+The @code{(gnu home services containers)} module provides the following service:
+
+@defvar home-oci-service-type
+This is the type of the service that allows to manage your OCI containers with
+the same consistent interface you use for your other Home Shepherd services.
+@end defvar
+
+This service is a direct mapping of the @code{oci-service-type} system
+service (@pxref{Miscellaneous Services, OCI backed services}). You can
+use it like this:
+
+@lisp
+(use-modules (gnu services containers)
+ (gnu home services containers))
+
+(simple-service 'home-oci-provisioning
+ home-oci-service-type
+ (oci-extension
+ (volumes
+ (list
+ (oci-volume-configuration (name "prometheus"))
+ (oci-volume-configuration (name "grafana"))))
+ (networks
+ (list
+ (oci-network-configuration (name "monitoring"))))
+ (containers
+ (list
+ (oci-container-configuration
+ (network "monitoring")
+ (image
+ (oci-image
+ (repository "guile")
+ (tag "3")
+ (value (specifications->manifest '("guile")))
+ (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile"))
+ #:max-layers 2))))
+ (entrypoint "/bin/guile")
+ (command
+ '("-c" "(display \"hello!\n\")")))
+ (oci-container-configuration
+ (image "prom/prometheus")
+ (network "monitoring")
+ (ports
+ '(("9000" . "9000")
+ ("9090" . "9090")))
+ (volumes
+ (list
+ '(("prometheus" . "/var/lib/prometheus")))))
+ (oci-container-configuration
+ (image "grafana/grafana:10.0.1")
+ (network "monitoring")
+ (volumes
+ '(("grafana:/var/lib/grafana"))))))))
+
+@end lisp
+
+You may specify a custom configuration by providing a
+@code{oci-configuration} record, exactly like for
+@code{oci-service-type}, but wrapping it in @code{for-home}:
+
+@lisp
+(use-modules (gnu services)
+ (gnu services containers)
+ (gnu home services containers))
+
+(service home-oci-service-type
+ (for-home
+ (oci-configuration
+ (runtime 'podman)
+ (verbose? #t))))
+
+(simple-service 'home-oci-provisioning
+ home-oci-service-type
+ (oci-extension
+ (volumes
+ (list
+ (oci-volume-configuration (name "prometheus"))
+ (oci-volume-configuration (name "grafana"))))
+ (networks
+ (list
+ (oci-network-configuration (name "monitoring"))))
+ (containers
+ (list
+ (oci-container-configuration
+ (network "monitoring")
+ (image
+ (oci-image
+ (repository "guile")
+ (tag "3")
+ (value (specifications->manifest '("guile")))
+ (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile"))
+ #:max-layers 2))))
+ (entrypoint "/bin/guile")
+ (command
+ '("-c" "(display \"hello!\n\")")))
+ (oci-container-configuration
+ (image "prom/prometheus")
+ (network "monitoring")
+ (ports
+ '(("9000" . "9000")
+ ("9090" . "9090")))
+ (volumes
+ (list
+ '(("prometheus" . "/var/lib/prometheus")))))
+ (oci-container-configuration
+ (image "grafana/grafana:10.0.1")
+ (network "monitoring")
+ (volumes
+ '(("grafana:/var/lib/grafana"))))))))
+@end lisp
+
@node Invoking guix home
@section Invoking @command{guix home}
diff --git a/gnu/home/services/containers.scm b/gnu/home/services/containers.scm
new file mode 100644
index 00000000000..938dde2f37a
--- /dev/null
+++ b/gnu/home/services/containers.scm
@@ -0,0 +1,50 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2025 Giacomo Leidi <goodoldpaul <at> 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 home services containers)
+ #:use-module (gnu home services)
+ #:use-module (gnu home services shepherd)
+ #:use-module (gnu services)
+ #:use-module (gnu services configuration)
+ #:use-module (gnu services containers)
+ #:use-module (guix gexp)
+ #:use-module (guix packages)
+ #:use-module (srfi srfi-1)
+ #:export (home-oci-service-type))
+
+(define home-oci-service-type
+ (service-type (inherit (system->home-service-type oci-service-type))
+ (extensions
+ (list
+ (service-extension home-profile-service-type
+ (oci-service-extension-wrap-validate
+ (lambda (config)
+ (let ((runtime-cli
+ (oci-configuration-runtime-cli config))
+ (runtime
+ (oci-configuration-runtime config)))
+ (oci-service-profile runtime runtime-cli)))))
+ (service-extension home-shepherd-service-type
+ (oci-service-extension-wrap-validate
+ oci-configuration->shepherd-services))))
+ (extend
+ (lambda (config extension)
+ (for-home
+ (oci-configuration
+ (inherit (oci-configuration-extend config extension))))))
+ (default-value (for-home (oci-configuration)))))
diff --git a/gnu/local.mk b/gnu/local.mk
index 01926bb1b8b..37ab59a3ba1 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -102,6 +102,7 @@ GNU_SYSTEM_MODULES = \
%D%/home.scm \
%D%/home/services.scm \
%D%/home/services/admin.scm \
+ %D%/home/services/containers.scm \
%D%/home/services/desktop.scm \
%D%/home/services/dict.scm \
%D%/home/services/dotfiles.scm \
--
2.48.1
guix-patches <at> gnu.org:bug#76081; Package guix-patches.
(Wed, 19 Feb 2025 00:10:06 GMT) Full text and rfc822 format available.Message #80 received at 76081 <at> debbugs.gnu.org (full text, mbox):
From: Giacomo Leidi <goodoldpaul <at> autistici.org> To: 76081 <at> debbugs.gnu.org Cc: Giacomo Leidi <goodoldpaul <at> autistici.org> Subject: [PATCH v5 2/5] services: oci-container-configuration: Move to (gnu services containers). Date: Wed, 19 Feb 2025 01:09:19 +0100
This patch moves the oci-container-configuration and related
configuration records to (gnu services containers).
Public symbols are still exported for backwards
compatibility but since the oci-container-service-type will be
deprecated in favor of the more general oci-service-type, everything is
moved outside of the docker related module.
* gnu/services/docker.scm: Move everything related to oci-container-configuration
to...
* gnu/services/containers.scm: ...here.scm.
* gnu/tests/docker.scm: Simplify %test-oci-container test case.
Change-Id: Iae599dd5cc7442eb632f0c1b3b12f6b928397ae7
---
gnu/services/containers.scm | 549 +++++++++++++++++++++++++++++++++-
gnu/services/docker.scm | 577 +++---------------------------------
gnu/tests/docker.scm | 99 +++----
3 files changed, 625 insertions(+), 600 deletions(-)
diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm
index dc66ac4f967..50bf6c05549 100644
--- a/gnu/services/containers.scm
+++ b/gnu/services/containers.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2024 Giacomo Leidi <goodoldpaul <at> autistici.org>
+;;; Copyright © 2024, 2025 Giacomo Leidi <goodoldpaul <at> autistici.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -17,19 +17,31 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu services containers)
+ #:use-module (gnu image)
+ #:use-module (gnu packages admin)
#:use-module (gnu packages bash)
#:use-module (gnu packages containers)
+ #:use-module (gnu packages docker)
#: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)
#:use-module (gnu system accounts)
+ #:use-module (gnu system image)
#:use-module (gnu system shadow)
#:use-module (gnu system pam)
+ #:use-module (guix diagnostics)
#:use-module (guix gexp)
+ #:use-module (guix i18n)
+ #:use-module (guix monads)
#:use-module (guix packages)
+ #:use-module (guix profiles)
+ #:use-module ((guix scripts pack) #:prefix pack:)
+ #:use-module (guix store)
#:use-module (srfi srfi-1)
+ #:use-module (ice-9 match)
#:export (rootless-podman-configuration
rootless-podman-configuration?
rootless-podman-configuration-fields
@@ -48,7 +60,44 @@ (define-module (gnu services containers)
rootless-podman-shepherd-services
rootless-podman-service-etc
- rootless-podman-service-type))
+ rootless-podman-service-type
+
+ oci-image
+ oci-image?
+ oci-image-fields
+ oci-image-repository
+ oci-image-tag
+ oci-image-value
+ oci-image-pack-options
+ oci-image-target
+ oci-image-system
+ oci-image-grafts?
+
+ oci-container-configuration
+ oci-container-configuration?
+ oci-container-configuration-fields
+ oci-container-configuration-user
+ oci-container-configuration-group
+ oci-container-configuration-command
+ oci-container-configuration-entrypoint
+ oci-container-configuration-host-environment
+ oci-container-configuration-environment
+ oci-container-configuration-image
+ oci-container-configuration-provision
+ oci-container-configuration-requirement
+ oci-container-configuration-log-file
+ oci-container-configuration-auto-start?
+ oci-container-configuration-respawn?
+ oci-container-configuration-shepherd-actions
+ oci-container-configuration-network
+ oci-container-configuration-ports
+ oci-container-configuration-volumes
+ oci-container-configuration-container-user
+ oci-container-configuration-workdir
+ oci-container-configuration-extra-arguments
+
+ oci-container-shepherd-service
+ %oci-container-accounts))
(define (gexp-or-string? value)
(or (gexp? value)
@@ -188,7 +237,7 @@ (define (rootless-podman-cgroups-limits-service config)
rootless-podman-shared-root-fs))
(one-shot? #t)
(documentation
- "Allow setting cgroups limits: cpu, cpuset, memory and
+ "Allow setting cgroups limits: cpu, cpuset, io, memory and
pids.")
(start
#~(make-forkexec-constructor
@@ -242,3 +291,497 @@ (define rootless-podman-service-type
(default-value (rootless-podman-configuration))
(description
"This service configures rootless @code{podman} on the Guix System.")))
+
+
+;;;
+;;; OCI container.
+;;;
+
+(define (oci-sanitize-pair pair delimiter)
+ (define (valid? member)
+ (or (string? member)
+ (gexp? member)
+ (file-like? member)))
+ (match pair
+ (((? valid? key) . (? valid? value))
+ #~(string-append #$key #$delimiter #$value))
+ (_
+ (raise
+ (formatted-message
+ (G_ "pair members must contain only strings, gexps or file-like objects
+but ~a was found")
+ pair)))))
+
+(define (oci-sanitize-mixed-list name value delimiter)
+ (map
+ (lambda (el)
+ (cond ((string? el) el)
+ ((pair? el) (oci-sanitize-pair el delimiter))
+ (else
+ (raise
+ (formatted-message
+ (G_ "~a members must be either a string or a pair but ~a was
+found!")
+ name el)))))
+ value))
+
+(define (oci-sanitize-host-environment value)
+ ;; Expected spec format:
+ ;; '(("HOME" . "/home/nobody") "JAVA_HOME=/java")
+ (oci-sanitize-mixed-list "host-environment" value "="))
+
+(define (oci-sanitize-environment value)
+ ;; Expected spec format:
+ ;; '(("HOME" . "/home/nobody") "JAVA_HOME=/java")
+ (oci-sanitize-mixed-list "environment" value "="))
+
+(define (oci-sanitize-ports value)
+ ;; Expected spec format:
+ ;; '(("8088" . "80") "2022:22")
+ (oci-sanitize-mixed-list "ports" value ":"))
+
+(define (oci-sanitize-volumes value)
+ ;; Expected spec format:
+ ;; '(("/mnt/dir" . "/dir") "/run/current-system/profile:/java")
+ (oci-sanitize-mixed-list "volumes" value ":"))
+
+(define (oci-sanitize-shepherd-actions value)
+ (map
+ (lambda (el)
+ (if (shepherd-action? el)
+ el
+ (raise
+ (formatted-message
+ (G_ "shepherd-actions may only be shepherd-action records
+but ~a was found") el))))
+ value))
+
+(define (oci-sanitize-extra-arguments value)
+ (define (valid? member)
+ (or (string? member)
+ (gexp? member)
+ (file-like? member)))
+ (map
+ (lambda (el)
+ (if (valid? el)
+ el
+ (raise
+ (formatted-message
+ (G_ "extra arguments may only be strings, gexps or file-like objects
+but ~a was found") el))))
+ value))
+
+(define (oci-image-reference image)
+ (if (string? image)
+ image
+ (string-append (oci-image-repository image)
+ ":" (oci-image-tag image))))
+
+(define (oci-lowerable-image? image)
+ (or (manifest? image)
+ (operating-system? image)
+ (gexp? image)
+ (file-like? image)))
+
+(define (string-or-oci-image? image)
+ (or (string? image)
+ (oci-image? image)))
+
+(define list-of-symbols?
+ (list-of symbol?))
+
+(define-maybe/no-serialization string)
+
+(define-configuration/no-serialization oci-image
+ (repository
+ (string)
+ "A string like @code{myregistry.local:5000/testing/test-image} that names
+the OCI image.")
+ (tag
+ (string "latest")
+ "A string representing the OCI image tag. Defaults to @code{latest}.")
+ (value
+ (oci-lowerable-image)
+ "A @code{manifest} or @code{operating-system} record that will be lowered
+into an OCI compatible tarball. Otherwise this field's value can be a gexp
+or a file-like object that evaluates to an OCI compatible tarball.")
+ (pack-options
+ (list '())
+ "An optional set of keyword arguments that will be passed to the
+@code{docker-image} procedure from @code{guix scripts pack}. They can be used
+to replicate @command{guix pack} behavior:
+
+@lisp
+(oci-image
+ (repository \"guile\")
+ (tag \"3\")
+ (manifest (specifications->manifest '(\"guile\")))
+ (pack-options
+ '(#:symlinks ((\"/bin/guile\" -> \"bin/guile\"))
+ #:max-layers 2)))
+@end lisp
+
+If the @code{value} field is an @code{operating-system} record, this field's
+value will be ignored.")
+ (system
+ (maybe-string)
+ "Attempt to build for a given system, e.g. \"i686-linux\"")
+ (target
+ (maybe-string)
+ "Attempt to cross-build for a given triple, e.g. \"aarch64-linux-gnu\"")
+ (grafts?
+ (boolean #f)
+ "Whether to allow grafting or not in the pack build."))
+
+(define-configuration/no-serialization oci-container-configuration
+ (user
+ (string "oci-container")
+ "The user under whose authority docker commands will be run.")
+ (group
+ (string "docker")
+ "The group under whose authority docker commands will be run.")
+ (command
+ (list-of-strings '())
+ "Overwrite the default command (@code{CMD}) of the image.")
+ (entrypoint
+ (maybe-string)
+ "Overwrite the default entrypoint (@code{ENTRYPOINT}) of the image.")
+ (host-environment
+ (list '())
+ "Set environment variables in the host environment where @command{docker run}
+is invoked. This is especially useful to pass secrets from the host to the
+container without having them on the @command{docker run}'s command line: by
+setting the @code{MYSQL_PASSWORD} on the host and by passing
+@code{--env MYSQL_PASSWORD} through the @code{extra-arguments} field, it is
+possible to securely set values in the container environment. This field's
+value can be a list of pairs or strings, even mixed:
+
+@lisp
+(list '(\"LANGUAGE\" . \"eo:ca:eu\")
+ \"JAVA_HOME=/opt/java\")
+@end lisp
+
+Pair members can be strings, gexps or file-like objects. Strings are passed
+directly to @code{make-forkexec-constructor}."
+ (sanitizer oci-sanitize-host-environment))
+ (environment
+ (list '())
+ "Set environment variables inside the container. This can be a list of pairs
+or strings, even mixed:
+
+@lisp
+(list '(\"LANGUAGE\" . \"eo:ca:eu\")
+ \"JAVA_HOME=/opt/java\")
+@end lisp
+
+Pair members can be strings, gexps or file-like objects. Strings are passed
+directly to the Docker CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#env,upstream}
+documentation for semantics."
+ (sanitizer oci-sanitize-environment))
+ (image
+ (string-or-oci-image)
+ "The image used to build the container. It can be a string or an
+@code{oci-image} record. Strings are resolved by the Docker
+Engine, and follow the usual format
+@code{myregistry.local:5000/testing/test-image:tag}.")
+ (provision
+ (maybe-string)
+ "Set the name of the provisioned Shepherd service.")
+ (requirement
+ (list-of-symbols '())
+ "Set additional Shepherd services dependencies to the provisioned Shepherd
+service.")
+ (log-file
+ (maybe-string)
+ "When @code{log-file} is set, it names the file to which the service’s
+standard output and standard error are redirected. @code{log-file} is created
+if it does not exist, otherwise it is appended to.")
+ (auto-start?
+ (boolean #t)
+ "Whether this service should be started automatically by the Shepherd. If it
+is @code{#f} the service has to be started manually with @command{herd start}.")
+ (respawn?
+ (boolean #f)
+ "Whether to restart the service when it stops, for instance when the
+underlying process dies.")
+ (shepherd-actions
+ (list '())
+ "This is a list of @code{shepherd-action} records defining actions supported
+by the service."
+ (sanitizer oci-sanitize-shepherd-actions))
+ (network
+ (maybe-string)
+ "Set a Docker network for the spawned container.")
+ (ports
+ (list '())
+ "Set the port or port ranges to expose from the spawned container. This can
+be a list of pairs or strings, even mixed:
+
+@lisp
+(list '(\"8080\" . \"80\")
+ \"10443:443\")
+@end lisp
+
+Pair members can be strings, gexps or file-like objects. Strings are passed
+directly to the Docker CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#publish,upstream}
+documentation for semantics."
+ (sanitizer oci-sanitize-ports))
+ (volumes
+ (list '())
+ "Set volume mappings for the spawned container. This can be a
+list of pairs or strings, even mixed:
+
+@lisp
+(list '(\"/root/data/grafana\" . \"/var/lib/grafana\")
+ \"/gnu/store:/gnu/store\")
+@end lisp
+
+Pair members can be strings, gexps or file-like objects. Strings are passed
+directly to the Docker CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#volume,upstream}
+documentation for semantics."
+ (sanitizer oci-sanitize-volumes))
+ (container-user
+ (maybe-string)
+ "Set the current user inside the spawned container. You can refer to the
+@url{https://docs.docker.com/engine/reference/run/#user,upstream}
+documentation for semantics.")
+ (workdir
+ (maybe-string)
+ "Set the current working for the spawned Shepherd service.
+You can refer to the
+@url{https://docs.docker.com/engine/reference/run/#workdir,upstream}
+documentation for semantics.")
+ (extra-arguments
+ (list '())
+ "A list of strings, gexps or file-like objects that will be directly passed
+to the @command{docker run} invokation."
+ (sanitizer oci-sanitize-extra-arguments)))
+
+(define oci-container-configuration->options
+ (lambda (config)
+ (let ((entrypoint
+ (oci-container-configuration-entrypoint config))
+ (network
+ (oci-container-configuration-network config))
+ (user
+ (oci-container-configuration-container-user config))
+ (workdir
+ (oci-container-configuration-workdir config)))
+ (apply append
+ (filter (compose not unspecified?)
+ `(,(if (maybe-value-set? entrypoint)
+ `("--entrypoint" ,entrypoint)
+ '())
+ ,(append-map
+ (lambda (spec)
+ (list "--env" spec))
+ (oci-container-configuration-environment config))
+ ,(if (maybe-value-set? network)
+ `("--network" ,network)
+ '())
+ ,(if (maybe-value-set? user)
+ `("--user" ,user)
+ '())
+ ,(if (maybe-value-set? workdir)
+ `("--workdir" ,workdir)
+ '())
+ ,(append-map
+ (lambda (spec)
+ (list "-p" spec))
+ (oci-container-configuration-ports config))
+ ,(append-map
+ (lambda (spec)
+ (list "-v" spec))
+ (oci-container-configuration-volumes config))))))))
+
+(define* (get-keyword-value args keyword #:key (default #f))
+ (let ((kv (memq keyword args)))
+ (if (and kv (>= (length kv) 2))
+ (cadr kv)
+ default)))
+
+(define (lower-operating-system os target system)
+ (mlet* %store-monad
+ ((tarball
+ (lower-object
+ (system-image (os->image os #:type docker-image-type))
+ system
+ #:target target)))
+ (return tarball)))
+
+(define (lower-manifest name image target system)
+ (define value (oci-image-value image))
+ (define options (oci-image-pack-options image))
+ (define image-reference
+ (oci-image-reference image))
+ (define image-tag
+ (let* ((extra-options
+ (get-keyword-value options #:extra-options))
+ (image-tag-option
+ (and extra-options
+ (get-keyword-value extra-options #:image-tag))))
+ (if image-tag-option
+ '()
+ `(#:extra-options (#:image-tag ,image-reference)))))
+
+ (mlet* %store-monad
+ ((_ (set-grafting
+ (oci-image-grafts? image)))
+ (guile (set-guile-for-build (default-guile)))
+ (profile
+ (profile-derivation value
+ #:target target
+ #:system system
+ #:hooks '()
+ #:locales? #f))
+ (tarball (apply pack:docker-image
+ `(,name ,profile
+ ,@options
+ ,@image-tag
+ #:localstatedir? #t))))
+ (return tarball)))
+
+(define (lower-oci-image name image)
+ (define value (oci-image-value image))
+ (define image-target (oci-image-target image))
+ (define image-system (oci-image-system image))
+ (define target
+ (if (maybe-value-set? image-target)
+ image-target
+ (%current-target-system)))
+ (define system
+ (if (maybe-value-set? image-system)
+ image-system
+ (%current-system)))
+ (with-store store
+ (run-with-store store
+ (match value
+ ((? manifest? value)
+ (lower-manifest name image target system))
+ ((? operating-system? value)
+ (lower-operating-system value target system))
+ ((or (? gexp? value)
+ (? file-like? value))
+ value)
+ (_
+ (raise
+ (formatted-message
+ (G_ "oci-image value must contain only manifest,
+operating-system, gexp or file-like records but ~a was found")
+ value))))
+ #:target target
+ #:system system)))
+
+(define (%oci-image-loader name image tag)
+ (let ((docker (file-append docker-cli "/bin/docker"))
+ (tarball (lower-oci-image name image)))
+ (with-imported-modules '((guix build utils))
+ (program-file (format #f "~a-image-loader" name)
+ #~(begin
+ (use-modules (guix build utils)
+ (ice-9 popen)
+ (ice-9 rdelim))
+
+ (format #t "Loading image for ~a from ~a...~%" #$name #$tarball)
+ (define line
+ (read-line
+ (open-input-pipe
+ (string-append #$docker " load -i " #$tarball))))
+
+ (unless (or (eof-object? line)
+ (string-null? line))
+ (format #t "~a~%" line)
+ (let ((repository&tag
+ (string-drop line
+ (string-length
+ "Loaded image: "))))
+
+ (invoke #$docker "tag" repository&tag #$tag)
+ (format #t "Tagged ~a with ~a...~%" #$tarball #$tag))))))))
+
+(define (oci-container-shepherd-service config)
+ (define (guess-name name image)
+ (if (maybe-value-set? name)
+ name
+ (string-append "docker-"
+ (basename
+ (if (string? image)
+ (first (string-split image #\:))
+ (oci-image-repository image))))))
+
+ (let* ((docker (file-append docker-cli "/bin/docker"))
+ (actions (oci-container-configuration-shepherd-actions config))
+ (auto-start?
+ (oci-container-configuration-auto-start? config))
+ (user (oci-container-configuration-user config))
+ (group (oci-container-configuration-group config))
+ (host-environment
+ (oci-container-configuration-host-environment config))
+ (command (oci-container-configuration-command config))
+ (log-file (oci-container-configuration-log-file config))
+ (provision (oci-container-configuration-provision config))
+ (requirement (oci-container-configuration-requirement config))
+ (respawn?
+ (oci-container-configuration-respawn? config))
+ (image (oci-container-configuration-image config))
+ (image-reference (oci-image-reference image))
+ (options (oci-container-configuration->options config))
+ (name (guess-name provision image))
+ (extra-arguments
+ (oci-container-configuration-extra-arguments config)))
+
+ (shepherd-service (provision `(,(string->symbol name)))
+ (requirement `(dockerd user-processes ,@requirement))
+ (respawn? respawn?)
+ (auto-start? auto-start?)
+ (documentation
+ (string-append
+ "Docker backed Shepherd service for "
+ (if (oci-image? image) name image) "."))
+ (start
+ #~(lambda ()
+ #$@(if (oci-image? image)
+ #~((invoke #$(%oci-image-loader
+ name image image-reference)))
+ #~())
+ (fork+exec-command
+ ;; docker run [OPTIONS] IMAGE [COMMAND] [ARG...]
+ (list #$docker "run" "--rm" "--name" #$name
+ #$@options #$@extra-arguments
+ #$image-reference #$@command)
+ #:user #$user
+ #:group #$group
+ #$@(if (maybe-value-set? log-file)
+ (list #:log-file log-file)
+ '())
+ #:environment-variables
+ (list #$@host-environment))))
+ (stop
+ #~(lambda _
+ (invoke #$docker "rm" "-f" #$name)))
+ (actions
+ (if (oci-image? image)
+ '()
+ (append
+ (list
+ (shepherd-action
+ (name 'pull)
+ (documentation
+ (format #f "Pull ~a's image (~a)."
+ name image))
+ (procedure
+ #~(lambda _
+ (invoke #$docker "pull" #$image)))))
+ actions))))))
+
+(define %oci-container-accounts
+ (list (user-account
+ (name "oci-container")
+ (comment "OCI services account")
+ (group "docker")
+ (system? #t)
+ (home-directory "/var/empty")
+ (shell (file-append shadow "/sbin/nologin")))))
diff --git a/gnu/services/docker.scm b/gnu/services/docker.scm
index 3af0f792701..69ff9f1d9e4 100644
--- a/gnu/services/docker.scm
+++ b/gnu/services/docker.scm
@@ -5,7 +5,7 @@
;;; Copyright © 2020 Efraim Flashner <efraim <at> flashner.co.il>
;;; Copyright © 2020 Jesse Dowell <jessedowell <at> gmail.com>
;;; Copyright © 2021 Brice Waegeneire <brice <at> waegenei.re>
-;;; Copyright © 2023, 2024 Giacomo Leidi <goodoldpaul <at> autistici.org>
+;;; Copyright © 2023, 2024, 2025 Giacomo Leidi <goodoldpaul <at> autistici.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -23,72 +23,60 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu services docker)
- #:use-module (gnu image)
#:use-module (gnu services)
#:use-module (gnu services configuration)
- #:use-module (gnu services base)
- #:use-module (gnu services dbus)
+ #:use-module (gnu services containers)
#:use-module (gnu services shepherd)
- #:use-module (gnu system)
- #:use-module (gnu system image)
#:use-module (gnu system privilege)
#:use-module (gnu system shadow)
- #:use-module (gnu packages admin) ;shadow
#:use-module (gnu packages docker)
#:use-module (gnu packages linux) ;singularity
- #:use-module (guix records)
- #:use-module (guix diagnostics)
#:use-module (guix gexp)
- #:use-module (guix i18n)
- #:use-module (guix monads)
- #:use-module (guix packages)
- #:use-module (guix profiles)
- #:use-module ((guix scripts pack) #:prefix pack:)
- #:use-module (guix store)
+ #:use-module (guix records)
#:use-module (srfi srfi-1)
#:use-module (ice-9 format)
#:use-module (ice-9 match)
+ #:re-export (oci-image ;for backwards compatibility, until the
+ oci-image? ;oci-container-service-type is fully deprecated
+ oci-image-fields
+ oci-image-repository
+ oci-image-tag
+ oci-image-value
+ oci-image-pack-options
+ oci-image-target
+ oci-image-system
+ oci-image-grafts?
+ oci-container-configuration
+ oci-container-configuration?
+ oci-container-configuration-fields
+ oci-container-configuration-user
+ oci-container-configuration-group
+ oci-container-configuration-command
+ oci-container-configuration-entrypoint
+ oci-container-configuration-host-environment
+ oci-container-configuration-environment
+ oci-container-configuration-image
+ oci-container-configuration-provision
+ oci-container-configuration-requirement
+ oci-container-configuration-log-file
+ oci-container-configuration-auto-start?
+ oci-container-configuration-respawn?
+ oci-container-configuration-shepherd-actions
+ oci-container-configuration-network
+ oci-container-configuration-ports
+ oci-container-configuration-volumes
+ oci-container-configuration-container-user
+ oci-container-configuration-workdir
+ oci-container-configuration-extra-arguments
+ oci-container-shepherd-service
+ %oci-container-accounts)
#:export (containerd-configuration
containerd-service-type
docker-configuration
docker-service-type
singularity-service-type
- oci-image
- oci-image?
- oci-image-fields
- oci-image-repository
- oci-image-tag
- oci-image-value
- oci-image-pack-options
- oci-image-target
- oci-image-system
- oci-image-grafts?
- oci-container-configuration
- oci-container-configuration?
- oci-container-configuration-fields
- oci-container-configuration-user
- oci-container-configuration-group
- oci-container-configuration-command
- oci-container-configuration-entrypoint
- oci-container-configuration-host-environment
- oci-container-configuration-environment
- oci-container-configuration-image
- oci-container-configuration-provision
- oci-container-configuration-requirement
- oci-container-configuration-log-file
- oci-container-configuration-auto-start?
- oci-container-configuration-respawn?
- oci-container-configuration-shepherd-actions
- oci-container-configuration-network
- oci-container-configuration-ports
- oci-container-configuration-volumes
- oci-container-configuration-container-user
- oci-container-configuration-workdir
- oci-container-configuration-extra-arguments
- oci-container-service-type
- oci-container-shepherd-service
- %oci-container-accounts))
+ oci-container-service-type))
(define-maybe file-like)
@@ -307,495 +295,6 @@ (define singularity-service-type
;;; OCI container.
;;;
-(define (oci-sanitize-pair pair delimiter)
- (define (valid? member)
- (or (string? member)
- (gexp? member)
- (file-like? member)))
- (match pair
- (((? valid? key) . (? valid? value))
- #~(string-append #$key #$delimiter #$value))
- (_
- (raise
- (formatted-message
- (G_ "pair members must contain only strings, gexps or file-like objects
-but ~a was found")
- pair)))))
-
-(define (oci-sanitize-mixed-list name value delimiter)
- (map
- (lambda (el)
- (cond ((string? el) el)
- ((pair? el) (oci-sanitize-pair el delimiter))
- (else
- (raise
- (formatted-message
- (G_ "~a members must be either a string or a pair but ~a was
-found!")
- name el)))))
- value))
-
-(define (oci-sanitize-host-environment value)
- ;; Expected spec format:
- ;; '(("HOME" . "/home/nobody") "JAVA_HOME=/java")
- (oci-sanitize-mixed-list "host-environment" value "="))
-
-(define (oci-sanitize-environment value)
- ;; Expected spec format:
- ;; '(("HOME" . "/home/nobody") "JAVA_HOME=/java")
- (oci-sanitize-mixed-list "environment" value "="))
-
-(define (oci-sanitize-ports value)
- ;; Expected spec format:
- ;; '(("8088" . "80") "2022:22")
- (oci-sanitize-mixed-list "ports" value ":"))
-
-(define (oci-sanitize-volumes value)
- ;; Expected spec format:
- ;; '(("/mnt/dir" . "/dir") "/run/current-system/profile:/java")
- (oci-sanitize-mixed-list "volumes" value ":"))
-
-(define (oci-sanitize-shepherd-actions value)
- (map
- (lambda (el)
- (if (shepherd-action? el)
- el
- (raise
- (formatted-message
- (G_ "shepherd-actions may only be shepherd-action records
-but ~a was found") el))))
- value))
-
-(define (oci-sanitize-extra-arguments value)
- (define (valid? member)
- (or (string? member)
- (gexp? member)
- (file-like? member)))
- (map
- (lambda (el)
- (if (valid? el)
- el
- (raise
- (formatted-message
- (G_ "extra arguments may only be strings, gexps or file-like objects
-but ~a was found") el))))
- value))
-
-(define (oci-image-reference image)
- (if (string? image)
- image
- (string-append (oci-image-repository image)
- ":" (oci-image-tag image))))
-
-(define (oci-lowerable-image? image)
- (or (manifest? image)
- (operating-system? image)
- (gexp? image)
- (file-like? image)))
-
-(define (string-or-oci-image? image)
- (or (string? image)
- (oci-image? image)))
-
-(define list-of-symbols?
- (list-of symbol?))
-
-(define-maybe/no-serialization string)
-
-(define-configuration/no-serialization oci-image
- (repository
- (string)
- "A string like @code{myregistry.local:5000/testing/test-image} that names
-the OCI image.")
- (tag
- (string "latest")
- "A string representing the OCI image tag. Defaults to @code{latest}.")
- (value
- (oci-lowerable-image)
- "A @code{manifest} or @code{operating-system} record that will be lowered
-into an OCI compatible tarball. Otherwise this field's value can be a gexp
-or a file-like object that evaluates to an OCI compatible tarball.")
- (pack-options
- (list '())
- "An optional set of keyword arguments that will be passed to the
-@code{docker-image} procedure from @code{guix scripts pack}. They can be used
-to replicate @command{guix pack} behavior:
-
-@lisp
-(oci-image
- (repository \"guile\")
- (tag \"3\")
- (manifest (specifications->manifest '(\"guile\")))
- (pack-options
- '(#:symlinks ((\"/bin/guile\" -> \"bin/guile\"))
- #:max-layers 2)))
-@end lisp
-
-If the @code{value} field is an @code{operating-system} record, this field's
-value will be ignored.")
- (system
- (maybe-string)
- "Attempt to build for a given system, e.g. \"i686-linux\"")
- (target
- (maybe-string)
- "Attempt to cross-build for a given triple, e.g. \"aarch64-linux-gnu\"")
- (grafts?
- (boolean #f)
- "Whether to allow grafting or not in the pack build."))
-
-(define-configuration/no-serialization oci-container-configuration
- (user
- (string "oci-container")
- "The user under whose authority docker commands will be run.")
- (group
- (string "docker")
- "The group under whose authority docker commands will be run.")
- (command
- (list-of-strings '())
- "Overwrite the default command (@code{CMD}) of the image.")
- (entrypoint
- (maybe-string)
- "Overwrite the default entrypoint (@code{ENTRYPOINT}) of the image.")
- (host-environment
- (list '())
- "Set environment variables in the host environment where @command{docker run}
-is invoked. This is especially useful to pass secrets from the host to the
-container without having them on the @command{docker run}'s command line: by
-setting the @code{MYSQL_PASSWORD} on the host and by passing
-@code{--env MYSQL_PASSWORD} through the @code{extra-arguments} field, it is
-possible to securely set values in the container environment. This field's
-value can be a list of pairs or strings, even mixed:
-
-@lisp
-(list '(\"LANGUAGE\" . \"eo:ca:eu\")
- \"JAVA_HOME=/opt/java\")
-@end lisp
-
-Pair members can be strings, gexps or file-like objects. Strings are passed
-directly to @code{make-forkexec-constructor}."
- (sanitizer oci-sanitize-host-environment))
- (environment
- (list '())
- "Set environment variables inside the container. This can be a list of pairs
-or strings, even mixed:
-
-@lisp
-(list '(\"LANGUAGE\" . \"eo:ca:eu\")
- \"JAVA_HOME=/opt/java\")
-@end lisp
-
-Pair members can be strings, gexps or file-like objects. Strings are passed
-directly to the Docker CLI. You can refer to the
-@url{https://docs.docker.com/engine/reference/commandline/run/#env,upstream}
-documentation for semantics."
- (sanitizer oci-sanitize-environment))
- (image
- (string-or-oci-image)
- "The image used to build the container. It can be a string or an
-@code{oci-image} record. Strings are resolved by the Docker
-Engine, and follow the usual format
-@code{myregistry.local:5000/testing/test-image:tag}.")
- (provision
- (maybe-string)
- "Set the name of the provisioned Shepherd service.")
- (requirement
- (list-of-symbols '())
- "Set additional Shepherd services dependencies to the provisioned Shepherd
-service.")
- (log-file
- (maybe-string)
- "When @code{log-file} is set, it names the file to which the service’s
-standard output and standard error are redirected. @code{log-file} is created
-if it does not exist, otherwise it is appended to.")
- (auto-start?
- (boolean #t)
- "Whether this service should be started automatically by the Shepherd. If it
-is @code{#f} the service has to be started manually with @command{herd start}.")
- (respawn?
- (boolean #f)
- "Whether to restart the service when it stops, for instance when the
-underlying process dies.")
- (shepherd-actions
- (list '())
- "This is a list of @code{shepherd-action} records defining actions supported
-by the service."
- (sanitizer oci-sanitize-shepherd-actions))
- (network
- (maybe-string)
- "Set a Docker network for the spawned container.")
- (ports
- (list '())
- "Set the port or port ranges to expose from the spawned container. This can
-be a list of pairs or strings, even mixed:
-
-@lisp
-(list '(\"8080\" . \"80\")
- \"10443:443\")
-@end lisp
-
-Pair members can be strings, gexps or file-like objects. Strings are passed
-directly to the Docker CLI. You can refer to the
-@url{https://docs.docker.com/engine/reference/commandline/run/#publish,upstream}
-documentation for semantics."
- (sanitizer oci-sanitize-ports))
- (volumes
- (list '())
- "Set volume mappings for the spawned container. This can be a
-list of pairs or strings, even mixed:
-
-@lisp
-(list '(\"/root/data/grafana\" . \"/var/lib/grafana\")
- \"/gnu/store:/gnu/store\")
-@end lisp
-
-Pair members can be strings, gexps or file-like objects. Strings are passed
-directly to the Docker CLI. You can refer to the
-@url{https://docs.docker.com/engine/reference/commandline/run/#volume,upstream}
-documentation for semantics."
- (sanitizer oci-sanitize-volumes))
- (container-user
- (maybe-string)
- "Set the current user inside the spawned container. You can refer to the
-@url{https://docs.docker.com/engine/reference/run/#user,upstream}
-documentation for semantics.")
- (workdir
- (maybe-string)
- "Set the current working for the spawned Shepherd service.
-You can refer to the
-@url{https://docs.docker.com/engine/reference/run/#workdir,upstream}
-documentation for semantics.")
- (extra-arguments
- (list '())
- "A list of strings, gexps or file-like objects that will be directly passed
-to the @command{docker run} invokation."
- (sanitizer oci-sanitize-extra-arguments)))
-
-(define oci-container-configuration->options
- (lambda (config)
- (let ((entrypoint
- (oci-container-configuration-entrypoint config))
- (network
- (oci-container-configuration-network config))
- (user
- (oci-container-configuration-container-user config))
- (workdir
- (oci-container-configuration-workdir config)))
- (apply append
- (filter (compose not unspecified?)
- `(,(if (maybe-value-set? entrypoint)
- `("--entrypoint" ,entrypoint)
- '())
- ,(append-map
- (lambda (spec)
- (list "--env" spec))
- (oci-container-configuration-environment config))
- ,(if (maybe-value-set? network)
- `("--network" ,network)
- '())
- ,(if (maybe-value-set? user)
- `("--user" ,user)
- '())
- ,(if (maybe-value-set? workdir)
- `("--workdir" ,workdir)
- '())
- ,(append-map
- (lambda (spec)
- (list "-p" spec))
- (oci-container-configuration-ports config))
- ,(append-map
- (lambda (spec)
- (list "-v" spec))
- (oci-container-configuration-volumes config))))))))
-
-(define* (get-keyword-value args keyword #:key (default #f))
- (let ((kv (memq keyword args)))
- (if (and kv (>= (length kv) 2))
- (cadr kv)
- default)))
-
-(define (lower-operating-system os target system)
- (mlet* %store-monad
- ((tarball
- (lower-object
- (system-image (os->image os #:type docker-image-type))
- system
- #:target target)))
- (return tarball)))
-
-(define (lower-manifest name image target system)
- (define value (oci-image-value image))
- (define options (oci-image-pack-options image))
- (define image-reference
- (oci-image-reference image))
- (define image-tag
- (let* ((extra-options
- (get-keyword-value options #:extra-options))
- (image-tag-option
- (and extra-options
- (get-keyword-value extra-options #:image-tag))))
- (if image-tag-option
- '()
- `(#:extra-options (#:image-tag ,image-reference)))))
-
- (mlet* %store-monad
- ((_ (set-grafting
- (oci-image-grafts? image)))
- (guile (set-guile-for-build (default-guile)))
- (profile
- (profile-derivation value
- #:target target
- #:system system
- #:hooks '()
- #:locales? #f))
- (tarball (apply pack:docker-image
- `(,name ,profile
- ,@options
- ,@image-tag
- #:localstatedir? #t))))
- (return tarball)))
-
-(define (lower-oci-image name image)
- (define value (oci-image-value image))
- (define image-target (oci-image-target image))
- (define image-system (oci-image-system image))
- (define target
- (if (maybe-value-set? image-target)
- image-target
- (%current-target-system)))
- (define system
- (if (maybe-value-set? image-system)
- image-system
- (%current-system)))
- (with-store store
- (run-with-store store
- (match value
- ((? manifest? value)
- (lower-manifest name image target system))
- ((? operating-system? value)
- (lower-operating-system value target system))
- ((or (? gexp? value)
- (? file-like? value))
- value)
- (_
- (raise
- (formatted-message
- (G_ "oci-image value must contain only manifest,
-operating-system, gexp or file-like records but ~a was found")
- value))))
- #:target target
- #:system system)))
-
-(define (%oci-image-loader name image tag)
- (let ((docker (file-append docker-cli "/bin/docker"))
- (tarball (lower-oci-image name image)))
- (with-imported-modules '((guix build utils))
- (program-file (format #f "~a-image-loader" name)
- #~(begin
- (use-modules (guix build utils)
- (ice-9 popen)
- (ice-9 rdelim))
-
- (format #t "Loading image for ~a from ~a...~%" #$name #$tarball)
- (define line
- (read-line
- (open-input-pipe
- (string-append #$docker " load -i " #$tarball))))
-
- (unless (or (eof-object? line)
- (string-null? line))
- (format #t "~a~%" line)
- (let ((repository&tag
- (string-drop line
- (string-length
- "Loaded image: "))))
-
- (invoke #$docker "tag" repository&tag #$tag)
- (format #t "Tagged ~a with ~a...~%" #$tarball #$tag))))))))
-
-(define (oci-container-shepherd-service config)
- (define (guess-name name image)
- (if (maybe-value-set? name)
- name
- (string-append "docker-"
- (basename
- (if (string? image)
- (first (string-split image #\:))
- (oci-image-repository image))))))
-
- (let* ((docker (file-append docker-cli "/bin/docker"))
- (actions (oci-container-configuration-shepherd-actions config))
- (auto-start?
- (oci-container-configuration-auto-start? config))
- (user (oci-container-configuration-user config))
- (group (oci-container-configuration-group config))
- (host-environment
- (oci-container-configuration-host-environment config))
- (command (oci-container-configuration-command config))
- (log-file (oci-container-configuration-log-file config))
- (provision (oci-container-configuration-provision config))
- (requirement (oci-container-configuration-requirement config))
- (respawn?
- (oci-container-configuration-respawn? config))
- (image (oci-container-configuration-image config))
- (image-reference (oci-image-reference image))
- (options (oci-container-configuration->options config))
- (name (guess-name provision image))
- (extra-arguments
- (oci-container-configuration-extra-arguments config)))
-
- (shepherd-service (provision `(,(string->symbol name)))
- (requirement `(dockerd user-processes ,@requirement))
- (respawn? respawn?)
- (auto-start? auto-start?)
- (documentation
- (string-append
- "Docker backed Shepherd service for "
- (if (oci-image? image) name image) "."))
- (start
- #~(lambda ()
- #$@(if (oci-image? image)
- #~((invoke #$(%oci-image-loader
- name image image-reference)))
- #~())
- (fork+exec-command
- ;; docker run [OPTIONS] IMAGE [COMMAND] [ARG...]
- (list #$docker "run" "--rm" "--name" #$name
- #$@options #$@extra-arguments
- #$image-reference #$@command)
- #:user #$user
- #:group #$group
- #$@(if (maybe-value-set? log-file)
- (list #:log-file log-file)
- '())
- #:environment-variables
- (list #$@host-environment))))
- (stop
- #~(lambda _
- (invoke #$docker "rm" "-f" #$name)))
- (actions
- (if (oci-image? image)
- '()
- (append
- (list
- (shepherd-action
- (name 'pull)
- (documentation
- (format #f "Pull ~a's image (~a)."
- name image))
- (procedure
- #~(lambda _
- (invoke #$docker "pull" #$image)))))
- actions))))))
-
-(define %oci-container-accounts
- (list (user-account
- (name "oci-container")
- (comment "OCI services account")
- (group "docker")
- (system? #t)
- (home-directory "/var/empty")
- (shell (file-append shadow "/sbin/nologin")))))
-
(define (configs->shepherd-services configs)
(map oci-container-shepherd-service configs))
diff --git a/gnu/tests/docker.scm b/gnu/tests/docker.scm
index 90c8d0f8508..5dcf05a17e3 100644
--- a/gnu/tests/docker.scm
+++ b/gnu/tests/docker.scm
@@ -1,7 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019 Danny Milosavljevic <dannym <at> scratchpost.org>
;;; Copyright © 2019-2023 Ludovic Courtès <ludo <at> gnu.org>
-;;; Copyright © 2024 Giacomo Leidi <goodoldpaul <at> autistici.org>
+;;; Copyright © 2024, 2025 Giacomo Leidi <goodoldpaul <at> autistici.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -414,71 +414,54 @@ (define (run-oci-container-test)
(test-runner-current (system-test-runner #$output))
(test-begin "oci-container")
- (test-assert "containerd service running"
- (marionette-eval
- '(begin
- (use-modules (gnu services herd))
- (match (start-service 'containerd)
- (#f #f)
- (('service response-parts ...)
- (match (assq-ref response-parts 'running)
- ((pid) pid)))))
- marionette))
-
- (test-assert "containerd PID file present"
- (wait-for-file "/run/containerd/containerd.pid" marionette))
-
- (test-assert "dockerd running"
- (marionette-eval
- '(begin
- (use-modules (gnu services herd))
- (match (start-service 'dockerd)
- (#f #f)
- (('service response-parts ...)
- (match (assq-ref response-parts 'running)
- ((pid) pid)))))
- marionette))
-
- (sleep 10) ; let service start
+ (wait-for-file "/run/containerd/containerd.pid" marionette)
(test-assert "docker-guile running"
(marionette-eval
'(begin
(use-modules (gnu services herd))
- (match (start-service 'docker-guile)
- (#f #f)
- (('service response-parts ...)
- (match (assq-ref response-parts 'running)
- ((pid) pid)))))
+ (wait-for-service 'docker-guile #:timeout 120)
+ #t)
marionette))
- (test-equal "passing host environment variables and volumes"
- '("value" "hello")
- (marionette-eval
- `(begin
- (use-modules (ice-9 popen)
- (ice-9 rdelim))
-
- (define slurp
- (lambda args
- (let* ((port (apply open-pipe* OPEN_READ args))
- (output (let ((line (read-line port)))
- (if (eof-object? line)
- ""
- line)))
- (status (close-pipe port)))
- output)))
- (let* ((response1 (slurp
- ,(string-append #$docker-cli "/bin/docker")
- "exec" "docker-guile"
- "/bin/guile" "-c" "(display (getenv \"VARIABLE\"))"))
- (response2 (slurp
- ,(string-append #$docker-cli "/bin/docker")
- "exec" "docker-guile"
- "/bin/guile" "-c" "(begin (use-modules (ice-9 popen) (ice-9 rdelim))
+ (test-assert "passing host environment variables and volumes"
+ (begin
+ (define (run-test)
+ (marionette-eval
+ `(begin
+ (use-modules (ice-9 popen)
+ (ice-9 rdelim))
+
+ (define slurp
+ (lambda args
+ (let* ((port (apply open-pipe* OPEN_READ args))
+ (output (let ((line (read-line port)))
+ (if (eof-object? line)
+ ""
+ line)))
+ (status (close-pipe port)))
+ output)))
+ (let* ((response1 (slurp
+ ,(string-append #$docker-cli "/bin/docker")
+ "exec" "docker-guile"
+ "/bin/guile" "-c" "(display (getenv \"VARIABLE\"))"))
+ (response2 (slurp
+ ,(string-append #$docker-cli "/bin/docker")
+ "exec" "docker-guile"
+ "/bin/guile" "-c" "(begin (use-modules (ice-9 popen) (ice-9 rdelim))
(display (call-with-input-file \"/shared.txt\" read-line)))")))
- (list response1 response2)))
- marionette))
+ (list response1 response2)))
+ marionette))
+ ;; Allow services to come up on slower machines
+ (let loop ((attempts 0))
+ (if (= attempts 60)
+ (error "Service didn't come up after more than 60 seconds")
+ (if (equal? '("value" "hello")
+ (run-test))
+ #t
+ (begin
+ (sleep 1)
+ (loop (+ 1 attempts))))))))
(test-end))))
--
2.48.1
guix-patches <at> gnu.org:bug#76081; Package guix-patches.
(Wed, 26 Feb 2025 23:02:02 GMT) Full text and rfc822 format available.Message #83 received at 76081 <at> debbugs.gnu.org (full text, mbox):
From: paul <goodoldpaul <at> autistici.org> To: 76081 <at> debbugs.gnu.org Subject: Re: OCI provisioning service Date: Thu, 27 Feb 2025 00:01:16 +0100
Hi guix, On 2/18/25 02:20, paul wrote: > Hi, > > On 2/12/25 02:09, paul wrote: >> Hi guix, >> >> On 2/9/25 21:38, paul wrote: >>> I'm sending a v3 fixing a bug in the merge algorithm for volumes and >>> networks. >>> >>> On 2/9/25 20:14, paul wrote: >>>> Hi, >>>> >>>> I'm about to send a v2. v2 compared to the first revision features: >>>> >>>> >>>> - it actually compiles all the times :) (rev 1 referenced oci-image >>>> too early for it to be working and generated a compile time error, >>>> if you recompiled it sometimes went away so I thought it was a >>>> problem of my setup. CI caught this) >>>> - it allows more values to be overridden by eventual users of the >>>> Scheme API >>>> - it allows passing extra arguments directly after each podman or >>>> docker invokation, allowing for example for overriding podman >>>> --root and similar options. >>>> >>>> All of these tests should pass: >>>> >>>> guix shell -D guix -CPW -- make check-system TESTS="oci-container >>>> oci-service-rootless-podman docker docker-system rootless-podman >>>> oci-service-docker" >>>> >> I'm sending a v4 changing slightly the image loader, the same tests >> as before are supposed to pass. Now the Home service [0] is working >> for me with rootless podman. I'll try it on different distros if I >> manage to. > > I'm sending a v5 implementing a Home service. The changes compared to > v4 are pretty trivial as the plumbing was already there, the only > downside is that I'm not able to use for-home? in > define-configuration, so I had to reimplement oci-configuration with > (guix records) and had to reimplement some validation (gnu services > configuration) would figure out magically. I'm sending a v6. Compared to v5 it resolves the conflicts with master and it should fix the stop action for rootless podman backed services. Thank you for all your work, giacomo
guix-patches <at> gnu.org:bug#76081; Package guix-patches.
(Wed, 26 Feb 2025 23:09:01 GMT) Full text and rfc822 format available.Message #86 received at 76081 <at> debbugs.gnu.org (full text, mbox):
From: Giacomo Leidi <goodoldpaul <at> autistici.org> To: 76081 <at> debbugs.gnu.org Cc: Giacomo Leidi <goodoldpaul <at> autistici.org> Subject: [PATCH v6 1/5] services: rootless-podman: Use login shell. Date: Thu, 27 Feb 2025 00:08:06 +0100
This commit allows for having PATH set when changing the owner of
/sys/fs/group.
* gnu/services/containers.scm (crgroups-fs-owner): Use login shell.
Change-Id: I9510c637a5332325e05ca5ebc9dfd4de32685c50
---
gnu/services/containers.scm | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm
index b3cd109ce6c..d5a211765a6 100644
--- a/gnu/services/containers.scm
+++ b/gnu/services/containers.scm
@@ -140,7 +140,7 @@ (define (cgroups-fs-owner-entrypoint config)
(rootless-podman-configuration-group-name config))
(program-file "cgroups2-fs-owner-entrypoint"
#~(system*
- (string-append #+bash-minimal "/bin/bash") "-c"
+ (string-append #+bash-minimal "/bin/bash") "-l" "-c"
(string-append "echo Setting /sys/fs/cgroup "
"group ownership to " #$group " && chown -v "
"root:" #$group " /sys/fs/cgroup && "
base-commit: 4f220482de742c9c03cf6378ab147026a330edd0
--
2.48.1
ludo <at> gnu.org, maxim.cournoyer <at> gmail.com, guix-patches <at> gnu.org:bug#76081; Package guix-patches.
(Wed, 26 Feb 2025 23:09:02 GMT) Full text and rfc822 format available.Message #89 received at 76081 <at> debbugs.gnu.org (full text, mbox):
From: Giacomo Leidi <goodoldpaul <at> autistici.org> To: 76081 <at> debbugs.gnu.org Cc: Giacomo Leidi <goodoldpaul <at> autistici.org> Subject: [PATCH v6 3/5] services: Add oci-service-type. Date: Thu, 27 Feb 2025 00:08:08 +0100
This patch implements a generalization of the
oci-container-service-type, which consequently is made deprecated. The
oci-service-type, in addition to all the features from the
oci-container-service-type, can now provision OCI networks and volumes.
It only handles OCI objects creation, the user is supposed to handle
state once the objects are provsioned.
It currently supports two different OCI runtimes: Docker and rootless
Podman. Both runtimes are tested to make sure provisioned containers
can connect to each other through provisioned networks and can
read/write data with provisioned volumes.
At last the Scheme API is thought to facilitate the implementation of a
Guix Home service in the future.
* gnu/services/containers.scm (%oci-supported-runtimes): New variable;
(oci-runtime-cli): new variable;
(oci-runtime-name): new variable;
(oci-network-configuration): new variable;
(oci-volume-configuration): new variable;
(oci-configuration): new variable;
(oci-extension): new variable;
(oci-networks-shepherd-name): new variable;
(oci-service-type): new variable;
(oci-state->shepherd-services): new variable.
* doc/guix.texi: Document it.
* gnu/tests/containers.scm: Test it.
* gnu/services/docker.scm: Deprecate the oci-container-service-type.
Change-Id: I656b3db85832e42d53072fcbfb91d1226f39ef38
---
doc/guix.texi | 306 ++++++--
gnu/services/containers.scm | 1314 ++++++++++++++++++++++++++++++-----
gnu/services/docker.scm | 37 +-
gnu/tests/containers.scm | 999 +++++++++++++++++++++++++-
4 files changed, 2404 insertions(+), 252 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index a036c85c31a..fd08261af3b 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -42325,59 +42325,162 @@ Miscellaneous Services
@cindex OCI-backed, Shepherd services
@subsubheading OCI backed services
-Should you wish to manage your Docker containers with the same consistent
-interface you use for your other Shepherd services,
-@var{oci-container-service-type} is the tool to use: given an
-@acronym{Open Container Initiative, OCI} container image, it will run it in a
+Should you wish to manage your @acronym{Open Container Initiative, OCI} containers
+with the same consistent interface you use for your other Shepherd services,
+@var{oci-service-type} is the tool to use: given an
+OCI container image, it will run it in a
Shepherd service. One example where this is useful: it lets you run services
-that are available as Docker/OCI images but not yet packaged for Guix.
+that are available as OCI images but not yet packaged for Guix.
-@defvar oci-container-service-type
+@defvar oci-service-type
-This is a thin wrapper around Docker's CLI that executes OCI images backed
+This is a thin wrapper around Docker's or Podman's CLI that executes OCI images backed
processes as Shepherd Services.
@lisp
-(service oci-container-service-type
- (list
- (oci-container-configuration
- (network "host")
- (image
- (oci-image
- (repository "guile")
- (tag "3")
- (value (specifications->manifest '("guile")))
- (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile"))
- #:max-layers 2))))
- (entrypoint "/bin/guile")
- (command
- '("-c" "(display \"hello!\n\")")))
- (oci-container-configuration
- (image "prom/prometheus")
- (ports
- '(("9000" . "9000")
- ("9090" . "9090"))))
- (oci-container-configuration
- (image "grafana/grafana:10.0.1")
- (network "host")
- (volumes
- '("/var/lib/grafana:/var/lib/grafana")))))
+(simple-service 'oci-provisioning
+ oci-service-type
+ (oci-extension
+ (networks
+ (list
+ (oci-network-configuration (name "monitoring"))))
+ (containers
+ (list
+ (oci-container-configuration
+ (network "monitoring")
+ (image
+ (oci-image
+ (repository "guile")
+ (tag "3")
+ (value (specifications->manifest '("guile")))
+ (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile"))
+ #:max-layers 2))))
+ (entrypoint "/bin/guile")
+ (command
+ '("-c" "(display \"hello!\n\")")))
+ (oci-container-configuration
+ (image "prom/prometheus")
+ (network "host")
+ (ports
+ '(("9000" . "9000")
+ ("9090" . "9090"))))
+ (oci-container-configuration
+ (image "grafana/grafana:10.0.1")
+ (network "host")
+ (volumes
+ '("/var/lib/grafana:/var/lib/grafana")))))))
@end lisp
In this example three different Shepherd services are going to be added to the
system. Each @code{oci-container-configuration} record translates to a
-@code{docker run} invocation and its fields directly map to options. You can
-refer to the
-@url{https://docs.docker.com/engine/reference/commandline/run,upstream}
-documentation for the semantics of each value. If the images are not found,
-they will be
-@url{https://docs.docker.com/engine/reference/commandline/pull/,pulled}. The
+@command{docker run} or @command{podman run} invocation and its fields directly
+map to options. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html,Podman}
+upstream documentation for semantics of each value. If the images are not found,
+they will be pulled. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/pull/,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-pull.1.html,Podman}
+upstream documentation for semantics. The
services with @code{(network "host")} are going to be attached to the
host network and are supposed to behave like native processes with regard to
networking.
@end defvar
+@c %start of fragment
+
+@deftp {Data Type} oci-configuration
+Available @code{oci-configuration} fields are:
+
+@table @asis
+@item @code{runtime} (default: @code{'docker}) (type: symbol)
+The OCI runtime to use to run commands. It can be either @code{'docker} or
+@code{'podman}.
+
+@item @code{runtime-cli} (type: maybe-package-or-string)
+The OCI runtime command line to be installed in the system profile and used
+to provision OCI resources. When unset it will default to @code{docker-cli}
+package for the @code{'docker} runtime or to @code{podman} package for the
+@code{'podman} runtime. When a string is passed it will be interpreted as the
+absolute file-system path of the selected OCI runtime command.
+
+@item @code{runtime-extra-arguments} (default: @code{'()}) (type: list)
+A list of strings, gexps or file-like objects that will be placed
+after each @command{docker} or @command{podman} invokation.
+
+@item @code{user} (type: maybe-string)
+The user name under whose authority OCI commands will be run. This field will
+override the @code{user} field of @code{oci-configuration}.
+
+@item @code{group} (type: maybe-string)
+The group name under whose authority OCI commands will be run. When
+using the @code{'podman} OCI runtime, this field will be ignored and the
+default group of the user configured in the @code{user} field will be used.
+This field will override the @code{group} field of @code{oci-configuration}.
+
+@item @code{subuids-range} (type: maybe-subid-range)
+An optional @code{subid-range} record allocating subuids for the user from
+the @code{user} field. When unset, with the rootless Podman OCI runtime, it
+defaults to @code{(subid-range (name "oci-container"))}.
+
+@item @code{subgids-range} (type: maybe-subid-range)
+An optional @code{subid-range} record allocating subgids for the user from
+the @code{user} field. When unset, with the rootless Podman OCI runtime, it
+defaults to @code{(subid-range (name "oci-container"))}.
+
+@item @code{containers} (default: @code{'()}) (type: list-of-oci-containers)
+The list of @code{oci-container-configuration} records representing the
+containers to provision. Most users are supposed not to use this field and use
+the @code{oci-extension} record instead.
+
+@item @code{networks} (default: @code{'()}) (type: list-of-oci-networks)
+The list of @code{oci-network-configuration} records representing the
+containers to provision. Most users are supposed not to use this field and use
+the @code{oci-extension} record instead.
+
+@item @code{volumes} (default: @code{'()}) (type: list-of-oci-volumes)
+The list of @code{oci-volumes-configuration} records representing the
+containers to provision. Most users are supposed not to use this field and use
+the @code{oci-extension} record instead.
+
+@item @code{verbose?} (default: @code{#f}) (type: boolean)
+When true, additional output will be printed, allowing to better follow the
+flow of execution.
+
+@end table
+
+@end deftp
+
+
+@c %end of fragment
+
+@c %start of fragment
+
+@deftp {Data Type} oci-extension
+Available @code{oci-extension} fields are:
+
+@table @asis
+@item @code{containers} (default: @code{'()}) (type: list-of-oci-containers)
+The list of @code{oci-container-configuration} records representing the
+containers to provision.
+
+@item @code{networks} (default: @code{'()}) (type: list-of-oci-networks)
+The list of @code{oci-network-configuration} records representing the
+containers to provision.
+
+@item @code{volumes} (default: @code{'()}) (type: list-of-oci-volumes)
+The list of @code{oci-volumes-configuration} records representing the
+containers to provision.
+
+@end table
+
+@end deftp
+
+
+@c %end of fragment
+
+
@c %start of fragment
@deftp {Data Type} oci-container-configuration
@@ -42397,16 +42500,16 @@ Miscellaneous Services
Overwrite the default entrypoint (@code{ENTRYPOINT}) of the image.
@item @code{host-environment} (default: @code{'()}) (type: list)
-Set environment variables in the host environment where @command{docker
-run} is invoked. This is especially useful to pass secrets from the
-host to the container without having them on the @command{docker run}'s
-command line: by setting the @code{MYSQL_PASSWORD} on the host and by passing
+Set environment variables in the host environment where @command{docker run}
+or @command{podman run} are invoked. This is especially useful to pass secrets
+from the host to the container without having them on the OCI runtime command line,
+for example: by setting the @code{MYSQL_PASSWORD} on the host and by passing
@code{--env MYSQL_PASSWORD} through the @code{extra-arguments} field, it is
possible to securely set values in the container environment. This field's
value can be a list of pairs or strings, even mixed:
@lisp
-(list '("LANGUAGE\" . "eo:ca:eu")
+(list '("LANGUAGE" . "eo:ca:eu")
"JAVA_HOME=/opt/java")
@end lisp
@@ -42414,22 +42517,24 @@ Miscellaneous Services
directly to @code{make-forkexec-constructor}.
@item @code{environment} (default: @code{'()}) (type: list)
-Set environment variables. This can be a list of pairs or strings, even mixed:
+Set environment variables inside the container. This can be a list of pairs
+or strings, even mixed:
@lisp
(list '("LANGUAGE" . "eo:ca:eu")
"JAVA_HOME=/opt/java")
@end lisp
-Pair members can be strings, gexps or file-like objects.
-Strings are passed directly to the Docker CLI. You can refer to the
-@uref{https://docs.docker.com/engine/reference/commandline/run/#env,upstream}
-documentation for semantics.
+Pair members can be strings, gexps or file-like objects. Strings are passed
+directly to the OCI runtime CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#env,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#env-e-env,Podman}
+upstream documentation for semantics.
@item @code{image} (type: string-or-oci-image)
The image used to build the container. It can be a string or an
-@code{oci-image} record. Strings are resolved by the Docker Engine, and
-follow the usual format
+@code{oci-image} record. Strings are resolved by the OCI runtime,
+and follow the usual format
@code{myregistry.local:5000/testing/test-image:tag}.
@item @code{provision} (default: @code{""}) (type: string)
@@ -42457,7 +42562,7 @@ Miscellaneous Services
by the service.
@item @code{network} (default: @code{""}) (type: string)
-Set a Docker network for the spawned container.
+Set an OCI network for the spawned container.
@item @code{ports} (default: @code{'()}) (type: list)
Set the port or port ranges to expose from the spawned container. This can be a
@@ -42468,10 +42573,11 @@ Miscellaneous Services
"10443:443")
@end lisp
-Pair members can be strings, gexps or file-like objects.
-Strings are passed directly to the Docker CLI. You can refer to the
-@uref{https://docs.docker.com/engine/reference/commandline/run/#publish,upstream}
-documentation for semantics.
+Pair members can be strings, gexps or file-like objects. Strings are passed
+directly to the OCI runtime CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#publish,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#publish-p-ip-hostport-containerport-protocol,Podman}
+upstream documentation for semantics.
@item @code{volumes} (default: @code{'()}) (type: list)
Set volume mappings for the spawned container. This can be a
@@ -42482,25 +42588,97 @@ Miscellaneous Services
"/gnu/store:/gnu/store")
@end lisp
-Pair members can be strings, gexps or file-like objects.
-Strings are passed directly to the Docker CLI. You can refer to the
-@uref{https://docs.docker.com/engine/reference/commandline/run/#volume,upstream}
-documentation for semantics.
+Pair members can be strings, gexps or file-like objects. Strings are passed
+directly to the OCI runtime CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#volume,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#volume-v-source-volume-host-dir-container-dir-options,Podman}
+upstream documentation for semantics.
@item @code{container-user} (default: @code{""}) (type: string)
Set the current user inside the spawned container. You can refer to the
-@url{https://docs.docker.com/engine/reference/run/#user,upstream}
-documentation for semantics.
+@url{https://docs.docker.com/engine/reference/run/#user,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#user-u-user-group,Podman}
+upstream documentation for semantics.
@item @code{workdir} (default: @code{""}) (type: string)
Set the current working directory for the spawned Shepherd service.
You can refer to the
-@url{https://docs.docker.com/engine/reference/run/#workdir,upstream}
-documentation for semantics.
+@url{https://docs.docker.com/engine/reference/run/#workdir,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#workdir-w-dir,Podman}
+upstream documentation for semantics.
+
+@item @code{extra-arguments} (default: @code{'()}) (type: list)
+A list of strings, gexps or file-like objects that will be directly passed
+to the @command{docker run} or @command{podman run} invokation.
+
+@end table
+
+@end deftp
+
+
+@c %end of fragment
+
+@c %start of fragment
+
+@deftp {Data Type} oci-network-configuration
+Available @code{oci-network-configuration} fields are:
+
+@table @asis
+@item @code{name} (type: string)
+The name of the OCI network to provision.
+
+@item @code{driver} (type: maybe-string)
+The driver to manage the network.
+
+@item @code{gateway} (type: maybe-string)
+IPv4 or IPv6 gateway for the subnet.
+
+@item @code{internal?} (default: @code{#f}) (type: boolean)
+Restrict external access to the network
+
+@item @code{ip-range} (type: maybe-string)
+Allocate container ip from a sub-range in CIDR format.
+
+@item @code{ipam-driver} (type: maybe-string)
+IP Address Management Driver.
+
+@item @code{ipv6?} (default: @code{#f}) (type: boolean)
+Enable IPv6 networking.
+
+@item @code{subnet} (type: maybe-string)
+Subnet in CIDR format that represents a network segment.
+
+@item @code{labels} (default: @code{'()}) (type: list)
+The list of labels that will be used to tag the current volume.
+
+@item @code{extra-arguments} (default: @code{'()}) (type: list)
+A list of strings, gexps or file-like objects that will be directly passed
+to the @command{docker network create} or @command{podman network create}
+invokation.
+
+@end table
+
+@end deftp
+
+
+@c %end of fragment
+
+@c %start of fragment
+
+@deftp {Data Type} oci-volume-configuration
+Available @code{oci-volume-configuration} fields are:
+
+@table @asis
+@item @code{name} (type: string)
+The name of the OCI volume to provision.
+
+@item @code{labels} (default: @code{'()}) (type: list)
+The list of labels that will be used to tag the current volume.
@item @code{extra-arguments} (default: @code{'()}) (type: list)
-A list of strings, gexps or file-like objects that will be directly
-passed to the @command{docker run} invocation.
+A list of strings, gexps or file-like objects that will be directly passed
+to the @command{docker volume create} or @command{podman volume create}
+invokation.
@end table
diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm
index 24f31c756b8..603eec25e2b 100644
--- a/gnu/services/containers.scm
+++ b/gnu/services/containers.scm
@@ -39,8 +39,10 @@ (define-module (gnu services containers)
#:use-module (guix packages)
#:use-module (guix profiles)
#:use-module ((guix scripts pack) #:prefix pack:)
+ #:use-module (guix records)
#:use-module (guix store)
#:use-module (srfi srfi-1)
+ #:use-module (ice-9 format)
#:use-module (ice-9 match)
#:export (rootless-podman-configuration
rootless-podman-configuration?
@@ -96,8 +98,80 @@ (define-module (gnu services containers)
oci-container-configuration-workdir
oci-container-configuration-extra-arguments
+ list-of-oci-containers?
+ list-of-oci-networks?
+ list-of-oci-volumes?
+
+ %oci-supported-runtimes
+ oci-sanitize-runtime
+ oci-runtime-system-environment
+ oci-runtime-system-extra-arguments
+ oci-runtime-system-group
+ oci-runtime-system-requirement
+ oci-runtime-cli
+ oci-runtime-system-cli
+ oci-runtime-home-cli
+ oci-runtime-name
+ oci-runtime-group
+
+ oci-network-configuration
+ oci-network-configuration?
+ oci-network-configuration-fields
+ oci-network-configuration-name
+ oci-network-configuration-driver
+ oci-network-configuration-gateway
+ oci-network-configuration-internal?
+ oci-network-configuration-ip-range
+ oci-network-configuration-ipam-driver
+ oci-network-configuration-ipv6?
+ oci-network-configuration-subnet
+ oci-network-configuration-labels
+ oci-network-configuration-extra-arguments
+
+ oci-volume-configuration
+ oci-volume-configuration?
+ oci-volume-configuration-fields
+ oci-volume-configuration-name
+ oci-volume-configuration-labels
+ oci-volume-configuration-extra-arguments
+
+ oci-configuration
+ oci-configuration?
+ oci-configuration-runtime
+ oci-configuration-runtime-cli
+ oci-configuration-runtime-extra-arguments
+ oci-configuration-user
+ oci-configuration-group
+ oci-configuration-containers
+ oci-configuration-networks
+ oci-configuration-volumes
+ oci-configuration-verbose?
+ oci-configuration-valid?
+
+ oci-extension
+ oci-extension?
+ oci-extension-fields
+ oci-extension-containers
+ oci-extension-networks
+ oci-extension-volumes
+
+ oci-container-shepherd-name
+ oci-networks-shepherd-name
+ oci-networks-home-shepherd-name
+ oci-volumes-shepherd-name
+ oci-volumes-home-shepherd-name
+
oci-container-shepherd-service
- %oci-container-accounts))
+ oci-objects-merge-lst
+ oci-extension-merge
+ oci-service-extension-wrap-validate
+ oci-service-type
+ oci-service-accounts
+ oci-service-profile
+ oci-service-subids
+ oci-state->shepherd-services
+ oci-configuration->shepherd-services
+ oci-configuration-extend))
(define (gexp-or-string? value)
(or (gexp? value)
@@ -296,9 +370,42 @@ (define rootless-podman-service-type
;;;
-;;; OCI container.
+;;; OCI provisioning service.
;;;
+(define %oci-supported-runtimes
+ '(docker podman))
+
+(define (oci-runtime-system-requirement runtime)
+ "Return a list of Shepherd service names required by a given OCI runtime,
+before it is able to run containers."
+ (if (eq? 'podman runtime)
+ '(cgroups2-fs-owner cgroups2-limits
+ rootless-podman-shared-root-fs user-processes)
+ '(dockerd user-processes)))
+
+(define (oci-runtime-name runtime)
+ "Return a human readable name for a given OCI runtime."
+ (if (eq? 'podman runtime)
+ "Podman" "Docker"))
+
+(define (oci-runtime-group runtime maybe-group)
+ "Implement the logic behind selection of the group that is to be used by
+Shepherd to execute OCI commands."
+ (if (eq? maybe-group #f)
+ (if (eq? 'podman runtime)
+ "cgroup"
+ "docker")
+ maybe-group))
+
+(define (oci-sanitize-runtime value)
+ (unless (member value %oci-supported-runtimes)
+ (raise
+ (formatted-message
+ (G_ "OCI runtime must be a symbol and one of ~a,
+but ~a was found") %oci-supported-runtimes value)))
+ value)
+
(define (oci-sanitize-pair pair delimiter)
(define (valid? member)
(or (string? member)
@@ -347,6 +454,11 @@ (define (oci-sanitize-volumes value)
;; '(("/mnt/dir" . "/dir") "/run/current-system/profile:/java")
(oci-sanitize-mixed-list "volumes" value ":"))
+(define (oci-sanitize-labels value)
+ ;; Expected spec format:
+ ;; '(("foo" . "bar") "foo=bar")
+ (oci-sanitize-mixed-list "labels" value "="))
+
(define (oci-sanitize-shepherd-actions value)
(map
(lambda (el)
@@ -374,10 +486,15 @@ (define (oci-sanitize-extra-arguments value)
value))
(define (oci-image-reference image)
- (if (string? image)
- image
- (string-append (oci-image-repository image)
- ":" (oci-image-tag image))))
+ "Return a string OCI image reference representing IMAGE."
+ (define reference
+ (if (string? image)
+ image
+ (string-append (oci-image-repository image)
+ ":" (oci-image-tag image))))
+ (if (> (length (string-split reference #\/)) 1)
+ reference
+ (string-append "localhost/" reference)))
(define (oci-lowerable-image? image)
(or (manifest? image)
@@ -392,7 +509,19 @@ (define (string-or-oci-image? image)
(define list-of-symbols?
(list-of symbol?))
+(define (list-of-oci-records? name predicate value)
+ (map
+ (lambda (el)
+ (if (predicate el)
+ el
+ (raise
+ (formatted-message
+ (G_ "~a contains an illegal value: ~a") name el))))
+ value))
+
(define-maybe/no-serialization string)
+(define-maybe/no-serialization package)
+(define-maybe/no-serialization subid-range)
(define-configuration/no-serialization oci-image
(repository
@@ -437,11 +566,15 @@ (define-configuration/no-serialization oci-image
(define-configuration/no-serialization oci-container-configuration
(user
- (string "oci-container")
- "The user under whose authority docker commands will be run.")
+ (maybe-string)
+ "The user name under whose authority OCI commands will be run. This field will
+override the @code{user} field of @code{oci-configuration}.")
(group
- (string "docker")
- "The group under whose authority docker commands will be run.")
+ (maybe-string)
+ "The group name under whose authority OCI commands will be run. When
+using the @code{'podman} OCI runtime, this field will be ignored and the
+default group of the user configured in the @code{user} field will be used.
+This field will override the @code{group} field of @code{oci-configuration}.")
(command
(list-of-strings '())
"Overwrite the default command (@code{CMD}) of the image.")
@@ -451,9 +584,9 @@ (define-configuration/no-serialization oci-container-configuration
(host-environment
(list '())
"Set environment variables in the host environment where @command{docker run}
-is invoked. This is especially useful to pass secrets from the host to the
-container without having them on the @command{docker run}'s command line: by
-setting the @code{MYSQL_PASSWORD} on the host and by passing
+or @command{podman run} are invoked. This is especially useful to pass secrets
+from the host to the container without having them on the OCI runtime command line,
+for example: by setting the @code{MYSQL_PASSWORD} on the host and by passing
@code{--env MYSQL_PASSWORD} through the @code{extra-arguments} field, it is
possible to securely set values in the container environment. This field's
value can be a list of pairs or strings, even mixed:
@@ -477,15 +610,16 @@ (define-configuration/no-serialization oci-container-configuration
@end lisp
Pair members can be strings, gexps or file-like objects. Strings are passed
-directly to the Docker CLI. You can refer to the
-@url{https://docs.docker.com/engine/reference/commandline/run/#env,upstream}
-documentation for semantics."
+directly to the OCI runtime CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#env,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#env-e-env,Podman}
+upstream documentation for semantics."
(sanitizer oci-sanitize-environment))
(image
(string-or-oci-image)
"The image used to build the container. It can be a string or an
-@code{oci-image} record. Strings are resolved by the Docker
-Engine, and follow the usual format
+@code{oci-image} record. Strings are resolved by the OCI runtime,
+and follow the usual format
@code{myregistry.local:5000/testing/test-image:tag}.")
(provision
(maybe-string)
@@ -514,7 +648,7 @@ (define-configuration/no-serialization oci-container-configuration
(sanitizer oci-sanitize-shepherd-actions))
(network
(maybe-string)
- "Set a Docker network for the spawned container.")
+ "Set an OCI network for the spawned container.")
(ports
(list '())
"Set the port or port ranges to expose from the spawned container. This can
@@ -526,9 +660,10 @@ (define-configuration/no-serialization oci-container-configuration
@end lisp
Pair members can be strings, gexps or file-like objects. Strings are passed
-directly to the Docker CLI. You can refer to the
-@url{https://docs.docker.com/engine/reference/commandline/run/#publish,upstream}
-documentation for semantics."
+directly to the OCI runtime CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#publish,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#publish-p-ip-hostport-containerport-protocol,Podman}
+upstream documentation for semantics."
(sanitizer oci-sanitize-ports))
(volumes
(list '())
@@ -541,71 +676,363 @@ (define-configuration/no-serialization oci-container-configuration
@end lisp
Pair members can be strings, gexps or file-like objects. Strings are passed
-directly to the Docker CLI. You can refer to the
-@url{https://docs.docker.com/engine/reference/commandline/run/#volume,upstream}
-documentation for semantics."
+directly to the OCI runtime CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#volume,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#volume-v-source-volume-host-dir-container-dir-options,Podman}
+upstream documentation for semantics."
(sanitizer oci-sanitize-volumes))
(container-user
(maybe-string)
"Set the current user inside the spawned container. You can refer to the
-@url{https://docs.docker.com/engine/reference/run/#user,upstream}
-documentation for semantics.")
+@url{https://docs.docker.com/engine/reference/run/#user,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#user-u-user-group,Podman}
+upstream documentation for semantics.")
(workdir
(maybe-string)
- "Set the current working for the spawned Shepherd service.
+ "Set the current working directory for the spawned Shepherd service.
You can refer to the
-@url{https://docs.docker.com/engine/reference/run/#workdir,upstream}
-documentation for semantics.")
+@url{https://docs.docker.com/engine/reference/run/#workdir,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#workdir-w-dir,Podman}
+upstream documentation for semantics.")
(extra-arguments
(list '())
"A list of strings, gexps or file-like objects that will be directly passed
-to the @command{docker run} invokation."
+to the @command{docker run} or @command{podman run} invocation."
(sanitizer oci-sanitize-extra-arguments)))
-(define oci-container-configuration->options
- (lambda (config)
- (let ((entrypoint
- (oci-container-configuration-entrypoint config))
- (network
- (oci-container-configuration-network config))
- (user
- (oci-container-configuration-container-user config))
- (workdir
- (oci-container-configuration-workdir config)))
- (apply append
- (filter (compose not unspecified?)
- `(,(if (maybe-value-set? entrypoint)
- `("--entrypoint" ,entrypoint)
- '())
- ,(append-map
- (lambda (spec)
- (list "--env" spec))
- (oci-container-configuration-environment config))
- ,(if (maybe-value-set? network)
- `("--network" ,network)
- '())
- ,(if (maybe-value-set? user)
- `("--user" ,user)
- '())
- ,(if (maybe-value-set? workdir)
- `("--workdir" ,workdir)
- '())
- ,(append-map
- (lambda (spec)
- (list "-p" spec))
- (oci-container-configuration-ports config))
- ,(append-map
- (lambda (spec)
- (list "-v" spec))
- (oci-container-configuration-volumes config))))))))
-
-(define* (get-keyword-value args keyword #:key (default #f))
- (let ((kv (memq keyword args)))
- (if (and kv (>= (length kv) 2))
- (cadr kv)
- default)))
+(define (list-of-oci-containers? value)
+ (list-of-oci-records? "containers" oci-container-configuration? value))
+
+(define-configuration/no-serialization oci-volume-configuration
+ (name
+ (string)
+ "The name of the OCI volume to provision.")
+ (labels
+ (list '())
+ "The list of labels that will be used to tag the current volume."
+ (sanitizer oci-sanitize-labels))
+ (extra-arguments
+ (list '())
+ "A list of strings, gexps or file-like objects that will be directly passed
+to the @command{docker volume create} or @command{podman volume create}
+invocation."
+ (sanitizer oci-sanitize-extra-arguments)))
+
+(define (list-of-oci-volumes? value)
+ (list-of-oci-records? "volumes" oci-volume-configuration? value))
+
+(define-configuration/no-serialization oci-network-configuration
+ (name
+ (string)
+ "The name of the OCI network to provision.")
+ (driver
+ (maybe-string)
+ "The driver to manage the network.")
+ (gateway
+ (maybe-string)
+ "IPv4 or IPv6 gateway for the subnet.")
+ (internal?
+ (boolean #f)
+ "Restrict external access to the network")
+ (ip-range
+ (maybe-string)
+ "Allocate container ip from a sub-range in CIDR format.")
+ (ipam-driver
+ (maybe-string)
+ "IP Address Management Driver.")
+ (ipv6?
+ (boolean #f)
+ "Enable IPv6 networking.")
+ (subnet
+ (maybe-string)
+ "Subnet in CIDR format that represents a network segment.")
+ (labels
+ (list '())
+ "The list of labels that will be used to tag the current volume."
+ (sanitizer oci-sanitize-labels))
+ (extra-arguments
+ (list '())
+ "A list of strings, gexps or file-like objects that will be directly passed
+to the @command{docker network create} or @command{podman network create}
+invocation."
+ (sanitizer oci-sanitize-extra-arguments)))
+
+(define (list-of-oci-networks? value)
+ (list-of-oci-records? "networks" oci-network-configuration? value))
+
+(define-record-type* <oci-configuration>
+ oci-configuration
+ make-oci-configuration
+ oci-configuration?
+ this-oci-configuration
+
+ (runtime oci-configuration-runtime
+ (default 'docker))
+ (runtime-cli oci-configuration-runtime-cli
+ (default #f)) ; package or string
+ (runtime-extra-arguments oci-configuration-runtime-extra-arguments ; strings or gexps
+ (default '())) ; or file-like objects
+ (user oci-configuration-user
+ (default "oci-container"))
+ (group oci-configuration-group ; string
+ (default #f))
+ (subuids-range oci-configuration-subuids-range ; subid-range
+ (default #f))
+ (subgids-range oci-configuration-subgids-range ; subid-range
+ (default #f))
+ (containers oci-configuration-containers ; oci-container-configurations
+ (default '()))
+ (networks oci-configuration-networks ; oci-network-configurations
+ (default '()))
+ (volumes oci-configuration-volumes ; oci-volume-configurations
+ (default '()))
+ (verbose? oci-configuration-verbose?
+ (default #f))
+ (home-service? oci-configuration-home-service?
+ (default for-home?) (innate)))
+
+(define (package-or-string? value)
+ (or (package? value) (string? value)))
+
+(define (oci-configuration-valid? config)
+ (define runtime-cli
+ (oci-configuration-runtime-cli config))
+ (define group
+ (oci-configuration-group config))
+ (define subuids-range
+ (oci-configuration-subuids-range config))
+ (define subgids-range
+ (oci-configuration-subgids-range config))
+ (and
+ (symbol?
+ (oci-sanitize-runtime (oci-configuration-runtime config)))
+ (or (eq? runtime-cli #f)
+ (package-or-string? runtime-cli))
+ (list? (oci-configuration-runtime-extra-arguments config))
+ (string? (oci-configuration-user config))
+ (or (eq? group #f)
+ (string? group))
+ (or (eq? subuids-range #f)
+ (subid-range? subuids-range))
+ (or (eq? subgids-range #f)
+ (subid-range? subgids-range))
+ (list-of-oci-containers?
+ (oci-configuration-containers config))
+ (list-of-oci-networks?
+ (oci-configuration-networks config))
+ (list-of-oci-volumes?
+ (oci-configuration-volumes config))
+ (boolean?
+ (oci-configuration-verbose? config))
+ (boolean?
+ (oci-configuration-home-service? config))))
+
+(define (oci-runtime-system-environment runtime user)
+ (if (eq? runtime 'podman)
+ (list
+ #~(string-append
+ "HOME=" (passwd:dir (getpwnam #$user))))
+ #~()))
+
+(define (oci-runtime-system-group runtime user group)
+ (if (eq? runtime 'podman)
+ #~(group:name
+ (getgrgid
+ (passwd:gid
+ (getpwnam #$user))))
+ group))
+
+(define (oci-runtime-cli runtime runtime-cli path)
+ "Return a gexp that, when lowered, evaluates to the file system path of the OCI
+runtime command requested by the user."
+ (if (string? runtime-cli)
+ ;; It is a user defined absolute path
+ runtime-cli
+ #~(string-append
+ #$(if (eq? runtime-cli #f)
+ path
+ runtime-cli)
+ #$(if (eq? 'podman runtime)
+ "/bin/podman"
+ "/bin/docker"))))
+
+(define* (oci-runtime-system-cli config #:key (path "/run/current-system/profile"))
+ (let ((runtime-cli
+ (oci-configuration-runtime-cli config))
+ (runtime
+ (oci-configuration-runtime config)))
+ (oci-runtime-cli runtime runtime-cli path)))
+
+(define (oci-runtime-home-cli config)
+ (let ((runtime-cli
+ (oci-configuration-runtime-cli config))
+ (runtime
+ (oci-configuration-runtime config)))
+ (oci-runtime-cli runtime runtime-cli
+ (string-append (getenv "HOME")
+ "/.guix-home/profile"))))
+
+(define-configuration/no-serialization oci-extension
+ (containers
+ (list-of-oci-containers '())
+ "The list of @code{oci-container-configuration} records representing the
+containers to add.")
+ (networks
+ (list-of-oci-networks '())
+ "The list of @code{oci-network-configuration} records representing the
+networks to add.")
+ (volumes
+ (list-of-oci-volumes '())
+ "The list of @code{oci-volume-configuration} records representing the
+volumes to add."))
+
+(define (oci-image->container-name image)
+ "Infer the name of an OCI backed Shepherd service from its OCI image."
+ (basename
+ (if (string? image)
+ (first (string-split image #\:))
+ (oci-image-repository image))))
+
+(define (oci-object-command-shepherd-action object-name invokation)
+ "Return a Shepherd action printing a given INVOKATION of an OCI command for the
+given OBJECT-NAME."
+ (shepherd-action
+ (name 'command-line)
+ (documentation
+ (format #f "Prints ~a's OCI runtime command line invocation."
+ object-name))
+ (procedure
+ #~(lambda _
+ (format #t "~a~%" #$invokation)))))
+
+(define (oci-container-shepherd-name runtime config)
+ "Return the name of an OCI backed Shepherd service based on CONFIG.
+The name configured in the configuration record is returned when
+CONFIG's name field has a value, otherwise a name is inferred from CONFIG's
+image field."
+ (define name (oci-container-configuration-provision config))
+ (define image (oci-container-configuration-image config))
+
+ (if (maybe-value-set? name)
+ name
+ (string-append (symbol->string runtime) "-"
+ (oci-image->container-name image))))
+
+(define (oci-networks-shepherd-name runtime)
+ "Return the name of the OCI networks provisioning Shepherd service based on
+RUNTIME."
+ (string-append (symbol->string runtime) "-networks"))
+
+(define (oci-volumes-shepherd-name runtime)
+ "Return the name of the OCI volumes provisioning Shepherd service based on
+RUNTIME."
+ (string-append (symbol->string runtime) "-volumes"))
+
+(define (oci-networks-home-shepherd-name runtime)
+ "Return the name of the OCI volumes provisioning Home Shepherd service based on
+RUNTIME."
+ (string-append "home-" (oci-networks-shepherd-name runtime)))
+
+(define (oci-volumes-home-shepherd-name runtime)
+ "Return the name of the OCI volumes provisioning Home Shepherd service based on
+RUNTIME."
+ (string-append "home-" (oci-volumes-shepherd-name runtime)))
+
+(define (oci-container-configuration->options config)
+ "Map CONFIG, an oci-container-configuration record, to a gexp that, upon
+lowering, will be evaluated to a list of strings containing command line options
+for the OCI runtime run command."
+ (let ((entrypoint
+ (oci-container-configuration-entrypoint config))
+ (network
+ (oci-container-configuration-network config))
+ (user
+ (oci-container-configuration-container-user config))
+ (workdir
+ (oci-container-configuration-workdir config)))
+ (apply append
+ (filter (compose not unspecified?)
+ `(,(if (maybe-value-set? entrypoint)
+ `("--entrypoint" ,entrypoint)
+ '())
+ ,(append-map
+ (lambda (spec)
+ (list "--env" spec))
+ (oci-container-configuration-environment config))
+ ,(if (maybe-value-set? network)
+ `("--network" ,network)
+ '())
+ ,(if (maybe-value-set? user)
+ `("--user" ,user)
+ '())
+ ,(if (maybe-value-set? workdir)
+ `("--workdir" ,workdir)
+ '())
+ ,(append-map
+ (lambda (spec)
+ (list "-p" spec))
+ (oci-container-configuration-ports config))
+ ,(append-map
+ (lambda (spec)
+ (list "-v" spec))
+ (oci-container-configuration-volumes config)))))))
+
+(define (oci-network-configuration->options config)
+ "Map CONFIG, an oci-network-configuration record, to a gexp that, upon
+lowering, will be evaluated to a list of strings containing command line options
+for the OCI runtime network create command."
+ (let ((driver (oci-network-configuration-driver config))
+ (gateway
+ (oci-network-configuration-gateway config))
+ (internal?
+ (oci-network-configuration-internal? config))
+ (ip-range
+ (oci-network-configuration-ip-range config))
+ (ipam-driver
+ (oci-network-configuration-ipam-driver config))
+ (ipv6?
+ (oci-network-configuration-ipv6? config))
+ (subnet
+ (oci-network-configuration-subnet config)))
+ (apply append
+ (filter (compose not unspecified?)
+ `(,(if (maybe-value-set? driver)
+ `("--driver" ,driver)
+ '())
+ ,(if (maybe-value-set? gateway)
+ `("--gateway" ,gateway)
+ '())
+ ,(if internal?
+ `("--internal")
+ '())
+ ,(if (maybe-value-set? ip-range)
+ `("--ip-range" ,ip-range)
+ '())
+ ,(if (maybe-value-set? ipam-driver)
+ `("--ipam-driver" ,ipam-driver)
+ '())
+ ,(if ipv6?
+ `("--ipv6")
+ '())
+ ,(if (maybe-value-set? subnet)
+ `("--subnet" ,subnet)
+ '())
+ ,(append-map
+ (lambda (spec)
+ (list "--label" spec))
+ (oci-network-configuration-labels config)))))))
+
+(define (oci-volume-configuration->options config)
+ "Map CONFIG, an oci-volume-configuration record, to a gexp that, upon
+lowering, will be evaluated to a list of strings containing command line options
+for the OCI runtime volume create command."
+ (append-map
+ (lambda (spec)
+ (list "--label" spec))
+ (oci-volume-configuration-labels config)))
(define (lower-operating-system os target system)
+ "Lower OS, an operating-system record, into a tarball containing an OCI image."
(mlet* %store-monad
((tarball
(lower-object
@@ -614,24 +1041,11 @@ (define (lower-operating-system os target system)
#:target target)))
(return tarball)))
-(define (lower-manifest name image target system)
- (define value (oci-image-value image))
- (define options (oci-image-pack-options image))
- (define image-reference
- (oci-image-reference image))
- (define image-tag
- (let* ((extra-options
- (get-keyword-value options #:extra-options))
- (image-tag-option
- (and extra-options
- (get-keyword-value extra-options #:image-tag))))
- (if image-tag-option
- '()
- `(#:extra-options (#:image-tag ,image-reference)))))
-
+(define (lower-manifest name value options image-reference
+ target system grafts?)
+ "Lower VALUE, a manifest record, into a tarball containing an OCI image."
(mlet* %store-monad
- ((_ (set-grafting
- (oci-image-grafts? image)))
+ ((_ (set-grafting grafts?))
(guile (set-guile-for-build (default-guile)))
(profile
(profile-derivation value
@@ -642,14 +1056,11 @@ (define (lower-manifest name image target system)
(tarball (apply pack:docker-image
`(,name ,profile
,@options
- ,@image-tag
#:localstatedir? #t))))
(return tarball)))
-(define (lower-oci-image name image)
- (define value (oci-image-value image))
- (define image-target (oci-image-target image))
- (define image-system (oci-image-system image))
+(define (lower-oci-image-state name value options reference
+ image-target image-system grafts?)
(define target
(if (maybe-value-set? image-target)
image-target
@@ -662,7 +1073,8 @@ (define (lower-oci-image name image)
(run-with-store store
(match value
((? manifest? value)
- (lower-manifest name image target system))
+ (lower-manifest name value options reference
+ target system grafts?))
((? operating-system? value)
(lower-operating-system value target system))
((or (? gexp? value)
@@ -677,113 +1089,665 @@ (define (lower-oci-image name image)
#:target target
#:system system)))
-(define (%oci-image-loader name image tag)
- (let ((docker (file-append docker-cli "/bin/docker"))
- (tarball (lower-oci-image name image)))
+(define (lower-oci-image name image)
+ "Lower IMAGE, a oci-image record, into a tarball containing an OCI image."
+ (lower-oci-image-state
+ name
+ (oci-image-value image)
+ (oci-image-pack-options image)
+ (oci-image-reference image)
+ (oci-image-target image)
+ (oci-image-system image)
+ (oci-image-grafts? image)))
+
+(define (oci-object-exists? runtime runtime-cli object verbose?)
+ #~(lambda* (name #:key (format-string "{{.Name}}"))
+ (use-modules (ice-9 format)
+ (ice-9 match)
+ (ice-9 popen)
+ (ice-9 rdelim)
+ (srfi srfi-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)))
+
+ #$(if (eq? runtime 'podman)
+ #~(let ((command
+ (list #$runtime-cli
+ #$object "exists" name)))
+ (when #$verbose?
+ (format #t "Running~{ ~a~}~%" command))
+ (define exit-code (status:exit-val (apply system* command)))
+ (when #$verbose?
+ (format #t "Exit code: ~a~%" exit-code))
+ (equal? EXIT_SUCCESS exit-code))
+ #~(let ((command
+ (string-append #$runtime-cli
+ " " #$object " ls --format "
+ "\"" format-string "\"")))
+ (when #$verbose?
+ (format #t "Running ~a~%" command))
+ (member name (read-lines (open-input-pipe command)))))))
+
+(define* (oci-image-loader runtime runtime-cli name image tag #:key (verbose? #f))
+ "Return a file-like object that, once lowered, will evaluate to a program able
+to load IMAGE through RUNTIME-CLI and to tag it with TAG afterwards."
+ (let ((tarball (lower-oci-image name image)))
(with-imported-modules '((guix build utils))
- (program-file (format #f "~a-image-loader" name)
+ (program-file
+ (format #f "~a-image-loader" name)
#~(begin
(use-modules (guix build utils)
+ (ice-9 match)
(ice-9 popen)
- (ice-9 rdelim))
-
- (format #t "Loading image for ~a from ~a...~%" #$name #$tarball)
- (define line
- (read-line
- (open-input-pipe
- (string-append #$docker " load -i " #$tarball))))
-
- (unless (or (eof-object? line)
- (string-null? line))
- (format #t "~a~%" line)
- (let ((repository&tag
- (string-drop line
- (string-length
- "Loaded image: "))))
-
- (invoke #$docker "tag" repository&tag #$tag)
- (format #t "Tagged ~a with ~a...~%" #$tarball #$tag))))))))
-
-(define (oci-container-shepherd-service config)
- (define (guess-name name image)
- (if (maybe-value-set? name)
- name
- (string-append "docker-"
- (basename
- (if (string? image)
- (first (string-split image #\:))
- (oci-image-repository image))))))
-
- (let* ((docker (file-append docker-cli "/bin/docker"))
- (actions (oci-container-configuration-shepherd-actions config))
+ (ice-9 rdelim)
+ (srfi srfi-1))
+ (define object-exists?
+ #$(oci-object-exists? runtime runtime-cli "image" verbose?))
+ (define load-command
+ (string-append #$runtime-cli
+ " load -i " #$tarball))
+
+ (if (object-exists? #$tag #:format-string "{{.Repository}}:{{.Tag}}")
+ (format #t "~a image already exists, skipping.~%" #$tag)
+ (begin
+ (format #t "Loading image for ~a from ~a...~%" #$name #$tarball)
+ (when #$verbose?
+ (format #t "Running ~a~%" load-command))
+ (let ((line (read-line
+ (open-input-pipe load-command))))
+ (unless (or (eof-object? line)
+ (string-null? line))
+ (format #t "~a~%" line)
+ (let* ((repository&tag
+ (string-drop line
+ (string-length
+ "Loaded image: ")))
+ (tag-command
+ (list #$runtime-cli "tag" repository&tag #$tag))
+ (drop-old-tag-command
+ (list #$runtime-cli "image" "rm" "-f" repository&tag)))
+
+ (unless (string=? repository&tag #$tag)
+ (when #$verbose?
+ (format #t "Running~{ ~a~}~%" tag-command))
+
+ (let ((exit-code
+ (status:exit-val (apply system* tag-command))))
+ (format #t "Tagged ~a with ~a...~%" #$tarball #$tag)
+
+ (when #$verbose?
+ (format #t "Exit code: ~a~%" exit-code))
+
+ (when (equal? EXIT_SUCCESS exit-code)
+ (when #$verbose?
+ (format #t "Running~{ ~a~}~%" drop-old-tag-command))
+ (let ((drop-exit-code
+ (status:exit-val (apply system* drop-old-tag-command))))
+ (when #$verbose?
+ (format #t "Exit code: ~a~%" drop-exit-code))))))))))))))))
+
+(define (oci-container-run-invokation runtime-cli name command image-reference
+ options runtime-extra-arguments run-extra-arguments)
+ "Return a list representing the OCI runtime
+invocation for running containers."
+ ;; run [OPTIONS] IMAGE [COMMAND] [ARG...]
+ `(,runtime-cli ,@runtime-extra-arguments "run"
+ "--rm" "--name" ,name
+ ,@options ,@run-extra-arguments
+ ,image-reference ,@command))
+
+(define* (oci-container-entrypoint runtime runtime-cli name image image-reference
+ invokation #:key (verbose? #f))
+ "Return a file-like object that, once lowered, will evaluate to the entrypoint
+for the Shepherd service that will run IMAGE through RUNTIME-CLI."
+ (program-file
+ (string-append "oci-entrypoint-" name)
+ #~(begin
+ (use-modules (ice-9 format)
+ (srfi srfi-1))
+ (when #$verbose?
+ (format #t "Running in verbose mode...~%"))
+ (define invokation (list #$@invokation))
+ #$@(if (oci-image? image)
+ #~((system*
+ #$(oci-image-loader
+ runtime runtime-cli name image
+ image-reference #:verbose? verbose?)))
+ #~())
+ (when #$verbose?
+ (format #t "Running~{ ~a~}~%" invokation))
+ (apply execlp `(,(first invokation) ,@invokation)))))
+
+(define* (oci-container-shepherd-service runtime runtime-cli config
+ #:key
+ (runtime-environment #~())
+ (runtime-extra-arguments '())
+ (oci-requirement '())
+ (user #f)
+ (group #f)
+ (verbose? #f))
+ "Return a Shepherd service object that will run the OCI container represented
+by CONFIG through RUNTIME-CLI."
+ (let* ((actions (oci-container-configuration-shepherd-actions config))
(auto-start?
(oci-container-configuration-auto-start? config))
- (user (oci-container-configuration-user config))
- (group (oci-container-configuration-group config))
+ (maybe-user (oci-container-configuration-user config))
+ (maybe-group (oci-container-configuration-group config))
+ (user (if (maybe-value-set? maybe-user)
+ maybe-user
+ user))
+ (group (if (maybe-value-set? maybe-group)
+ maybe-group
+ group))
(host-environment
(oci-container-configuration-host-environment config))
(command (oci-container-configuration-command config))
(log-file (oci-container-configuration-log-file config))
- (provision (oci-container-configuration-provision config))
(requirement (oci-container-configuration-requirement config))
(respawn?
(oci-container-configuration-respawn? config))
(image (oci-container-configuration-image config))
(image-reference (oci-image-reference image))
(options (oci-container-configuration->options config))
- (name (guess-name provision image))
+ (name
+ (oci-container-shepherd-name runtime config))
(extra-arguments
- (oci-container-configuration-extra-arguments config)))
+ (oci-container-configuration-extra-arguments config))
+ (invokation
+ (oci-container-run-invokation
+ runtime-cli name command image-reference
+ options runtime-extra-arguments extra-arguments))
+ (wrap-command
+ (lambda (command)
+ (if (eq? runtime 'podman)
+ (list
+ "/bin/sh" "-l" "-c"
+ #~(string-join (list #$@command) " "))
+ command)))
+ (container-action
+ (lambda* (command #:key (environment-variables #f))
+ #~(lambda _
+ (fork+exec-command
+ (list #$@command)
+ #$@(if user (list #:user user) '())
+ #$@(if group (list #:group group) '())
+ #$@(if (maybe-value-set? log-file)
+ (list #:log-file log-file)
+ '())
+ #$@(if (and user (eq? runtime 'podman))
+ (list #:directory
+ #~(passwd:dir (getpwnam #$user)))
+ '())
+ #$@(if environment-variables
+ (list #:environment-variables
+ environment-variables)
+ '()))))))
(shepherd-service (provision `(,(string->symbol name)))
- (requirement `(dockerd user-processes ,@requirement))
+ (requirement `(,@oci-requirement
+ ,@requirement))
(respawn? respawn?)
(auto-start? auto-start?)
(documentation
(string-append
- "Docker backed Shepherd service for "
+ (oci-runtime-name runtime) " backed Shepherd service for "
(if (oci-image? image) name image) "."))
(start
- #~(lambda ()
- #$@(if (oci-image? image)
- #~((invoke #$(%oci-image-loader
- name image image-reference)))
- #~())
- (fork+exec-command
- ;; docker run [OPTIONS] IMAGE [COMMAND] [ARG...]
- (list #$docker "run" "--rm" "--name" #$name
- #$@options #$@extra-arguments
- #$image-reference #$@command)
- #:user #$user
- #:group #$group
- #$@(if (maybe-value-set? log-file)
- (list #:log-file log-file)
- '())
- #:environment-variables
- (list #$@host-environment))))
+ (container-action
+ (list (oci-container-entrypoint
+ runtime runtime-cli name image image-reference
+ invokation #:verbose? verbose?))
+ #:environment-variables
+ #~(append
+ (list #$@host-environment)
+ (list #$@runtime-environment))))
(stop
- #~(lambda _
- (invoke #$docker "rm" "-f" #$name)))
+ (container-action
+ (wrap-command
+ (list runtime-cli "rm" "-f" name))))
(actions
- (if (oci-image? image)
- '()
- (append
+ (append
+ (list
+ (oci-object-command-shepherd-action
+ name #~(string-join (list #$@invokation) " ")))
+ (if (oci-image? image)
+ '()
(list
- (shepherd-action
- (name 'pull)
- (documentation
- (format #f "Pull ~a's image (~a)."
- name image))
- (procedure
- #~(lambda _
- (invoke #$docker "pull" #$image)))))
- actions))))))
-
-(define %oci-container-accounts
+ (let ((service-name name))
+ (shepherd-action
+ (name 'pull)
+ (documentation
+ (format #f "Pull ~a's image (~a)."
+ service-name image))
+ (procedure
+ (container-action
+ (wrap-command
+ (list runtime-cli "pull" image))))))))
+ actions)))))
+
+(define (oci-object-create-invokation object runtime-cli name options
+ runtime-extra-arguments
+ create-extra-arguments)
+ "Return a gexp that, upon lowering, will evaluate to the OCI runtime
+invocation for creating networks and volumes."
+ ;; network|volume create [options] [NAME]
+ #~(list #$runtime-cli #$@runtime-extra-arguments #$object "create"
+ #$@options #$@create-extra-arguments #$name))
+
+(define (format-oci-invokations invokations)
+ "Return a gexp that, upon lowering, will evaluate to a formatted message
+containing the INVOKATIONS that the OCI runtime will execute to provision
+networks or volumes."
+ #~(string-join (map (lambda (i) (string-join i " "))
+ (list #$@invokations))
+ "\n"))
+
+(define* (oci-object-create-script object runtime runtime-cli invokations
+ #:key (verbose? #f))
+ "Return a file-like object that, once lowered, will evaluate to a program able
+to create OCI networks and volumes through RUNTIME-CLI."
+ (define runtime-string (symbol->string runtime))
+ (program-file
+ (string-append runtime-string "-" object "s-create.scm")
+ #~(begin
+ (use-modules (ice-9 format)
+ (ice-9 match)
+ (ice-9 popen)
+ (ice-9 rdelim)
+ (srfi srfi-1))
+
+ (define object-exists?
+ #$(oci-object-exists? runtime runtime-cli object verbose?))
+
+ (for-each
+ (lambda (invokation)
+ (define name (last invokation))
+ (if (object-exists? name)
+ (format #t "~a ~a ~a already exists, skipping creation.~%"
+ #$(oci-runtime-name runtime) name #$object)
+ (begin
+ (when #$verbose?
+ (format #t "Running~{ ~a~}~%" invokation))
+ (let ((exit-code (status:exit-val (apply system* invokation))))
+ (when #$verbose?
+ (format #t "Exit code: ~a~%" exit-code))))))
+ (list #$@invokations)))))
+
+(define* (oci-object-shepherd-service object runtime runtime-cli name requirement invokations
+ #:key
+ (runtime-environment #~())
+ (user #f)
+ (group #f)
+ (verbose? #f))
+ "Return a Shepherd service object that will create the OBJECTs represented
+by INVOKATIONS through RUNTIME-CLI."
+ (shepherd-service (provision `(,(string->symbol name)))
+ (requirement requirement)
+ (one-shot? #t)
+ (documentation
+ (string-append
+ (oci-runtime-name runtime) " " object
+ " provisioning service"))
+ (start
+ #~(lambda _
+ (fork+exec-command
+ (list
+ #$(oci-object-create-script
+ object runtime runtime-cli
+ invokations
+ #:verbose? verbose?))
+ #$@(if user (list #:user user) '())
+ #$@(if group (list #:group group) '())
+ #:environment-variables
+ (list #$@runtime-environment))))
+ (actions
+ (list
+ (oci-object-command-shepherd-action
+ name (format-oci-invokations invokations))))))
+
+(define* (oci-networks-shepherd-service runtime runtime-cli name networks
+ #:key (user #f) (group #f) (verbose? #f)
+ (runtime-extra-arguments '())
+ (runtime-environment #~())
+ (runtime-requirement '()))
+ "Return a Shepherd service object that will create the networks represented
+in CONFIG."
+ (let ((invokations
+ (map
+ (lambda (network)
+ (oci-object-create-invokation
+ "network" runtime-cli
+ (oci-network-configuration-name network)
+ (oci-network-configuration->options network)
+ runtime-extra-arguments
+ (oci-network-configuration-extra-arguments network)))
+ networks)))
+
+ (oci-object-shepherd-service
+ "network" runtime runtime-cli name
+ runtime-requirement invokations
+ #:user user #:group group #:runtime-environment runtime-environment
+ #:verbose? verbose?)))
+
+(define* (oci-volumes-shepherd-service runtime runtime-cli name volumes
+ #:key (user #f) (group #f) (verbose? #f)
+ (runtime-extra-arguments '())
+ (runtime-environment #~())
+ (runtime-requirement '()))
+ "Return a Shepherd service object that will create the volumes represented
+in CONFIG."
+ (let ((invokations
+ (map
+ (lambda (volume)
+ (oci-object-create-invokation
+ "volume" runtime-cli
+ (oci-volume-configuration-name volume)
+ (oci-volume-configuration->options volume)
+ runtime-extra-arguments
+ (oci-volume-configuration-extra-arguments volume)))
+ volumes)))
+
+ (oci-object-shepherd-service
+ "volume" runtime runtime-cli name runtime-requirement invokations
+ #:user user #:group group #:runtime-environment runtime-environment
+ #:verbose? verbose?)))
+
+(define (oci-service-accounts config)
+ (define user (oci-configuration-user config))
+ (define maybe-group (oci-configuration-group config))
+ (define runtime (oci-configuration-runtime config))
(list (user-account
- (name "oci-container")
+ (name user)
(comment "OCI services account")
- (group "docker")
- (system? #t)
- (home-directory "/var/empty")
+ (group "users")
+ (supplementary-groups
+ (list (oci-runtime-group runtime maybe-group)))
+ (system? (eq? 'docker runtime))
+ (home-directory (if (eq? 'podman runtime)
+ (string-append "/home/" user)
+ "/var/empty"))
+ (create-home-directory? (eq? 'podman runtime))
(shell (file-append shadow "/sbin/nologin")))))
+
+(define* (oci-state->shepherd-services runtime runtime-cli containers networks volumes
+ #:key (user #f) (group #f) (verbose? #f)
+ (networks-name #f) (volumes-name #f)
+ (runtime-extra-arguments '())
+ (runtime-environment #~())
+ (runtime-requirement '())
+ (containers-requirement '())
+ (networks-requirement '())
+ (volumes-requirement '()))
+ "Returns a list of Shepherd services based on the input OCI state."
+ (let* ((networks-name
+ (if (string? networks-name)
+ networks-name
+ (oci-networks-shepherd-name runtime)))
+ (networks?
+ (> (length networks) 0))
+ (networks-service
+ (if networks?
+ (list
+ (string->symbol networks-name))
+ '()))
+ (volumes-name
+ (if (string? volumes-name)
+ volumes-name
+ (oci-volumes-shepherd-name runtime)))
+ (volumes?
+ (> (length volumes) 0))
+ (volumes-service
+ (if volumes?
+ (list (string->symbol volumes-name))
+ '())))
+ (append
+ (map
+ (lambda (c)
+ (oci-container-shepherd-service
+ runtime runtime-cli c
+ #:user user
+ #:group group
+ #:runtime-environment runtime-environment
+ #:runtime-extra-arguments runtime-extra-arguments
+ #:oci-requirement
+ (append containers-requirement
+ runtime-requirement
+ networks-service
+ volumes-service)
+ #:verbose? verbose?))
+ containers)
+ (if networks?
+ (list
+ (oci-networks-shepherd-service
+ runtime runtime-cli
+ networks-name networks
+ #:user user #:group group
+ #:runtime-extra-arguments runtime-extra-arguments
+ #:runtime-environment runtime-environment
+ #:runtime-requirement (append networks-requirement
+ runtime-requirement)
+ #:verbose? verbose?))
+ '())
+ (if volumes?
+ (list
+ (oci-volumes-shepherd-service
+ runtime runtime-cli
+ volumes-name volumes
+ #:user user #:group group
+ #:runtime-extra-arguments runtime-extra-arguments
+ #:runtime-environment runtime-environment
+ #:runtime-requirement (append runtime-requirement
+ volumes-requirement)
+ #:verbose? verbose?))
+ '()))))
+
+(define (oci-configuration->shepherd-services config)
+ (let* ((runtime (oci-configuration-runtime config))
+ (system-runtime-cli
+ (oci-runtime-system-cli config))
+ (home-runtime-cli
+ (oci-runtime-home-cli config))
+ (runtime-extra-arguments
+ (oci-configuration-runtime-extra-arguments config))
+ (containers (oci-configuration-containers config))
+ (networks (oci-configuration-networks config))
+ (volumes (oci-configuration-volumes config))
+ (user (oci-configuration-user config))
+ (group (oci-runtime-group
+ runtime (oci-configuration-group config)))
+ (verbose? (oci-configuration-verbose? config))
+ (home-service?
+ (oci-configuration-home-service? config)))
+ (if home-service?
+ (oci-state->shepherd-services runtime home-runtime-cli containers networks volumes
+ #:verbose? verbose?
+ #:networks-name
+ (oci-networks-home-shepherd-name runtime)
+ #:volumes-name
+ (oci-volumes-home-shepherd-name runtime))
+ (oci-state->shepherd-services runtime system-runtime-cli containers networks volumes
+ #:user user
+ #:group
+ (oci-runtime-system-group runtime user group)
+ #:verbose? verbose?
+ #:runtime-extra-arguments
+ runtime-extra-arguments
+ #:runtime-environment
+ (oci-runtime-system-environment runtime user)
+ #:runtime-requirement
+ (oci-runtime-system-requirement runtime)
+ #:networks-requirement '(networking)))))
+
+(define (oci-service-subids config)
+ "Return a subids-extension record representing subuids and subgids required by
+the rootless Podman backend."
+ (define (delete-duplicate-ranges ranges)
+ (delete-duplicates ranges
+ (lambda args
+ (apply string=? (map subid-range-name ranges)))))
+ (define runtime
+ (oci-configuration-runtime config))
+ (define user
+ (oci-configuration-user config))
+ (define subgids (oci-configuration-subgids-range config))
+ (define subuids (oci-configuration-subuids-range config))
+ (define container-users
+ (filter (lambda (range)
+ (and (maybe-value-set?
+ (subid-range-name range))
+ (not (string=? (subid-range-name range) user))))
+ (map (lambda (container)
+ (subid-range
+ (name
+ (oci-container-configuration-user container))))
+ (oci-configuration-containers config))))
+ (define subgid-ranges
+ (delete-duplicate-ranges
+ (cons
+ (if (eq? subgids #f)
+ (subid-range (name user))
+ subgids)
+ container-users)))
+ (define subuid-ranges
+ (delete-duplicate-ranges
+ (cons
+ (if (eq? subuids #f)
+ (subid-range (name user))
+ subuids)
+ container-users)))
+
+ (if (eq? 'podman runtime)
+ (subids-extension
+ (subgids
+ subgid-ranges)
+ (subuids
+ subuid-ranges))
+ (subids-extension)))
+
+(define (oci-objects-merge-lst a b object get-name)
+ (define (contains? value lst)
+ (member value (map get-name lst)))
+ (let loop ((merged '())
+ (lst (append a b)))
+ (if (null? lst)
+ merged
+ (loop
+ (let ((element (car lst)))
+ (when (contains? element merged)
+ (raise
+ (formatted-message
+ (G_ "Duplicated ~a: ~a. ~as names should be unique, please
+remove the duplicate.") object (get-name element) object)))
+ (cons element merged))
+ (cdr lst)))))
+
+(define (oci-extension-merge a b)
+ (oci-extension
+ (containers (oci-objects-merge-lst
+ (oci-extension-containers a)
+ (oci-extension-containers b)
+ "container"
+ (lambda (config)
+ (define maybe-name (oci-container-configuration-provision config))
+ (if (maybe-value-set? maybe-name)
+ maybe-name
+ (oci-image->container-name
+ (oci-container-configuration-image config))))))
+ (networks (oci-objects-merge-lst
+ (oci-extension-networks a)
+ (oci-extension-networks b)
+ "network"
+ oci-network-configuration-name))
+ (volumes (oci-objects-merge-lst
+ (oci-extension-volumes a)
+ (oci-extension-volumes b)
+ "volume"
+ oci-volume-configuration-name))))
+
+(define (oci-service-profile runtime runtime-cli)
+ `(,bash-minimal
+ ,@(if (string? runtime-cli)
+ '()
+ (list
+ (cond
+ ((not (eq? runtime-cli #f))
+ runtime-cli)
+ ((eq? 'podman runtime)
+ podman)
+ (else
+ docker-cli))))))
+
+(define (oci-service-extension-wrap-validate extension)
+ (lambda (config)
+ (if (oci-configuration-valid? config)
+ (extension config)
+ (raise
+ (formatted-message
+ (G_ "Invalide oci-configuration ~a.") config)))))
+
+(define (oci-configuration-extend config extension)
+ (oci-configuration
+ (inherit config)
+ (containers
+ (oci-objects-merge-lst
+ (oci-configuration-containers config)
+ (oci-extension-containers extension)
+ "container"
+ (lambda (oci-config)
+ (define runtime
+ (oci-configuration-runtime config))
+ (oci-container-shepherd-name runtime oci-config))))
+ (networks (oci-objects-merge-lst
+ (oci-configuration-networks config)
+ (oci-extension-networks extension)
+ "network"
+ oci-network-configuration-name))
+ (volumes (oci-objects-merge-lst
+ (oci-configuration-volumes config)
+ (oci-extension-volumes extension)
+ "volume"
+ oci-volume-configuration-name))))
+
+(define oci-service-type
+ (service-type (name 'oci)
+ (extensions
+ (list
+ (service-extension profile-service-type
+ (oci-service-extension-wrap-validate
+ (lambda (config)
+ (let ((runtime-cli
+ (oci-configuration-runtime-cli config))
+ (runtime
+ (oci-configuration-runtime config)))
+ (oci-service-profile runtime runtime-cli)))))
+ (service-extension subids-service-type
+ (oci-service-extension-wrap-validate
+ oci-service-subids))
+ (service-extension account-service-type
+ (oci-service-extension-wrap-validate
+ oci-service-accounts))
+ (service-extension shepherd-root-service-type
+ (oci-service-extension-wrap-validate
+ oci-configuration->shepherd-services))))
+ ;; Concatenate OCI object lists.
+ (compose (lambda (args)
+ (fold oci-extension-merge
+ (oci-extension)
+ args)))
+ (extend oci-configuration-extend)
+ (default-value (oci-configuration))
+ (description
+ "This service implements the provisioning of OCI object such
+as containers, networks and volumes.")))
diff --git a/gnu/services/docker.scm b/gnu/services/docker.scm
index 828ceea313a..125e748bb0e 100644
--- a/gnu/services/docker.scm
+++ b/gnu/services/docker.scm
@@ -31,7 +31,10 @@ (define-module (gnu services docker)
#:use-module (gnu system shadow)
#:use-module (gnu packages docker)
#:use-module (gnu packages linux) ;singularity
+ #:use-module (guix deprecation)
+ #:use-module (guix diagnostics)
#:use-module (guix gexp)
+ #:use-module (guix i18n)
#:use-module (guix records)
#:use-module (srfi srfi-1)
#:use-module (ice-9 format)
@@ -67,16 +70,18 @@ (define-module (gnu services docker)
oci-container-configuration-volumes
oci-container-configuration-container-user
oci-container-configuration-workdir
- oci-container-configuration-extra-arguments
- oci-container-shepherd-service
- %oci-container-accounts)
+ oci-container-configuration-extra-arguments)
#:export (containerd-configuration
containerd-service-type
docker-configuration
docker-service-type
singularity-service-type
- oci-container-service-type))
+ ;; for backwards compatibility, until the
+ ;; oci-container-service-type is fully deprecated
+ oci-container-shepherd-service
+ oci-container-service-type
+ %oci-container-accounts))
(define-maybe file-like)
@@ -297,17 +302,25 @@ (define singularity-service-type
;;; OCI container.
;;;
-(define (configs->shepherd-services configs)
- (map oci-container-shepherd-service configs))
+;; for backwards compatibility, until the
+;; oci-container-service-type is fully deprecated
+(define-deprecated (oci-container-shepherd-service config)
+ oci-service-type
+ ((@ (gnu services containers) oci-container-shepherd-service)
+ 'docker config))
+(define %oci-container-accounts
+ (filter user-account? (oci-service-accounts (oci-configuration))))
(define oci-container-service-type
(service-type (name 'oci-container)
- (extensions (list (service-extension profile-service-type
- (lambda _ (list docker-cli)))
- (service-extension account-service-type
- (const %oci-container-accounts))
- (service-extension shepherd-root-service-type
- configs->shepherd-services)))
+ (extensions
+ (list (service-extension oci-service-type
+ (lambda (containers)
+ (warning
+ (G_
+ "'oci-container-service-type' is deprecated, use 'oci-service-type' instead~%"))
+ (oci-extension
+ (containers containers))))))
(default-value '())
(extend append)
(compose concatenate)
diff --git a/gnu/tests/containers.scm b/gnu/tests/containers.scm
index 0ecc8ddb126..5e6f39387e7 100644
--- a/gnu/tests/containers.scm
+++ b/gnu/tests/containers.scm
@@ -27,6 +27,9 @@ (define-module (gnu tests containers)
#:use-module (gnu services)
#:use-module (gnu services containers)
#:use-module (gnu services desktop)
+ #:use-module ((gnu services docker)
+ #:select (containerd-service-type
+ docker-service-type))
#:use-module (gnu services dbus)
#:use-module (gnu services networking)
#:use-module (gnu system)
@@ -39,7 +42,9 @@ (define-module (gnu tests containers)
#:use-module (guix profiles)
#:use-module ((guix scripts pack) #:prefix pack:)
#:use-module (guix store)
- #:export (%test-rootless-podman))
+ #:export (%test-rootless-podman
+ %test-oci-service-rootless-podman
+ %test-oci-service-docker))
(define %rootless-podman-os
@@ -345,3 +350,995 @@ (define %test-rootless-podman
(name "rootless-podman")
(description "Test rootless Podman service.")
(value (build-tarball&run-rootless-podman-test))))
+
+
+(define %oci-rootless-podman-os
+ (simple-operating-system
+ (service dhcp-client-service-type)
+ (service dbus-root-service-type)
+ (service polkit-service-type)
+ (service elogind-service-type)
+ (service iptables-service-type)
+ (service rootless-podman-service-type)
+ (extra-special-file "/shared.txt"
+ (plain-file "shared.txt" "hello"))
+ (service oci-service-type
+ (oci-configuration
+ (runtime 'podman)
+ (verbose? #t)))
+ (simple-service 'oci-provisioning
+ oci-service-type
+ (oci-extension
+ (networks
+ (list (oci-network-configuration (name "my-network"))))
+ (volumes
+ (list (oci-volume-configuration (name "my-volume"))))
+ (containers
+ (list
+ (oci-container-configuration
+ (provision "first")
+ (image
+ (oci-image
+ (repository "guile")
+ (value
+ (specifications->manifest '("guile")))
+ (pack-options
+ '(#:symlinks (("/bin" -> "bin"))))))
+ (entrypoint "/bin/guile")
+ (network "my-network")
+ (command
+ '("-c" "(use-modules (web server))
+(define (handler request request-body)
+ (values '((content-type . (text/plain))) \"out of office\"))
+(run-server handler 'http `(#:addr ,(inet-pton AF_INET \"0.0.0.0\")))"))
+ (host-environment
+ '(("VARIABLE" . "value")))
+ (volumes
+ '(("my-volume" . "/my-volume")))
+ (extra-arguments
+ '("--env" "VARIABLE")))
+ (oci-container-configuration
+ (provision "second")
+ (image
+ (oci-image
+ (repository "guile")
+ (value
+ (specifications->manifest '("guile")))
+ (pack-options
+ '(#:symlinks (("/bin" -> "bin"))))))
+ (entrypoint "/bin/guile")
+ (network "my-network")
+ (command
+ '("-c" "(let l ((c 300))(display c)(sleep 1)(when(positive? c)(l (- c 1))))"))
+ (volumes
+ '(("my-volume" . "/my-volume")
+ ("/shared.txt" . "/shared.txt:ro"))))))))))
+
+(define (run-rootless-podman-oci-service-test)
+ (define os
+ (marionette-operating-system
+ (operating-system-with-gc-roots
+ %oci-rootless-podman-os
+ (list))
+ #: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))
+ #~(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-oci-service")
+
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (wait-for-service 'user-processes))
+ marionette)
+
+ (test-assert "rootless-podman services started successfully"
+ (begin
+ (define (run-test)
+ (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))
+ ;; Allow services to come up on slower machines
+ (let loop ((attempts 0))
+ (if (= attempts 60)
+ (error "Services didn't come up after more than 60 seconds")
+ (if (equal? '("cgroup" "cgroup")
+ (run-test))
+ #t
+ (begin
+ (sleep 1)
+ (format #t "Services didn't come up yet, retrying with attempt ~a~%"
+ (+ 1 attempts))
+ (loop (+ 1 attempts))))))))
+
+ (test-assert "podman-volumes running"
+ (begin
+ (define (run-test)
+ (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 6))
+ (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 "oci-container")))
+ (setuid (passwd:uid (getpw "oci-container")))
+
+ (let ((response (slurp
+ "/run/current-system/profile/bin/podman"
+ "volume" "ls" "-n" "--format" "\"{{.Name}}\""
+ "|" "tr" "' '" "'\n'")))
+
+ (call-with-output-file (string-append ,out-dir "/response")
+ (lambda (port)
+ (display (string-join response "\n") port)))))
+ (lambda ()
+ (primitive-exit 127))))
+ (pid
+ (cdr (waitpid pid))))
+
+ (wait-for-file (string-append ,out-dir "/response"))
+
+ (stable-sort
+ (slurp "cat" (string-append ,out-dir "/response"))
+ string<=?))
+ marionette))
+ ;; Allow services to come up on slower machines
+ (let loop ((attempts 0))
+ (if (= attempts 80)
+ (error "Service didn't come up after more than 80 seconds")
+ (if (equal? '("my-volume")
+ (run-test))
+ #t
+ (begin
+ (sleep 1)
+ (loop (+ 1 attempts))))))))
+
+ (test-assert "podman-networks running"
+ (begin
+ (define (run-test)
+ (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 6))
+ (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 "oci-container")))
+ (setuid (passwd:uid (getpw "oci-container")))
+
+ (let ((response (slurp
+ "/run/current-system/profile/bin/podman"
+ "network" "ls" "-n" "--format" "\"{{.Name}}\""
+ "|" "tr" "' '" "'\n'")))
+
+ (call-with-output-file (string-append ,out-dir "/response")
+ (lambda (port)
+ (display (string-join response "\n") port)))))
+ (lambda ()
+ (primitive-exit 127))))
+ (pid
+ (cdr (waitpid pid))))
+
+ (wait-for-file (string-append ,out-dir "/response"))
+
+ (stable-sort
+ (slurp "cat" (string-append ,out-dir "/response"))
+ string<=?))
+ marionette))
+ ;; Allow services to come up on slower machines
+ (let loop ((attempts 0))
+ (if (= attempts 80)
+ (error "Service didn't come up after more than 80 seconds")
+ (if (equal? '("my-network" "podman")
+ (run-test))
+ #t
+ (begin
+ (sleep 1)
+ (loop (+ 1 attempts))))))))
+
+ (test-assert "first container running"
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (wait-for-service 'first #:timeout 120)
+ #t)
+ marionette))
+
+ (test-assert "second container running"
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (wait-for-service 'second #:timeout 120)
+ #t)
+ marionette))
+
+ (test-assert "passing host environment variables"
+ (begin
+ (define (run-test)
+ (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 "oci-container")))
+ (setuid (passwd:uid (getpw "oci-container")))
+
+ (let ((response (slurp
+ "/run/current-system/profile/bin/podman"
+ "exec" "first"
+ "/bin/guile" "-c" "'(display (getenv \"VARIABLE\"))'")))
+ (call-with-output-file (string-append ,out-dir "/response")
+ (lambda (port)
+ (display (string-join response "\n") port)))))
+ (lambda ()
+ (primitive-exit 127))))
+ (pid
+ (cdr (waitpid pid))))
+
+ (wait-for-file (string-append ,out-dir "/response"))
+ (slurp "cat" (string-append ,out-dir "/response")))
+ marionette))
+ ;; Allow image to be loaded on slower machines
+ (let loop ((attempts 0))
+ (if (= attempts 180)
+ (error "Service didn't come up after more than 180 seconds")
+ (if (equal? (list "value")
+ (run-test))
+ #t
+ (begin
+ (sleep 1)
+ (loop (+ 1 attempts))))))))
+
+ (test-equal "mounting host files"
+ '("hello")
+ (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 "oci-container")))
+ (setuid (passwd:uid (getpw "oci-container")))
+
+ (let ((response (slurp
+ "/run/current-system/profile/bin/podman"
+ "exec" "second"
+ "/bin/guile" "-c" "'(begin (use-modules (ice-9 popen) (ice-9 rdelim))
+(display (call-with-input-file \"/shared.txt\" read-line)))'")))
+ (call-with-output-file (string-append ,out-dir "/response")
+ (lambda (port)
+ (display (string-join response " ") port)))))
+ (lambda ()
+ (primitive-exit 127))))
+ (pid
+ (cdr (waitpid pid))))
+
+ (wait-for-file (string-append ,out-dir "/response"))
+ (slurp "cat" (string-append ,out-dir "/response")))
+ marionette))
+
+ (test-equal "write to volumes"
+ '("world")
+ (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 "oci-container")))
+ (setuid (passwd:uid (getpw "oci-container")))
+
+ (slurp
+ "/run/current-system/profile/bin/podman"
+ "exec" "first"
+ "/bin/guile" "-c" "'(begin (use-modules (ice-9 popen) (ice-9 rdelim))
+(call-with-output-file \"/my-volume/out.txt\" (lambda (p) (display \"world\" p))))'")
+
+ (let ((response (slurp
+ "/run/current-system/profile/bin/podman"
+ "exec" "second"
+ "/bin/guile" "-c" "'(begin (use-modules (ice-9 popen) (ice-9 rdelim))
+(display (call-with-input-file \"/my-volume/out.txt\" read-line)))'")))
+ (call-with-output-file (string-append ,out-dir "/response")
+ (lambda (port)
+ (display (string-join response " ") port)))))
+ (lambda ()
+ (primitive-exit 127))))
+ (pid
+ (cdr (waitpid pid))))
+
+ (wait-for-file (string-append ,out-dir "/response"))
+ (slurp "cat" (string-append ,out-dir "/response")))
+ marionette))
+
+ (test-equal "can read ports over network"
+ '("out of office")
+ (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 "oci-container")))
+ (setuid (passwd:uid (getpw "oci-container")))
+
+ (let ((response (slurp
+ "/run/current-system/profile/bin/podman"
+ "exec" "second"
+ "/bin/guile" "-c" "'(begin (use-modules (web client))
+(define-values (response out)
+ (http-get \"http://first:8080\"))
+(display out))'")))
+ (call-with-output-file (string-append ,out-dir "/response")
+ (lambda (port)
+ (display (string-join response " ") port)))))
+ (lambda ()
+ (primitive-exit 127))))
+ (pid
+ (cdr (waitpid pid))))
+
+ (wait-for-file (string-append ,out-dir "/response"))
+ (slurp "cat" (string-append ,out-dir "/response")))
+ marionette))
+
+ (test-end))))
+
+ (gexp->derivation "rootless-podman-oci-service-test" test))
+
+(define %test-oci-service-rootless-podman
+ (system-test
+ (name "oci-service-rootless-podman")
+ (description "Test Rootless-Podman backed OCI provisioning service.")
+ (value (run-rootless-podman-oci-service-test))))
+
+(define %oci-docker-os
+ (simple-operating-system
+ (service dhcp-client-service-type)
+ (service dbus-root-service-type)
+ (service polkit-service-type)
+ (service elogind-service-type)
+ (service containerd-service-type)
+ (service docker-service-type)
+ (extra-special-file "/shared.txt"
+ (plain-file "shared.txt" "hello"))
+ (service oci-service-type
+ (oci-configuration
+ (verbose? #t)))
+ (simple-service 'oci-provisioning
+ oci-service-type
+ (oci-extension
+ (networks
+ (list (oci-network-configuration (name "my-network"))))
+ (volumes
+ (list (oci-volume-configuration (name "my-volume"))))
+ (containers
+ (list
+ (oci-container-configuration
+ (provision "first")
+ (image
+ (oci-image
+ (repository "guile")
+ (value
+ (specifications->manifest '("guile")))
+ (pack-options
+ '(#:symlinks (("/bin" -> "bin"))))))
+ (entrypoint "/bin/guile")
+ (network "my-network")
+ (command
+ '("-c" "(use-modules (web server))
+(define (handler request request-body)
+ (values '((content-type . (text/plain))) \"out of office\"))
+(run-server handler 'http `(#:addr ,(inet-pton AF_INET \"0.0.0.0\")))"))
+ (host-environment
+ '(("VARIABLE" . "value")))
+ (volumes
+ '(("my-volume" . "/my-volume")))
+ (extra-arguments
+ '("--env" "VARIABLE")))
+ (oci-container-configuration
+ (provision "second")
+ (image
+ (oci-image
+ (repository "guile")
+ (value
+ (specifications->manifest '("guile")))
+ (pack-options
+ '(#:symlinks (("/bin" -> "bin"))))))
+ (entrypoint "/bin/guile")
+ (network "my-network")
+ (command
+ '("-c" "(let l ((c 300))(display c)(sleep 1)(when(positive? c)(l (- c 1))))"))
+ (volumes
+ '(("my-volume" . "/my-volume")
+ ("/shared.txt" . "/shared.txt:ro"))))))))))
+
+(define (run-docker-oci-service-test)
+ (define os
+ (marionette-operating-system
+ (operating-system-with-gc-roots
+ %oci-docker-os
+ (list))
+ #: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))
+ #~(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))
+
+ (test-runner-current (system-test-runner #$output))
+ (test-begin "docker-oci-service")
+
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (wait-for-service 'dockerd))
+ marionette)
+
+ (test-assert "docker-volumes running"
+ (begin
+ (define (run-test)
+ (marionette-eval
+ `(begin
+ (use-modules (ice-9 popen)
+ (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
+ (list "sh" "-l" "-c"
+ (string-join
+ args
+ " "))))
+ (output (read-lines port))
+ (status (close-pipe port)))
+ output)))
+
+ (stable-sort
+ (slurp
+ "/run/current-system/profile/bin/docker"
+ "volume" "ls" "--format" "\"{{.Name}}\"")
+ string<=?))
+
+ marionette))
+ ;; Allow services to come up on slower machines
+ (let loop ((attempts 0))
+ (if (= attempts 80)
+ (error "Service didn't come up after more than 80 seconds")
+ (if (equal? '("my-volume")
+ (run-test))
+ #t
+ (begin
+ (sleep 1)
+ (loop (+ 1 attempts))))))))
+
+ (test-assert "docker-networks running"
+ (begin
+ (define (run-test)
+ (marionette-eval
+ `(begin
+ (use-modules (ice-9 popen)
+ (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
+ (list "sh" "-l" "-c"
+ (string-join
+ args
+ " "))))
+ (output (read-lines port))
+ (status (close-pipe port)))
+ output)))
+
+ (stable-sort
+ (slurp
+ "/run/current-system/profile/bin/docker"
+ "network" "ls" "--format" "\"{{.Name}}\"")
+ string<=?))
+
+ marionette))
+ ;; Allow services to come up on slower machines
+ (let loop ((attempts 0))
+ (if (= attempts 80)
+ (error "Service didn't come up after more than 80 seconds")
+ (if (equal? '("bridge" "host" "my-network" "none")
+ (run-test))
+ #t
+ (begin
+ (sleep 1)
+ (loop (+ 1 attempts))))))))
+
+ (test-assert "first container running"
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (wait-for-service 'first #:timeout 120)
+ #t)
+ marionette))
+
+ (test-assert "second container running"
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (wait-for-service 'second #:timeout 120)
+ #t)
+ marionette))
+
+ (test-assert "passing host environment variables"
+ (begin
+ (define (run-test)
+ (marionette-eval
+ `(begin
+ (use-modules (ice-9 popen)
+ (ice-9 rdelim))
+
+ (define slurp
+ (lambda args
+ (let* ((port (apply open-pipe* OPEN_READ args))
+ (output (let ((line (read-line port)))
+ (if (eof-object? line)
+ ""
+ line)))
+ (status (close-pipe port)))
+ output)))
+
+ (slurp
+ "/run/current-system/profile/bin/docker"
+ "exec" "first"
+ "/bin/guile" "-c" "(display (getenv \"VARIABLE\"))"))
+ marionette))
+ ;; Allow image to be loaded on slower machines
+ (let loop ((attempts 0))
+ (if (= attempts 180)
+ (error "Service didn't come up after more than 180 seconds")
+ (if (equal? "value"
+ (run-test))
+ #t
+ (begin
+ (sleep 1)
+ (loop (+ 1 attempts))))))))
+
+ (test-equal "mounting host files"
+ "hello"
+ (marionette-eval
+ `(begin
+ (use-modules (ice-9 popen)
+ (ice-9 rdelim))
+
+ (define slurp
+ (lambda args
+ (let* ((port (apply open-pipe* OPEN_READ args))
+ (output (let ((line (read-line port)))
+ (if (eof-object? line)
+ ""
+ line)))
+ (status (close-pipe port)))
+ output)))
+
+ (slurp
+ "/run/current-system/profile/bin/docker"
+ "exec" "second"
+ "/bin/guile" "-c" "(begin (use-modules (ice-9 popen) (ice-9 rdelim))
+(display (call-with-input-file \"/shared.txt\" read-line)))"))
+ marionette))
+
+ (test-equal "write to volumes"
+ "world"
+ (marionette-eval
+ `(begin
+ (use-modules (ice-9 popen)
+ (ice-9 rdelim))
+
+ (define slurp
+ (lambda args
+ (let* ((port (apply open-pipe* OPEN_READ args))
+ (output (let ((line (read-line port)))
+ (if (eof-object? line)
+ ""
+ line)))
+ (status (close-pipe port)))
+ output)))
+
+ (slurp
+ "/run/current-system/profile/bin/docker"
+ "exec" "first"
+ "/bin/guile" "-c" "(begin (use-modules (ice-9 popen) (ice-9 rdelim))
+(call-with-output-file \"/my-volume/out.txt\" (lambda (p) (display \"world\" p))))")
+ (slurp
+ "/run/current-system/profile/bin/docker"
+ "exec" "second"
+ "/bin/guile" "-c" "(begin (use-modules (ice-9 popen) (ice-9 rdelim))
+(display (call-with-input-file \"/my-volume/out.txt\" read-line)))"))
+ marionette))
+
+ (test-equal "can read ports over network"
+ "out of office"
+ (marionette-eval
+ `(begin
+ (use-modules (ice-9 popen)
+ (ice-9 rdelim))
+
+ (define slurp
+ (lambda args
+ (let* ((port (apply open-pipe* OPEN_READ args))
+ (output (let ((line (read-line port)))
+ (if (eof-object? line)
+ ""
+ line)))
+ (status (close-pipe port)))
+ output)))
+
+ (slurp
+ "/run/current-system/profile/bin/docker"
+ "exec" "second"
+ "/bin/guile" "-c" "(begin (use-modules (web client))
+(define-values (response out)
+ (http-get \"http://first:8080\"))
+(display out))"))
+ marionette))
+
+ (test-end))))
+
+ (gexp->derivation "docker-oci-service-test" test))
+
+(define %test-oci-service-docker
+ (system-test
+ (name "oci-service-docker")
+ (description "Test Docker backed OCI provisioning service.")
+ (value (run-docker-oci-service-test))))
--
2.48.1
guix-patches <at> gnu.org:bug#76081; Package guix-patches.
(Wed, 26 Feb 2025 23:09:02 GMT) Full text and rfc822 format available.Message #92 received at 76081 <at> debbugs.gnu.org (full text, mbox):
From: Giacomo Leidi <goodoldpaul <at> autistici.org> To: 76081 <at> debbugs.gnu.org Cc: Giacomo Leidi <goodoldpaul <at> autistici.org> Subject: [PATCH v6 4/5] tests: Use lower-oci-image-state in container tests. Date: Thu, 27 Feb 2025 00:08:09 +0100
This patch replaces boilerplate in container related tests with
oci-image plumbing from (gnu services containers).
* gnu/services/containers.scm: Export lower-oci-image-state.
* gnu/tests/containers.scm (%oci-tarball): New variable;
(run-rootless-podman-test): use %oci-tarball;
(build-tarball&run-rootless-podman-test): drop procedure.
* gnu/tests/docker.scm (%docker-tarball): New variable;
(build-tarball&run-docker-test): use %docker-tarball;
(%docker-system-tarball): New variable;
(build-tarball&run-docker-system-test): new procedure.
Change-Id: Iad6f0704aee188d89464c83722dea0bb7adb084a
---
gnu/services/containers.scm | 2 +
gnu/tests/containers.scm | 80 ++++++++++++++---------------
gnu/tests/docker.scm | 100 ++++++++++++++++++++----------------
3 files changed, 95 insertions(+), 87 deletions(-)
diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm
index 603eec25e2b..139d5e4ec50 100644
--- a/gnu/services/containers.scm
+++ b/gnu/services/containers.scm
@@ -75,6 +75,8 @@ (define-module (gnu services containers)
oci-image-system
oci-image-grafts?
+ lower-oci-image-state
+
oci-container-configuration
oci-container-configuration?
oci-container-configuration-fields
diff --git a/gnu/tests/containers.scm b/gnu/tests/containers.scm
index 5e6f39387e7..8cdd86e7ae3 100644
--- a/gnu/tests/containers.scm
+++ b/gnu/tests/containers.scm
@@ -69,13 +69,47 @@ (define %rootless-podman-os
(supplementary-groups '("wheel" "netdev" "cgroup"
"audio" "video")))))))
-(define (run-rootless-podman-test oci-tarball)
+(define %oci-tarball
+ (lower-oci-image-state
+ "guile-guest"
+ (packages->manifest
+ (list
+ guile-3.0 guile-json-3
+ (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))))
+ '(#:entry-point "bin/guile"
+ #:localstatedir? #t
+ #:extra-options (#:image-tag "guile-guest")
+ #:symlinks (("/bin/Guile" -> "bin/guile")
+ ("aa.scm" -> "a.scm")))
+ "guile-guest"
+ (%current-target-system)
+ (%current-system)
+ #f))
+
+(define (run-rootless-podman-test)
(define os
(marionette-operating-system
(operating-system-with-gc-roots
%rootless-podman-os
- (list oci-tarball))
+ (list %oci-tarball))
#:imported-modules '((gnu services herd)
(guix combinators))))
@@ -254,7 +288,7 @@ (define (run-rootless-podman-test oci-tarball)
(let* ((loaded (slurp ,(string-append #$podman
"/bin/podman")
"load" "-i"
- ,#$oci-tarball))
+ ,#$%oci-tarball))
(repository&tag "localhost/guile-guest:latest")
(response1 (slurp
,(string-append #$podman "/bin/podman")
@@ -307,49 +341,11 @@ (define (run-rootless-podman-test oci-tarball)
(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))))
+ (value (run-rootless-podman-test))))
(define %oci-rootless-podman-os
diff --git a/gnu/tests/docker.scm b/gnu/tests/docker.scm
index 5dcf05a17e3..07edd9d5341 100644
--- a/gnu/tests/docker.scm
+++ b/gnu/tests/docker.scm
@@ -26,6 +26,7 @@ (define-module (gnu tests docker)
#:use-module (gnu system image)
#:use-module (gnu system vm)
#:use-module (gnu services)
+ #:use-module (gnu services containers)
#:use-module (gnu services dbus)
#:use-module (gnu services networking)
#:use-module (gnu services docker)
@@ -57,6 +58,40 @@ (define %docker-os
(service containerd-service-type)
(service docker-service-type)))
+(define %docker-tarball
+ (lower-oci-image-state
+ "guile-guest"
+ (packages->manifest
+ (list
+ guile-3.0 guile-json-3
+ (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))))
+ '(#:entry-point "bin/guile"
+ #:localstatedir? #t
+ #:extra-options (#:image-tag "guile-guest")
+ #:symlinks (("/bin/Guile" -> "bin/guile")
+ ("aa.scm" -> "a.scm")))
+ "guile-guest"
+ (%current-target-system)
+ (%current-system)
+ #f))
+
(define (run-docker-test docker-tarball)
"Load DOCKER-TARBALL as Docker image and run it in a Docker container,
inside %DOCKER-OS."
@@ -173,40 +208,7 @@ (define (run-docker-test docker-tarball)
(gexp->derivation "docker-test" test))
(define (build-tarball&run-docker-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"))
- #:entry-point "bin/guile"
- #:localstatedir? #t)))
- (run-docker-test tarball)))
+ (run-docker-test %docker-tarball))
(define %test-docker
(system-test
@@ -215,8 +217,22 @@ (define %test-docker
(value (build-tarball&run-docker-test))))
+(define %docker-system-tarball
+ (lower-oci-image-state
+ "guix-system-guest"
+ (operating-system
+ (inherit (simple-operating-system))
+ ;; Use locales for a single libc to
+ ;; reduce space requirements.
+ (locale-libcs (list glibc)))
+ '()
+ "guix-system-guest"
+ (%current-target-system)
+ (%current-system)
+ #f))
+
(define (run-docker-system-test tarball)
- "Load DOCKER-TARBALL as Docker image and run it in a Docker container,
+ "Load TARBALL as Docker image and run it in a Docker container,
inside %DOCKER-OS."
(define os
(marionette-operating-system
@@ -333,21 +349,15 @@ (define (run-docker-system-test tarball)
(gexp->derivation "docker-system-test" test))
+(define (build-tarball&run-docker-system-test)
+ (run-docker-system-test %docker-system-tarball))
+
(define %test-docker-system
(system-test
(name "docker-system")
(description "Run a system image as produced by @command{guix system
docker-image} inside Docker.")
- (value (with-monad %store-monad
- (>>= (lower-object
- (system-image (os->image
- (operating-system
- (inherit (simple-operating-system))
- ;; Use locales for a single libc to
- ;; reduce space requirements.
- (locale-libcs (list glibc)))
- #:type docker-image-type)))
- run-docker-system-test)))))
+ (value (build-tarball&run-docker-system-test))))
(define %oci-os
--
2.48.1
andrew <at> trop.in, janneke <at> gnu.org, ludo <at> gnu.org, maxim.cournoyer <at> gmail.com, tanguy <at> bioneland.org, guix-patches <at> gnu.org:bug#76081; Package guix-patches.
(Wed, 26 Feb 2025 23:09:03 GMT) Full text and rfc822 format available.Message #95 received at 76081 <at> debbugs.gnu.org (full text, mbox):
From: Giacomo Leidi <goodoldpaul <at> autistici.org> To: 76081 <at> debbugs.gnu.org Cc: Giacomo Leidi <goodoldpaul <at> autistici.org> Subject: [PATCH v6 5/5] home: Add home-oci-service-type. Date: Thu, 27 Feb 2025 00:08:10 +0100
* gnu/home/service/containers.scm: New file;
* gnu/local.mk (GNU_SYSTEM_MODULES): Add it.
* doc/guix.texi (OCI backed services): Document it.
Change-Id: I8ce5b301e8032d0a7b2a9ca46752738cdee1f030
---
doc/guix.texi | 114 +++++++++++++++++++++++++++++++
gnu/home/services/containers.scm | 50 ++++++++++++++
gnu/local.mk | 1 +
3 files changed, 165 insertions(+)
create mode 100644 gnu/home/services/containers.scm
diff --git a/doc/guix.texi b/doc/guix.texi
index fd08261af3b..5513eb89048 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -49876,6 +49876,120 @@ Miscellaneous Home Services
(dicod-configuration @dots{})))
@end lisp
+@subsubheading OCI backed services
+
+@cindex OCI-backed, for Home
+The @code{(gnu home services containers)} module provides the following service:
+
+@defvar home-oci-service-type
+This is the type of the service that allows to manage your OCI containers with
+the same consistent interface you use for your other Home Shepherd services.
+@end defvar
+
+This service is a direct mapping of the @code{oci-service-type} system
+service (@pxref{Miscellaneous Services, OCI backed services}). You can
+use it like this:
+
+@lisp
+(use-modules (gnu services containers)
+ (gnu home services containers))
+
+(simple-service 'home-oci-provisioning
+ home-oci-service-type
+ (oci-extension
+ (volumes
+ (list
+ (oci-volume-configuration (name "prometheus"))
+ (oci-volume-configuration (name "grafana"))))
+ (networks
+ (list
+ (oci-network-configuration (name "monitoring"))))
+ (containers
+ (list
+ (oci-container-configuration
+ (network "monitoring")
+ (image
+ (oci-image
+ (repository "guile")
+ (tag "3")
+ (value (specifications->manifest '("guile")))
+ (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile"))
+ #:max-layers 2))))
+ (entrypoint "/bin/guile")
+ (command
+ '("-c" "(display \"hello!\n\")")))
+ (oci-container-configuration
+ (image "prom/prometheus")
+ (network "monitoring")
+ (ports
+ '(("9000" . "9000")
+ ("9090" . "9090")))
+ (volumes
+ (list
+ '(("prometheus" . "/var/lib/prometheus")))))
+ (oci-container-configuration
+ (image "grafana/grafana:10.0.1")
+ (network "monitoring")
+ (volumes
+ '(("grafana:/var/lib/grafana"))))))))
+
+@end lisp
+
+You may specify a custom configuration by providing a
+@code{oci-configuration} record, exactly like for
+@code{oci-service-type}, but wrapping it in @code{for-home}:
+
+@lisp
+(use-modules (gnu services)
+ (gnu services containers)
+ (gnu home services containers))
+
+(service home-oci-service-type
+ (for-home
+ (oci-configuration
+ (runtime 'podman)
+ (verbose? #t))))
+
+(simple-service 'home-oci-provisioning
+ home-oci-service-type
+ (oci-extension
+ (volumes
+ (list
+ (oci-volume-configuration (name "prometheus"))
+ (oci-volume-configuration (name "grafana"))))
+ (networks
+ (list
+ (oci-network-configuration (name "monitoring"))))
+ (containers
+ (list
+ (oci-container-configuration
+ (network "monitoring")
+ (image
+ (oci-image
+ (repository "guile")
+ (tag "3")
+ (value (specifications->manifest '("guile")))
+ (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile"))
+ #:max-layers 2))))
+ (entrypoint "/bin/guile")
+ (command
+ '("-c" "(display \"hello!\n\")")))
+ (oci-container-configuration
+ (image "prom/prometheus")
+ (network "monitoring")
+ (ports
+ '(("9000" . "9000")
+ ("9090" . "9090")))
+ (volumes
+ (list
+ '(("prometheus" . "/var/lib/prometheus")))))
+ (oci-container-configuration
+ (image "grafana/grafana:10.0.1")
+ (network "monitoring")
+ (volumes
+ '(("grafana:/var/lib/grafana"))))))))
+@end lisp
+
@node Invoking guix home
@section Invoking @command{guix home}
diff --git a/gnu/home/services/containers.scm b/gnu/home/services/containers.scm
new file mode 100644
index 00000000000..938dde2f37a
--- /dev/null
+++ b/gnu/home/services/containers.scm
@@ -0,0 +1,50 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2025 Giacomo Leidi <goodoldpaul <at> 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 home services containers)
+ #:use-module (gnu home services)
+ #:use-module (gnu home services shepherd)
+ #:use-module (gnu services)
+ #:use-module (gnu services configuration)
+ #:use-module (gnu services containers)
+ #:use-module (guix gexp)
+ #:use-module (guix packages)
+ #:use-module (srfi srfi-1)
+ #:export (home-oci-service-type))
+
+(define home-oci-service-type
+ (service-type (inherit (system->home-service-type oci-service-type))
+ (extensions
+ (list
+ (service-extension home-profile-service-type
+ (oci-service-extension-wrap-validate
+ (lambda (config)
+ (let ((runtime-cli
+ (oci-configuration-runtime-cli config))
+ (runtime
+ (oci-configuration-runtime config)))
+ (oci-service-profile runtime runtime-cli)))))
+ (service-extension home-shepherd-service-type
+ (oci-service-extension-wrap-validate
+ oci-configuration->shepherd-services))))
+ (extend
+ (lambda (config extension)
+ (for-home
+ (oci-configuration
+ (inherit (oci-configuration-extend config extension))))))
+ (default-value (for-home (oci-configuration)))))
diff --git a/gnu/local.mk b/gnu/local.mk
index c8a29bf98b5..9b86e59c37f 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -102,6 +102,7 @@ GNU_SYSTEM_MODULES = \
%D%/home.scm \
%D%/home/services.scm \
%D%/home/services/admin.scm \
+ %D%/home/services/containers.scm \
%D%/home/services/desktop.scm \
%D%/home/services/dict.scm \
%D%/home/services/dotfiles.scm \
--
2.48.1
guix-patches <at> gnu.org:bug#76081; Package guix-patches.
(Wed, 26 Feb 2025 23:09:03 GMT) Full text and rfc822 format available.Message #98 received at 76081 <at> debbugs.gnu.org (full text, mbox):
From: Giacomo Leidi <goodoldpaul <at> autistici.org> To: 76081 <at> debbugs.gnu.org Cc: Giacomo Leidi <goodoldpaul <at> autistici.org> Subject: [PATCH v6 2/5] services: oci-container-configuration: Move to (gnu services containers). Date: Thu, 27 Feb 2025 00:08:07 +0100
This patch moves the oci-container-configuration and related
configuration records to (gnu services containers).
Public symbols are still exported for backwards
compatibility but since the oci-container-service-type will be
deprecated in favor of the more general oci-service-type, everything is
moved outside of the docker related module.
* gnu/services/docker.scm: Move everything related to oci-container-configuration
to...
* gnu/services/containers.scm: ...here.scm.
* gnu/tests/docker.scm: Simplify %test-oci-container test case.
Change-Id: Iae599dd5cc7442eb632f0c1b3b12f6b928397ae7
---
gnu/services/containers.scm | 549 +++++++++++++++++++++++++++++++++-
gnu/services/docker.scm | 577 +++---------------------------------
gnu/tests/docker.scm | 99 +++----
3 files changed, 625 insertions(+), 600 deletions(-)
diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm
index d5a211765a6..24f31c756b8 100644
--- a/gnu/services/containers.scm
+++ b/gnu/services/containers.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2024 Giacomo Leidi <goodoldpaul <at> autistici.org>
+;;; Copyright © 2024, 2025 Giacomo Leidi <goodoldpaul <at> autistici.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -17,19 +17,31 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu services containers)
+ #:use-module (gnu image)
+ #:use-module (gnu packages admin)
#:use-module (gnu packages bash)
#:use-module (gnu packages containers)
+ #:use-module (gnu packages docker)
#: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)
#:use-module (gnu system accounts)
+ #:use-module (gnu system image)
#:use-module (gnu system shadow)
#:use-module (gnu system pam)
+ #:use-module (guix diagnostics)
#:use-module (guix gexp)
+ #:use-module (guix i18n)
+ #:use-module (guix monads)
#:use-module (guix packages)
+ #:use-module (guix profiles)
+ #:use-module ((guix scripts pack) #:prefix pack:)
+ #:use-module (guix store)
#:use-module (srfi srfi-1)
+ #:use-module (ice-9 match)
#:export (rootless-podman-configuration
rootless-podman-configuration?
rootless-podman-configuration-fields
@@ -48,7 +60,44 @@ (define-module (gnu services containers)
rootless-podman-shepherd-services
rootless-podman-service-etc
- rootless-podman-service-type))
+ rootless-podman-service-type
+
+ oci-image
+ oci-image?
+ oci-image-fields
+ oci-image-repository
+ oci-image-tag
+ oci-image-value
+ oci-image-pack-options
+ oci-image-target
+ oci-image-system
+ oci-image-grafts?
+
+ oci-container-configuration
+ oci-container-configuration?
+ oci-container-configuration-fields
+ oci-container-configuration-user
+ oci-container-configuration-group
+ oci-container-configuration-command
+ oci-container-configuration-entrypoint
+ oci-container-configuration-host-environment
+ oci-container-configuration-environment
+ oci-container-configuration-image
+ oci-container-configuration-provision
+ oci-container-configuration-requirement
+ oci-container-configuration-log-file
+ oci-container-configuration-auto-start?
+ oci-container-configuration-respawn?
+ oci-container-configuration-shepherd-actions
+ oci-container-configuration-network
+ oci-container-configuration-ports
+ oci-container-configuration-volumes
+ oci-container-configuration-container-user
+ oci-container-configuration-workdir
+ oci-container-configuration-extra-arguments
+
+ oci-container-shepherd-service
+ %oci-container-accounts))
(define (gexp-or-string? value)
(or (gexp? value)
@@ -190,7 +239,7 @@ (define (rootless-podman-cgroups-limits-service config)
rootless-podman-shared-root-fs))
(one-shot? #t)
(documentation
- "Allow setting cgroups limits: cpu, cpuset, memory and
+ "Allow setting cgroups limits: cpu, cpuset, io, memory and
pids.")
(start
#~(make-forkexec-constructor
@@ -244,3 +293,497 @@ (define rootless-podman-service-type
(default-value (rootless-podman-configuration))
(description
"This service configures rootless @code{podman} on the Guix System.")))
+
+
+;;;
+;;; OCI container.
+;;;
+
+(define (oci-sanitize-pair pair delimiter)
+ (define (valid? member)
+ (or (string? member)
+ (gexp? member)
+ (file-like? member)))
+ (match pair
+ (((? valid? key) . (? valid? value))
+ #~(string-append #$key #$delimiter #$value))
+ (_
+ (raise
+ (formatted-message
+ (G_ "pair members must contain only strings, gexps or file-like objects
+but ~a was found")
+ pair)))))
+
+(define (oci-sanitize-mixed-list name value delimiter)
+ (map
+ (lambda (el)
+ (cond ((string? el) el)
+ ((pair? el) (oci-sanitize-pair el delimiter))
+ (else
+ (raise
+ (formatted-message
+ (G_ "~a members must be either a string or a pair but ~a was
+found!")
+ name el)))))
+ value))
+
+(define (oci-sanitize-host-environment value)
+ ;; Expected spec format:
+ ;; '(("HOME" . "/home/nobody") "JAVA_HOME=/java")
+ (oci-sanitize-mixed-list "host-environment" value "="))
+
+(define (oci-sanitize-environment value)
+ ;; Expected spec format:
+ ;; '(("HOME" . "/home/nobody") "JAVA_HOME=/java")
+ (oci-sanitize-mixed-list "environment" value "="))
+
+(define (oci-sanitize-ports value)
+ ;; Expected spec format:
+ ;; '(("8088" . "80") "2022:22")
+ (oci-sanitize-mixed-list "ports" value ":"))
+
+(define (oci-sanitize-volumes value)
+ ;; Expected spec format:
+ ;; '(("/mnt/dir" . "/dir") "/run/current-system/profile:/java")
+ (oci-sanitize-mixed-list "volumes" value ":"))
+
+(define (oci-sanitize-shepherd-actions value)
+ (map
+ (lambda (el)
+ (if (shepherd-action? el)
+ el
+ (raise
+ (formatted-message
+ (G_ "shepherd-actions may only be shepherd-action records
+but ~a was found") el))))
+ value))
+
+(define (oci-sanitize-extra-arguments value)
+ (define (valid? member)
+ (or (string? member)
+ (gexp? member)
+ (file-like? member)))
+ (map
+ (lambda (el)
+ (if (valid? el)
+ el
+ (raise
+ (formatted-message
+ (G_ "extra arguments may only be strings, gexps or file-like objects
+but ~a was found") el))))
+ value))
+
+(define (oci-image-reference image)
+ (if (string? image)
+ image
+ (string-append (oci-image-repository image)
+ ":" (oci-image-tag image))))
+
+(define (oci-lowerable-image? image)
+ (or (manifest? image)
+ (operating-system? image)
+ (gexp? image)
+ (file-like? image)))
+
+(define (string-or-oci-image? image)
+ (or (string? image)
+ (oci-image? image)))
+
+(define list-of-symbols?
+ (list-of symbol?))
+
+(define-maybe/no-serialization string)
+
+(define-configuration/no-serialization oci-image
+ (repository
+ (string)
+ "A string like @code{myregistry.local:5000/testing/test-image} that names
+the OCI image.")
+ (tag
+ (string "latest")
+ "A string representing the OCI image tag. Defaults to @code{latest}.")
+ (value
+ (oci-lowerable-image)
+ "A @code{manifest} or @code{operating-system} record that will be lowered
+into an OCI compatible tarball. Otherwise this field's value can be a gexp
+or a file-like object that evaluates to an OCI compatible tarball.")
+ (pack-options
+ (list '())
+ "An optional set of keyword arguments that will be passed to the
+@code{docker-image} procedure from @code{guix scripts pack}. They can be used
+to replicate @command{guix pack} behavior:
+
+@lisp
+(oci-image
+ (repository \"guile\")
+ (tag \"3\")
+ (manifest (specifications->manifest '(\"guile\")))
+ (pack-options
+ '(#:symlinks ((\"/bin/guile\" -> \"bin/guile\"))
+ #:max-layers 2)))
+@end lisp
+
+If the @code{value} field is an @code{operating-system} record, this field's
+value will be ignored.")
+ (system
+ (maybe-string)
+ "Attempt to build for a given system, e.g. \"i686-linux\"")
+ (target
+ (maybe-string)
+ "Attempt to cross-build for a given triple, e.g. \"aarch64-linux-gnu\"")
+ (grafts?
+ (boolean #f)
+ "Whether to allow grafting or not in the pack build."))
+
+(define-configuration/no-serialization oci-container-configuration
+ (user
+ (string "oci-container")
+ "The user under whose authority docker commands will be run.")
+ (group
+ (string "docker")
+ "The group under whose authority docker commands will be run.")
+ (command
+ (list-of-strings '())
+ "Overwrite the default command (@code{CMD}) of the image.")
+ (entrypoint
+ (maybe-string)
+ "Overwrite the default entrypoint (@code{ENTRYPOINT}) of the image.")
+ (host-environment
+ (list '())
+ "Set environment variables in the host environment where @command{docker run}
+is invoked. This is especially useful to pass secrets from the host to the
+container without having them on the @command{docker run}'s command line: by
+setting the @code{MYSQL_PASSWORD} on the host and by passing
+@code{--env MYSQL_PASSWORD} through the @code{extra-arguments} field, it is
+possible to securely set values in the container environment. This field's
+value can be a list of pairs or strings, even mixed:
+
+@lisp
+(list '(\"LANGUAGE\" . \"eo:ca:eu\")
+ \"JAVA_HOME=/opt/java\")
+@end lisp
+
+Pair members can be strings, gexps or file-like objects. Strings are passed
+directly to @code{make-forkexec-constructor}."
+ (sanitizer oci-sanitize-host-environment))
+ (environment
+ (list '())
+ "Set environment variables inside the container. This can be a list of pairs
+or strings, even mixed:
+
+@lisp
+(list '(\"LANGUAGE\" . \"eo:ca:eu\")
+ \"JAVA_HOME=/opt/java\")
+@end lisp
+
+Pair members can be strings, gexps or file-like objects. Strings are passed
+directly to the Docker CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#env,upstream}
+documentation for semantics."
+ (sanitizer oci-sanitize-environment))
+ (image
+ (string-or-oci-image)
+ "The image used to build the container. It can be a string or an
+@code{oci-image} record. Strings are resolved by the Docker
+Engine, and follow the usual format
+@code{myregistry.local:5000/testing/test-image:tag}.")
+ (provision
+ (maybe-string)
+ "Set the name of the provisioned Shepherd service.")
+ (requirement
+ (list-of-symbols '())
+ "Set additional Shepherd services dependencies to the provisioned Shepherd
+service.")
+ (log-file
+ (maybe-string)
+ "When @code{log-file} is set, it names the file to which the service’s
+standard output and standard error are redirected. @code{log-file} is created
+if it does not exist, otherwise it is appended to.")
+ (auto-start?
+ (boolean #t)
+ "Whether this service should be started automatically by the Shepherd. If it
+is @code{#f} the service has to be started manually with @command{herd start}.")
+ (respawn?
+ (boolean #f)
+ "Whether to restart the service when it stops, for instance when the
+underlying process dies.")
+ (shepherd-actions
+ (list '())
+ "This is a list of @code{shepherd-action} records defining actions supported
+by the service."
+ (sanitizer oci-sanitize-shepherd-actions))
+ (network
+ (maybe-string)
+ "Set a Docker network for the spawned container.")
+ (ports
+ (list '())
+ "Set the port or port ranges to expose from the spawned container. This can
+be a list of pairs or strings, even mixed:
+
+@lisp
+(list '(\"8080\" . \"80\")
+ \"10443:443\")
+@end lisp
+
+Pair members can be strings, gexps or file-like objects. Strings are passed
+directly to the Docker CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#publish,upstream}
+documentation for semantics."
+ (sanitizer oci-sanitize-ports))
+ (volumes
+ (list '())
+ "Set volume mappings for the spawned container. This can be a
+list of pairs or strings, even mixed:
+
+@lisp
+(list '(\"/root/data/grafana\" . \"/var/lib/grafana\")
+ \"/gnu/store:/gnu/store\")
+@end lisp
+
+Pair members can be strings, gexps or file-like objects. Strings are passed
+directly to the Docker CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#volume,upstream}
+documentation for semantics."
+ (sanitizer oci-sanitize-volumes))
+ (container-user
+ (maybe-string)
+ "Set the current user inside the spawned container. You can refer to the
+@url{https://docs.docker.com/engine/reference/run/#user,upstream}
+documentation for semantics.")
+ (workdir
+ (maybe-string)
+ "Set the current working for the spawned Shepherd service.
+You can refer to the
+@url{https://docs.docker.com/engine/reference/run/#workdir,upstream}
+documentation for semantics.")
+ (extra-arguments
+ (list '())
+ "A list of strings, gexps or file-like objects that will be directly passed
+to the @command{docker run} invokation."
+ (sanitizer oci-sanitize-extra-arguments)))
+
+(define oci-container-configuration->options
+ (lambda (config)
+ (let ((entrypoint
+ (oci-container-configuration-entrypoint config))
+ (network
+ (oci-container-configuration-network config))
+ (user
+ (oci-container-configuration-container-user config))
+ (workdir
+ (oci-container-configuration-workdir config)))
+ (apply append
+ (filter (compose not unspecified?)
+ `(,(if (maybe-value-set? entrypoint)
+ `("--entrypoint" ,entrypoint)
+ '())
+ ,(append-map
+ (lambda (spec)
+ (list "--env" spec))
+ (oci-container-configuration-environment config))
+ ,(if (maybe-value-set? network)
+ `("--network" ,network)
+ '())
+ ,(if (maybe-value-set? user)
+ `("--user" ,user)
+ '())
+ ,(if (maybe-value-set? workdir)
+ `("--workdir" ,workdir)
+ '())
+ ,(append-map
+ (lambda (spec)
+ (list "-p" spec))
+ (oci-container-configuration-ports config))
+ ,(append-map
+ (lambda (spec)
+ (list "-v" spec))
+ (oci-container-configuration-volumes config))))))))
+
+(define* (get-keyword-value args keyword #:key (default #f))
+ (let ((kv (memq keyword args)))
+ (if (and kv (>= (length kv) 2))
+ (cadr kv)
+ default)))
+
+(define (lower-operating-system os target system)
+ (mlet* %store-monad
+ ((tarball
+ (lower-object
+ (system-image (os->image os #:type docker-image-type))
+ system
+ #:target target)))
+ (return tarball)))
+
+(define (lower-manifest name image target system)
+ (define value (oci-image-value image))
+ (define options (oci-image-pack-options image))
+ (define image-reference
+ (oci-image-reference image))
+ (define image-tag
+ (let* ((extra-options
+ (get-keyword-value options #:extra-options))
+ (image-tag-option
+ (and extra-options
+ (get-keyword-value extra-options #:image-tag))))
+ (if image-tag-option
+ '()
+ `(#:extra-options (#:image-tag ,image-reference)))))
+
+ (mlet* %store-monad
+ ((_ (set-grafting
+ (oci-image-grafts? image)))
+ (guile (set-guile-for-build (default-guile)))
+ (profile
+ (profile-derivation value
+ #:target target
+ #:system system
+ #:hooks '()
+ #:locales? #f))
+ (tarball (apply pack:docker-image
+ `(,name ,profile
+ ,@options
+ ,@image-tag
+ #:localstatedir? #t))))
+ (return tarball)))
+
+(define (lower-oci-image name image)
+ (define value (oci-image-value image))
+ (define image-target (oci-image-target image))
+ (define image-system (oci-image-system image))
+ (define target
+ (if (maybe-value-set? image-target)
+ image-target
+ (%current-target-system)))
+ (define system
+ (if (maybe-value-set? image-system)
+ image-system
+ (%current-system)))
+ (with-store store
+ (run-with-store store
+ (match value
+ ((? manifest? value)
+ (lower-manifest name image target system))
+ ((? operating-system? value)
+ (lower-operating-system value target system))
+ ((or (? gexp? value)
+ (? file-like? value))
+ value)
+ (_
+ (raise
+ (formatted-message
+ (G_ "oci-image value must contain only manifest,
+operating-system, gexp or file-like records but ~a was found")
+ value))))
+ #:target target
+ #:system system)))
+
+(define (%oci-image-loader name image tag)
+ (let ((docker (file-append docker-cli "/bin/docker"))
+ (tarball (lower-oci-image name image)))
+ (with-imported-modules '((guix build utils))
+ (program-file (format #f "~a-image-loader" name)
+ #~(begin
+ (use-modules (guix build utils)
+ (ice-9 popen)
+ (ice-9 rdelim))
+
+ (format #t "Loading image for ~a from ~a...~%" #$name #$tarball)
+ (define line
+ (read-line
+ (open-input-pipe
+ (string-append #$docker " load -i " #$tarball))))
+
+ (unless (or (eof-object? line)
+ (string-null? line))
+ (format #t "~a~%" line)
+ (let ((repository&tag
+ (string-drop line
+ (string-length
+ "Loaded image: "))))
+
+ (invoke #$docker "tag" repository&tag #$tag)
+ (format #t "Tagged ~a with ~a...~%" #$tarball #$tag))))))))
+
+(define (oci-container-shepherd-service config)
+ (define (guess-name name image)
+ (if (maybe-value-set? name)
+ name
+ (string-append "docker-"
+ (basename
+ (if (string? image)
+ (first (string-split image #\:))
+ (oci-image-repository image))))))
+
+ (let* ((docker (file-append docker-cli "/bin/docker"))
+ (actions (oci-container-configuration-shepherd-actions config))
+ (auto-start?
+ (oci-container-configuration-auto-start? config))
+ (user (oci-container-configuration-user config))
+ (group (oci-container-configuration-group config))
+ (host-environment
+ (oci-container-configuration-host-environment config))
+ (command (oci-container-configuration-command config))
+ (log-file (oci-container-configuration-log-file config))
+ (provision (oci-container-configuration-provision config))
+ (requirement (oci-container-configuration-requirement config))
+ (respawn?
+ (oci-container-configuration-respawn? config))
+ (image (oci-container-configuration-image config))
+ (image-reference (oci-image-reference image))
+ (options (oci-container-configuration->options config))
+ (name (guess-name provision image))
+ (extra-arguments
+ (oci-container-configuration-extra-arguments config)))
+
+ (shepherd-service (provision `(,(string->symbol name)))
+ (requirement `(dockerd user-processes ,@requirement))
+ (respawn? respawn?)
+ (auto-start? auto-start?)
+ (documentation
+ (string-append
+ "Docker backed Shepherd service for "
+ (if (oci-image? image) name image) "."))
+ (start
+ #~(lambda ()
+ #$@(if (oci-image? image)
+ #~((invoke #$(%oci-image-loader
+ name image image-reference)))
+ #~())
+ (fork+exec-command
+ ;; docker run [OPTIONS] IMAGE [COMMAND] [ARG...]
+ (list #$docker "run" "--rm" "--name" #$name
+ #$@options #$@extra-arguments
+ #$image-reference #$@command)
+ #:user #$user
+ #:group #$group
+ #$@(if (maybe-value-set? log-file)
+ (list #:log-file log-file)
+ '())
+ #:environment-variables
+ (list #$@host-environment))))
+ (stop
+ #~(lambda _
+ (invoke #$docker "rm" "-f" #$name)))
+ (actions
+ (if (oci-image? image)
+ '()
+ (append
+ (list
+ (shepherd-action
+ (name 'pull)
+ (documentation
+ (format #f "Pull ~a's image (~a)."
+ name image))
+ (procedure
+ #~(lambda _
+ (invoke #$docker "pull" #$image)))))
+ actions))))))
+
+(define %oci-container-accounts
+ (list (user-account
+ (name "oci-container")
+ (comment "OCI services account")
+ (group "docker")
+ (system? #t)
+ (home-directory "/var/empty")
+ (shell (file-append shadow "/sbin/nologin")))))
diff --git a/gnu/services/docker.scm b/gnu/services/docker.scm
index 9ab3e583345..828ceea313a 100644
--- a/gnu/services/docker.scm
+++ b/gnu/services/docker.scm
@@ -5,7 +5,7 @@
;;; Copyright © 2020 Efraim Flashner <efraim <at> flashner.co.il>
;;; Copyright © 2020 Jesse Dowell <jessedowell <at> gmail.com>
;;; Copyright © 2021 Brice Waegeneire <brice <at> waegenei.re>
-;;; Copyright © 2023, 2024 Giacomo Leidi <goodoldpaul <at> autistici.org>
+;;; Copyright © 2023, 2024, 2025 Giacomo Leidi <goodoldpaul <at> autistici.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -23,72 +23,60 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu services docker)
- #:use-module (gnu image)
#:use-module (gnu services)
#:use-module (gnu services configuration)
- #:use-module (gnu services base)
- #:use-module (gnu services dbus)
+ #:use-module (gnu services containers)
#:use-module (gnu services shepherd)
- #:use-module (gnu system)
- #:use-module (gnu system image)
#:use-module (gnu system privilege)
#:use-module (gnu system shadow)
- #:use-module (gnu packages admin) ;shadow
#:use-module (gnu packages docker)
#:use-module (gnu packages linux) ;singularity
- #:use-module (guix records)
- #:use-module (guix diagnostics)
#:use-module (guix gexp)
- #:use-module (guix i18n)
- #:use-module (guix monads)
- #:use-module (guix packages)
- #:use-module (guix profiles)
- #:use-module ((guix scripts pack) #:prefix pack:)
- #:use-module (guix store)
+ #:use-module (guix records)
#:use-module (srfi srfi-1)
#:use-module (ice-9 format)
#:use-module (ice-9 match)
+ #:re-export (oci-image ;for backwards compatibility, until the
+ oci-image? ;oci-container-service-type is fully deprecated
+ oci-image-fields
+ oci-image-repository
+ oci-image-tag
+ oci-image-value
+ oci-image-pack-options
+ oci-image-target
+ oci-image-system
+ oci-image-grafts?
+ oci-container-configuration
+ oci-container-configuration?
+ oci-container-configuration-fields
+ oci-container-configuration-user
+ oci-container-configuration-group
+ oci-container-configuration-command
+ oci-container-configuration-entrypoint
+ oci-container-configuration-host-environment
+ oci-container-configuration-environment
+ oci-container-configuration-image
+ oci-container-configuration-provision
+ oci-container-configuration-requirement
+ oci-container-configuration-log-file
+ oci-container-configuration-auto-start?
+ oci-container-configuration-respawn?
+ oci-container-configuration-shepherd-actions
+ oci-container-configuration-network
+ oci-container-configuration-ports
+ oci-container-configuration-volumes
+ oci-container-configuration-container-user
+ oci-container-configuration-workdir
+ oci-container-configuration-extra-arguments
+ oci-container-shepherd-service
+ %oci-container-accounts)
#:export (containerd-configuration
containerd-service-type
docker-configuration
docker-service-type
singularity-service-type
- oci-image
- oci-image?
- oci-image-fields
- oci-image-repository
- oci-image-tag
- oci-image-value
- oci-image-pack-options
- oci-image-target
- oci-image-system
- oci-image-grafts?
- oci-container-configuration
- oci-container-configuration?
- oci-container-configuration-fields
- oci-container-configuration-user
- oci-container-configuration-group
- oci-container-configuration-command
- oci-container-configuration-entrypoint
- oci-container-configuration-host-environment
- oci-container-configuration-environment
- oci-container-configuration-image
- oci-container-configuration-provision
- oci-container-configuration-requirement
- oci-container-configuration-log-file
- oci-container-configuration-auto-start?
- oci-container-configuration-respawn?
- oci-container-configuration-shepherd-actions
- oci-container-configuration-network
- oci-container-configuration-ports
- oci-container-configuration-volumes
- oci-container-configuration-container-user
- oci-container-configuration-workdir
- oci-container-configuration-extra-arguments
- oci-container-service-type
- oci-container-shepherd-service
- %oci-container-accounts))
+ oci-container-service-type))
(define-maybe file-like)
@@ -309,495 +297,6 @@ (define singularity-service-type
;;; OCI container.
;;;
-(define (oci-sanitize-pair pair delimiter)
- (define (valid? member)
- (or (string? member)
- (gexp? member)
- (file-like? member)))
- (match pair
- (((? valid? key) . (? valid? value))
- #~(string-append #$key #$delimiter #$value))
- (_
- (raise
- (formatted-message
- (G_ "pair members must contain only strings, gexps or file-like objects
-but ~a was found")
- pair)))))
-
-(define (oci-sanitize-mixed-list name value delimiter)
- (map
- (lambda (el)
- (cond ((string? el) el)
- ((pair? el) (oci-sanitize-pair el delimiter))
- (else
- (raise
- (formatted-message
- (G_ "~a members must be either a string or a pair but ~a was
-found!")
- name el)))))
- value))
-
-(define (oci-sanitize-host-environment value)
- ;; Expected spec format:
- ;; '(("HOME" . "/home/nobody") "JAVA_HOME=/java")
- (oci-sanitize-mixed-list "host-environment" value "="))
-
-(define (oci-sanitize-environment value)
- ;; Expected spec format:
- ;; '(("HOME" . "/home/nobody") "JAVA_HOME=/java")
- (oci-sanitize-mixed-list "environment" value "="))
-
-(define (oci-sanitize-ports value)
- ;; Expected spec format:
- ;; '(("8088" . "80") "2022:22")
- (oci-sanitize-mixed-list "ports" value ":"))
-
-(define (oci-sanitize-volumes value)
- ;; Expected spec format:
- ;; '(("/mnt/dir" . "/dir") "/run/current-system/profile:/java")
- (oci-sanitize-mixed-list "volumes" value ":"))
-
-(define (oci-sanitize-shepherd-actions value)
- (map
- (lambda (el)
- (if (shepherd-action? el)
- el
- (raise
- (formatted-message
- (G_ "shepherd-actions may only be shepherd-action records
-but ~a was found") el))))
- value))
-
-(define (oci-sanitize-extra-arguments value)
- (define (valid? member)
- (or (string? member)
- (gexp? member)
- (file-like? member)))
- (map
- (lambda (el)
- (if (valid? el)
- el
- (raise
- (formatted-message
- (G_ "extra arguments may only be strings, gexps or file-like objects
-but ~a was found") el))))
- value))
-
-(define (oci-image-reference image)
- (if (string? image)
- image
- (string-append (oci-image-repository image)
- ":" (oci-image-tag image))))
-
-(define (oci-lowerable-image? image)
- (or (manifest? image)
- (operating-system? image)
- (gexp? image)
- (file-like? image)))
-
-(define (string-or-oci-image? image)
- (or (string? image)
- (oci-image? image)))
-
-(define list-of-symbols?
- (list-of symbol?))
-
-(define-maybe/no-serialization string)
-
-(define-configuration/no-serialization oci-image
- (repository
- (string)
- "A string like @code{myregistry.local:5000/testing/test-image} that names
-the OCI image.")
- (tag
- (string "latest")
- "A string representing the OCI image tag. Defaults to @code{latest}.")
- (value
- (oci-lowerable-image)
- "A @code{manifest} or @code{operating-system} record that will be lowered
-into an OCI compatible tarball. Otherwise this field's value can be a gexp
-or a file-like object that evaluates to an OCI compatible tarball.")
- (pack-options
- (list '())
- "An optional set of keyword arguments that will be passed to the
-@code{docker-image} procedure from @code{guix scripts pack}. They can be used
-to replicate @command{guix pack} behavior:
-
-@lisp
-(oci-image
- (repository \"guile\")
- (tag \"3\")
- (manifest (specifications->manifest '(\"guile\")))
- (pack-options
- '(#:symlinks ((\"/bin/guile\" -> \"bin/guile\"))
- #:max-layers 2)))
-@end lisp
-
-If the @code{value} field is an @code{operating-system} record, this field's
-value will be ignored.")
- (system
- (maybe-string)
- "Attempt to build for a given system, e.g. \"i686-linux\"")
- (target
- (maybe-string)
- "Attempt to cross-build for a given triple, e.g. \"aarch64-linux-gnu\"")
- (grafts?
- (boolean #f)
- "Whether to allow grafting or not in the pack build."))
-
-(define-configuration/no-serialization oci-container-configuration
- (user
- (string "oci-container")
- "The user under whose authority docker commands will be run.")
- (group
- (string "docker")
- "The group under whose authority docker commands will be run.")
- (command
- (list-of-strings '())
- "Overwrite the default command (@code{CMD}) of the image.")
- (entrypoint
- (maybe-string)
- "Overwrite the default entrypoint (@code{ENTRYPOINT}) of the image.")
- (host-environment
- (list '())
- "Set environment variables in the host environment where @command{docker run}
-is invoked. This is especially useful to pass secrets from the host to the
-container without having them on the @command{docker run}'s command line: by
-setting the @code{MYSQL_PASSWORD} on the host and by passing
-@code{--env MYSQL_PASSWORD} through the @code{extra-arguments} field, it is
-possible to securely set values in the container environment. This field's
-value can be a list of pairs or strings, even mixed:
-
-@lisp
-(list '(\"LANGUAGE\" . \"eo:ca:eu\")
- \"JAVA_HOME=/opt/java\")
-@end lisp
-
-Pair members can be strings, gexps or file-like objects. Strings are passed
-directly to @code{make-forkexec-constructor}."
- (sanitizer oci-sanitize-host-environment))
- (environment
- (list '())
- "Set environment variables inside the container. This can be a list of pairs
-or strings, even mixed:
-
-@lisp
-(list '(\"LANGUAGE\" . \"eo:ca:eu\")
- \"JAVA_HOME=/opt/java\")
-@end lisp
-
-Pair members can be strings, gexps or file-like objects. Strings are passed
-directly to the Docker CLI. You can refer to the
-@url{https://docs.docker.com/engine/reference/commandline/run/#env,upstream}
-documentation for semantics."
- (sanitizer oci-sanitize-environment))
- (image
- (string-or-oci-image)
- "The image used to build the container. It can be a string or an
-@code{oci-image} record. Strings are resolved by the Docker
-Engine, and follow the usual format
-@code{myregistry.local:5000/testing/test-image:tag}.")
- (provision
- (maybe-string)
- "Set the name of the provisioned Shepherd service.")
- (requirement
- (list-of-symbols '())
- "Set additional Shepherd services dependencies to the provisioned Shepherd
-service.")
- (log-file
- (maybe-string)
- "When @code{log-file} is set, it names the file to which the service’s
-standard output and standard error are redirected. @code{log-file} is created
-if it does not exist, otherwise it is appended to.")
- (auto-start?
- (boolean #t)
- "Whether this service should be started automatically by the Shepherd. If it
-is @code{#f} the service has to be started manually with @command{herd start}.")
- (respawn?
- (boolean #f)
- "Whether to restart the service when it stops, for instance when the
-underlying process dies.")
- (shepherd-actions
- (list '())
- "This is a list of @code{shepherd-action} records defining actions supported
-by the service."
- (sanitizer oci-sanitize-shepherd-actions))
- (network
- (maybe-string)
- "Set a Docker network for the spawned container.")
- (ports
- (list '())
- "Set the port or port ranges to expose from the spawned container. This can
-be a list of pairs or strings, even mixed:
-
-@lisp
-(list '(\"8080\" . \"80\")
- \"10443:443\")
-@end lisp
-
-Pair members can be strings, gexps or file-like objects. Strings are passed
-directly to the Docker CLI. You can refer to the
-@url{https://docs.docker.com/engine/reference/commandline/run/#publish,upstream}
-documentation for semantics."
- (sanitizer oci-sanitize-ports))
- (volumes
- (list '())
- "Set volume mappings for the spawned container. This can be a
-list of pairs or strings, even mixed:
-
-@lisp
-(list '(\"/root/data/grafana\" . \"/var/lib/grafana\")
- \"/gnu/store:/gnu/store\")
-@end lisp
-
-Pair members can be strings, gexps or file-like objects. Strings are passed
-directly to the Docker CLI. You can refer to the
-@url{https://docs.docker.com/engine/reference/commandline/run/#volume,upstream}
-documentation for semantics."
- (sanitizer oci-sanitize-volumes))
- (container-user
- (maybe-string)
- "Set the current user inside the spawned container. You can refer to the
-@url{https://docs.docker.com/engine/reference/run/#user,upstream}
-documentation for semantics.")
- (workdir
- (maybe-string)
- "Set the current working for the spawned Shepherd service.
-You can refer to the
-@url{https://docs.docker.com/engine/reference/run/#workdir,upstream}
-documentation for semantics.")
- (extra-arguments
- (list '())
- "A list of strings, gexps or file-like objects that will be directly passed
-to the @command{docker run} invocation."
- (sanitizer oci-sanitize-extra-arguments)))
-
-(define oci-container-configuration->options
- (lambda (config)
- (let ((entrypoint
- (oci-container-configuration-entrypoint config))
- (network
- (oci-container-configuration-network config))
- (user
- (oci-container-configuration-container-user config))
- (workdir
- (oci-container-configuration-workdir config)))
- (apply append
- (filter (compose not unspecified?)
- `(,(if (maybe-value-set? entrypoint)
- `("--entrypoint" ,entrypoint)
- '())
- ,(append-map
- (lambda (spec)
- (list "--env" spec))
- (oci-container-configuration-environment config))
- ,(if (maybe-value-set? network)
- `("--network" ,network)
- '())
- ,(if (maybe-value-set? user)
- `("--user" ,user)
- '())
- ,(if (maybe-value-set? workdir)
- `("--workdir" ,workdir)
- '())
- ,(append-map
- (lambda (spec)
- (list "-p" spec))
- (oci-container-configuration-ports config))
- ,(append-map
- (lambda (spec)
- (list "-v" spec))
- (oci-container-configuration-volumes config))))))))
-
-(define* (get-keyword-value args keyword #:key (default #f))
- (let ((kv (memq keyword args)))
- (if (and kv (>= (length kv) 2))
- (cadr kv)
- default)))
-
-(define (lower-operating-system os target system)
- (mlet* %store-monad
- ((tarball
- (lower-object
- (system-image (os->image os #:type docker-image-type))
- system
- #:target target)))
- (return tarball)))
-
-(define (lower-manifest name image target system)
- (define value (oci-image-value image))
- (define options (oci-image-pack-options image))
- (define image-reference
- (oci-image-reference image))
- (define image-tag
- (let* ((extra-options
- (get-keyword-value options #:extra-options))
- (image-tag-option
- (and extra-options
- (get-keyword-value extra-options #:image-tag))))
- (if image-tag-option
- '()
- `(#:extra-options (#:image-tag ,image-reference)))))
-
- (mlet* %store-monad
- ((_ (set-grafting
- (oci-image-grafts? image)))
- (guile (set-guile-for-build (default-guile)))
- (profile
- (profile-derivation value
- #:target target
- #:system system
- #:hooks '()
- #:locales? #f))
- (tarball (apply pack:docker-image
- `(,name ,profile
- ,@options
- ,@image-tag
- #:localstatedir? #t))))
- (return tarball)))
-
-(define (lower-oci-image name image)
- (define value (oci-image-value image))
- (define image-target (oci-image-target image))
- (define image-system (oci-image-system image))
- (define target
- (if (maybe-value-set? image-target)
- image-target
- (%current-target-system)))
- (define system
- (if (maybe-value-set? image-system)
- image-system
- (%current-system)))
- (with-store store
- (run-with-store store
- (match value
- ((? manifest? value)
- (lower-manifest name image target system))
- ((? operating-system? value)
- (lower-operating-system value target system))
- ((or (? gexp? value)
- (? file-like? value))
- value)
- (_
- (raise
- (formatted-message
- (G_ "oci-image value must contain only manifest,
-operating-system, gexp or file-like records but ~a was found")
- value))))
- #:target target
- #:system system)))
-
-(define (%oci-image-loader name image tag)
- (let ((docker (file-append docker-cli "/bin/docker"))
- (tarball (lower-oci-image name image)))
- (with-imported-modules '((guix build utils))
- (program-file (format #f "~a-image-loader" name)
- #~(begin
- (use-modules (guix build utils)
- (ice-9 popen)
- (ice-9 rdelim))
-
- (format #t "Loading image for ~a from ~a...~%" #$name #$tarball)
- (define line
- (read-line
- (open-input-pipe
- (string-append #$docker " load -i " #$tarball))))
-
- (unless (or (eof-object? line)
- (string-null? line))
- (format #t "~a~%" line)
- (let ((repository&tag
- (string-drop line
- (string-length
- "Loaded image: "))))
-
- (invoke #$docker "tag" repository&tag #$tag)
- (format #t "Tagged ~a with ~a...~%" #$tarball #$tag))))))))
-
-(define (oci-container-shepherd-service config)
- (define (guess-name name image)
- (if (maybe-value-set? name)
- name
- (string-append "docker-"
- (basename
- (if (string? image)
- (first (string-split image #\:))
- (oci-image-repository image))))))
-
- (let* ((docker (file-append docker-cli "/bin/docker"))
- (actions (oci-container-configuration-shepherd-actions config))
- (auto-start?
- (oci-container-configuration-auto-start? config))
- (user (oci-container-configuration-user config))
- (group (oci-container-configuration-group config))
- (host-environment
- (oci-container-configuration-host-environment config))
- (command (oci-container-configuration-command config))
- (log-file (oci-container-configuration-log-file config))
- (provision (oci-container-configuration-provision config))
- (requirement (oci-container-configuration-requirement config))
- (respawn?
- (oci-container-configuration-respawn? config))
- (image (oci-container-configuration-image config))
- (image-reference (oci-image-reference image))
- (options (oci-container-configuration->options config))
- (name (guess-name provision image))
- (extra-arguments
- (oci-container-configuration-extra-arguments config)))
-
- (shepherd-service (provision `(,(string->symbol name)))
- (requirement `(dockerd user-processes ,@requirement))
- (respawn? respawn?)
- (auto-start? auto-start?)
- (documentation
- (string-append
- "Docker backed Shepherd service for "
- (if (oci-image? image) name image) "."))
- (start
- #~(lambda ()
- #$@(if (oci-image? image)
- #~((invoke #$(%oci-image-loader
- name image image-reference)))
- #~())
- (fork+exec-command
- ;; docker run [OPTIONS] IMAGE [COMMAND] [ARG...]
- (list #$docker "run" "--rm" "--name" #$name
- #$@options #$@extra-arguments
- #$image-reference #$@command)
- #:user #$user
- #:group #$group
- #$@(if (maybe-value-set? log-file)
- (list #:log-file log-file)
- '())
- #:environment-variables
- (list #$@host-environment))))
- (stop
- #~(lambda _
- (invoke #$docker "rm" "-f" #$name)))
- (actions
- (if (oci-image? image)
- '()
- (append
- (list
- (shepherd-action
- (name 'pull)
- (documentation
- (format #f "Pull ~a's image (~a)."
- name image))
- (procedure
- #~(lambda _
- (invoke #$docker "pull" #$image)))))
- actions))))))
-
-(define %oci-container-accounts
- (list (user-account
- (name "oci-container")
- (comment "OCI services account")
- (group "docker")
- (system? #t)
- (home-directory "/var/empty")
- (shell (file-append shadow "/sbin/nologin")))))
-
(define (configs->shepherd-services configs)
(map oci-container-shepherd-service configs))
diff --git a/gnu/tests/docker.scm b/gnu/tests/docker.scm
index 90c8d0f8508..5dcf05a17e3 100644
--- a/gnu/tests/docker.scm
+++ b/gnu/tests/docker.scm
@@ -1,7 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019 Danny Milosavljevic <dannym <at> scratchpost.org>
;;; Copyright © 2019-2023 Ludovic Courtès <ludo <at> gnu.org>
-;;; Copyright © 2024 Giacomo Leidi <goodoldpaul <at> autistici.org>
+;;; Copyright © 2024, 2025 Giacomo Leidi <goodoldpaul <at> autistici.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -414,71 +414,54 @@ (define (run-oci-container-test)
(test-runner-current (system-test-runner #$output))
(test-begin "oci-container")
- (test-assert "containerd service running"
- (marionette-eval
- '(begin
- (use-modules (gnu services herd))
- (match (start-service 'containerd)
- (#f #f)
- (('service response-parts ...)
- (match (assq-ref response-parts 'running)
- ((pid) pid)))))
- marionette))
-
- (test-assert "containerd PID file present"
- (wait-for-file "/run/containerd/containerd.pid" marionette))
-
- (test-assert "dockerd running"
- (marionette-eval
- '(begin
- (use-modules (gnu services herd))
- (match (start-service 'dockerd)
- (#f #f)
- (('service response-parts ...)
- (match (assq-ref response-parts 'running)
- ((pid) pid)))))
- marionette))
-
- (sleep 10) ; let service start
+ (wait-for-file "/run/containerd/containerd.pid" marionette)
(test-assert "docker-guile running"
(marionette-eval
'(begin
(use-modules (gnu services herd))
- (match (start-service 'docker-guile)
- (#f #f)
- (('service response-parts ...)
- (match (assq-ref response-parts 'running)
- ((pid) pid)))))
+ (wait-for-service 'docker-guile #:timeout 120)
+ #t)
marionette))
- (test-equal "passing host environment variables and volumes"
- '("value" "hello")
- (marionette-eval
- `(begin
- (use-modules (ice-9 popen)
- (ice-9 rdelim))
-
- (define slurp
- (lambda args
- (let* ((port (apply open-pipe* OPEN_READ args))
- (output (let ((line (read-line port)))
- (if (eof-object? line)
- ""
- line)))
- (status (close-pipe port)))
- output)))
- (let* ((response1 (slurp
- ,(string-append #$docker-cli "/bin/docker")
- "exec" "docker-guile"
- "/bin/guile" "-c" "(display (getenv \"VARIABLE\"))"))
- (response2 (slurp
- ,(string-append #$docker-cli "/bin/docker")
- "exec" "docker-guile"
- "/bin/guile" "-c" "(begin (use-modules (ice-9 popen) (ice-9 rdelim))
+ (test-assert "passing host environment variables and volumes"
+ (begin
+ (define (run-test)
+ (marionette-eval
+ `(begin
+ (use-modules (ice-9 popen)
+ (ice-9 rdelim))
+
+ (define slurp
+ (lambda args
+ (let* ((port (apply open-pipe* OPEN_READ args))
+ (output (let ((line (read-line port)))
+ (if (eof-object? line)
+ ""
+ line)))
+ (status (close-pipe port)))
+ output)))
+ (let* ((response1 (slurp
+ ,(string-append #$docker-cli "/bin/docker")
+ "exec" "docker-guile"
+ "/bin/guile" "-c" "(display (getenv \"VARIABLE\"))"))
+ (response2 (slurp
+ ,(string-append #$docker-cli "/bin/docker")
+ "exec" "docker-guile"
+ "/bin/guile" "-c" "(begin (use-modules (ice-9 popen) (ice-9 rdelim))
(display (call-with-input-file \"/shared.txt\" read-line)))")))
- (list response1 response2)))
- marionette))
+ (list response1 response2)))
+ marionette))
+ ;; Allow services to come up on slower machines
+ (let loop ((attempts 0))
+ (if (= attempts 60)
+ (error "Service didn't come up after more than 60 seconds")
+ (if (equal? '("value" "hello")
+ (run-test))
+ #t
+ (begin
+ (sleep 1)
+ (loop (+ 1 attempts))))))))
(test-end))))
--
2.48.1
guix-patches <at> gnu.org:bug#76081; Package guix-patches.
(Tue, 04 Mar 2025 12:40:02 GMT) Full text and rfc822 format available.Message #101 received at 76081 <at> debbugs.gnu.org (full text, mbox):
From: paul <goodoldpaul <at> autistici.org> To: 76081 <at> debbugs.gnu.org Subject: Re: OCI provisioning service Date: Tue, 4 Mar 2025 13:39:33 +0100
Hi, On 2/27/25 00:01, paul wrote: > Hi guix, > > On 2/18/25 02:20, paul wrote: >> Hi, >> >> On 2/12/25 02:09, paul wrote: >>> Hi guix, >>> >>> On 2/9/25 21:38, paul wrote: >>>> I'm sending a v3 fixing a bug in the merge algorithm for volumes >>>> and networks. >>>> >>>> On 2/9/25 20:14, paul wrote: >>>>> Hi, >>>>> >>>>> I'm about to send a v2. v2 compared to the first revision features: >>>>> >>>>> >>>>> - it actually compiles all the times :) (rev 1 referenced >>>>> oci-image too early for it to be working and generated a compile >>>>> time error, if you recompiled it sometimes went away so I thought >>>>> it was a problem of my setup. CI caught this) >>>>> - it allows more values to be overridden by eventual users of the >>>>> Scheme API >>>>> - it allows passing extra arguments directly after each podman or >>>>> docker invokation, allowing for example for overriding podman >>>>> --root and similar options. >>>>> >>>>> All of these tests should pass: >>>>> >>>>> guix shell -D guix -CPW -- make check-system TESTS="oci-container >>>>> oci-service-rootless-podman docker docker-system rootless-podman >>>>> oci-service-docker" >>>>> >>> I'm sending a v4 changing slightly the image loader, the same tests >>> as before are supposed to pass. Now the Home service [0] is working >>> for me with rootless podman. I'll try it on different distros if I >>> manage to. >> >> I'm sending a v5 implementing a Home service. The changes compared to >> v4 are pretty trivial as the plumbing was already there, the only >> downside is that I'm not able to use for-home? in >> define-configuration, so I had to reimplement oci-configuration with >> (guix records) and had to reimplement some validation (gnu services >> configuration) would figure out magically. > > I'm sending a v6. Compared to v5 it resolves the conflicts with > master and it should fix the stop action for rootless podman backed > services. I'm sending a v7 fixing the restart action for podman backed services. Thank you for your work, giacomo
ludo <at> gnu.org, maxim.cournoyer <at> gmail.com, guix-patches <at> gnu.org:bug#76081; Package guix-patches.
(Tue, 04 Mar 2025 12:42:01 GMT) Full text and rfc822 format available.Message #104 received at 76081 <at> debbugs.gnu.org (full text, mbox):
From: Giacomo Leidi <goodoldpaul <at> autistici.org> To: 76081 <at> debbugs.gnu.org Cc: Giacomo Leidi <goodoldpaul <at> autistici.org> Subject: [PATCH v7 3/5] services: Add oci-service-type. Date: Tue, 4 Mar 2025 13:40:00 +0100
This patch implements a generalization of the
oci-container-service-type, which consequently is made deprecated. The
oci-service-type, in addition to all the features from the
oci-container-service-type, can now provision OCI networks and volumes.
It only handles OCI objects creation, the user is supposed to handle
state once the objects are provsioned.
It currently supports two different OCI runtimes: Docker and rootless
Podman. Both runtimes are tested to make sure provisioned containers
can connect to each other through provisioned networks and can
read/write data with provisioned volumes.
At last the Scheme API is thought to facilitate the implementation of a
Guix Home service in the future.
* gnu/services/containers.scm (%oci-supported-runtimes): New variable;
(oci-runtime-cli): new variable;
(oci-runtime-name): new variable;
(oci-network-configuration): new variable;
(oci-volume-configuration): new variable;
(oci-configuration): new variable;
(oci-extension): new variable;
(oci-networks-shepherd-name): new variable;
(oci-service-type): new variable;
(oci-state->shepherd-services): new variable.
* doc/guix.texi: Document it.
* gnu/tests/containers.scm: Test it.
* gnu/services/docker.scm: Deprecate the oci-container-service-type.
Change-Id: I656b3db85832e42d53072fcbfb91d1226f39ef38
---
doc/guix.texi | 306 ++++++--
gnu/services/containers.scm | 1320 ++++++++++++++++++++++++++++++-----
gnu/services/docker.scm | 37 +-
gnu/tests/containers.scm | 999 +++++++++++++++++++++++++-
4 files changed, 2410 insertions(+), 252 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index 551bc52f7f6..be5c8cf8fad 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -42727,59 +42727,162 @@ Miscellaneous Services
@cindex OCI-backed, Shepherd services
@subsubheading OCI backed services
-Should you wish to manage your Docker containers with the same consistent
-interface you use for your other Shepherd services,
-@var{oci-container-service-type} is the tool to use: given an
-@acronym{Open Container Initiative, OCI} container image, it will run it in a
+Should you wish to manage your @acronym{Open Container Initiative, OCI} containers
+with the same consistent interface you use for your other Shepherd services,
+@var{oci-service-type} is the tool to use: given an
+OCI container image, it will run it in a
Shepherd service. One example where this is useful: it lets you run services
-that are available as Docker/OCI images but not yet packaged for Guix.
+that are available as OCI images but not yet packaged for Guix.
-@defvar oci-container-service-type
+@defvar oci-service-type
-This is a thin wrapper around Docker's CLI that executes OCI images backed
+This is a thin wrapper around Docker's or Podman's CLI that executes OCI images backed
processes as Shepherd Services.
@lisp
-(service oci-container-service-type
- (list
- (oci-container-configuration
- (network "host")
- (image
- (oci-image
- (repository "guile")
- (tag "3")
- (value (specifications->manifest '("guile")))
- (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile"))
- #:max-layers 2))))
- (entrypoint "/bin/guile")
- (command
- '("-c" "(display \"hello!\n\")")))
- (oci-container-configuration
- (image "prom/prometheus")
- (ports
- '(("9000" . "9000")
- ("9090" . "9090"))))
- (oci-container-configuration
- (image "grafana/grafana:10.0.1")
- (network "host")
- (volumes
- '("/var/lib/grafana:/var/lib/grafana")))))
+(simple-service 'oci-provisioning
+ oci-service-type
+ (oci-extension
+ (networks
+ (list
+ (oci-network-configuration (name "monitoring"))))
+ (containers
+ (list
+ (oci-container-configuration
+ (network "monitoring")
+ (image
+ (oci-image
+ (repository "guile")
+ (tag "3")
+ (value (specifications->manifest '("guile")))
+ (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile"))
+ #:max-layers 2))))
+ (entrypoint "/bin/guile")
+ (command
+ '("-c" "(display \"hello!\n\")")))
+ (oci-container-configuration
+ (image "prom/prometheus")
+ (network "host")
+ (ports
+ '(("9000" . "9000")
+ ("9090" . "9090"))))
+ (oci-container-configuration
+ (image "grafana/grafana:10.0.1")
+ (network "host")
+ (volumes
+ '("/var/lib/grafana:/var/lib/grafana")))))))
@end lisp
In this example three different Shepherd services are going to be added to the
system. Each @code{oci-container-configuration} record translates to a
-@code{docker run} invocation and its fields directly map to options. You can
-refer to the
-@url{https://docs.docker.com/engine/reference/commandline/run,upstream}
-documentation for the semantics of each value. If the images are not found,
-they will be
-@url{https://docs.docker.com/engine/reference/commandline/pull/,pulled}. The
+@command{docker run} or @command{podman run} invocation and its fields directly
+map to options. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html,Podman}
+upstream documentation for semantics of each value. If the images are not found,
+they will be pulled. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/pull/,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-pull.1.html,Podman}
+upstream documentation for semantics. The
services with @code{(network "host")} are going to be attached to the
host network and are supposed to behave like native processes with regard to
networking.
@end defvar
+@c %start of fragment
+
+@deftp {Data Type} oci-configuration
+Available @code{oci-configuration} fields are:
+
+@table @asis
+@item @code{runtime} (default: @code{'docker}) (type: symbol)
+The OCI runtime to use to run commands. It can be either @code{'docker} or
+@code{'podman}.
+
+@item @code{runtime-cli} (type: maybe-package-or-string)
+The OCI runtime command line to be installed in the system profile and used
+to provision OCI resources. When unset it will default to @code{docker-cli}
+package for the @code{'docker} runtime or to @code{podman} package for the
+@code{'podman} runtime. When a string is passed it will be interpreted as the
+absolute file-system path of the selected OCI runtime command.
+
+@item @code{runtime-extra-arguments} (default: @code{'()}) (type: list)
+A list of strings, gexps or file-like objects that will be placed
+after each @command{docker} or @command{podman} invokation.
+
+@item @code{user} (type: maybe-string)
+The user name under whose authority OCI commands will be run. This field will
+override the @code{user} field of @code{oci-configuration}.
+
+@item @code{group} (type: maybe-string)
+The group name under whose authority OCI commands will be run. When
+using the @code{'podman} OCI runtime, this field will be ignored and the
+default group of the user configured in the @code{user} field will be used.
+This field will override the @code{group} field of @code{oci-configuration}.
+
+@item @code{subuids-range} (type: maybe-subid-range)
+An optional @code{subid-range} record allocating subuids for the user from
+the @code{user} field. When unset, with the rootless Podman OCI runtime, it
+defaults to @code{(subid-range (name "oci-container"))}.
+
+@item @code{subgids-range} (type: maybe-subid-range)
+An optional @code{subid-range} record allocating subgids for the user from
+the @code{user} field. When unset, with the rootless Podman OCI runtime, it
+defaults to @code{(subid-range (name "oci-container"))}.
+
+@item @code{containers} (default: @code{'()}) (type: list-of-oci-containers)
+The list of @code{oci-container-configuration} records representing the
+containers to provision. Most users are supposed not to use this field and use
+the @code{oci-extension} record instead.
+
+@item @code{networks} (default: @code{'()}) (type: list-of-oci-networks)
+The list of @code{oci-network-configuration} records representing the
+containers to provision. Most users are supposed not to use this field and use
+the @code{oci-extension} record instead.
+
+@item @code{volumes} (default: @code{'()}) (type: list-of-oci-volumes)
+The list of @code{oci-volumes-configuration} records representing the
+containers to provision. Most users are supposed not to use this field and use
+the @code{oci-extension} record instead.
+
+@item @code{verbose?} (default: @code{#f}) (type: boolean)
+When true, additional output will be printed, allowing to better follow the
+flow of execution.
+
+@end table
+
+@end deftp
+
+
+@c %end of fragment
+
+@c %start of fragment
+
+@deftp {Data Type} oci-extension
+Available @code{oci-extension} fields are:
+
+@table @asis
+@item @code{containers} (default: @code{'()}) (type: list-of-oci-containers)
+The list of @code{oci-container-configuration} records representing the
+containers to provision.
+
+@item @code{networks} (default: @code{'()}) (type: list-of-oci-networks)
+The list of @code{oci-network-configuration} records representing the
+containers to provision.
+
+@item @code{volumes} (default: @code{'()}) (type: list-of-oci-volumes)
+The list of @code{oci-volumes-configuration} records representing the
+containers to provision.
+
+@end table
+
+@end deftp
+
+
+@c %end of fragment
+
+
@c %start of fragment
@deftp {Data Type} oci-container-configuration
@@ -42799,16 +42902,16 @@ Miscellaneous Services
Overwrite the default entrypoint (@code{ENTRYPOINT}) of the image.
@item @code{host-environment} (default: @code{'()}) (type: list)
-Set environment variables in the host environment where @command{docker
-run} is invoked. This is especially useful to pass secrets from the
-host to the container without having them on the @command{docker run}'s
-command line: by setting the @code{MYSQL_PASSWORD} on the host and by passing
+Set environment variables in the host environment where @command{docker run}
+or @command{podman run} are invoked. This is especially useful to pass secrets
+from the host to the container without having them on the OCI runtime command line,
+for example: by setting the @code{MYSQL_PASSWORD} on the host and by passing
@code{--env MYSQL_PASSWORD} through the @code{extra-arguments} field, it is
possible to securely set values in the container environment. This field's
value can be a list of pairs or strings, even mixed:
@lisp
-(list '("LANGUAGE\" . "eo:ca:eu")
+(list '("LANGUAGE" . "eo:ca:eu")
"JAVA_HOME=/opt/java")
@end lisp
@@ -42816,22 +42919,24 @@ Miscellaneous Services
directly to @code{make-forkexec-constructor}.
@item @code{environment} (default: @code{'()}) (type: list)
-Set environment variables. This can be a list of pairs or strings, even mixed:
+Set environment variables inside the container. This can be a list of pairs
+or strings, even mixed:
@lisp
(list '("LANGUAGE" . "eo:ca:eu")
"JAVA_HOME=/opt/java")
@end lisp
-Pair members can be strings, gexps or file-like objects.
-Strings are passed directly to the Docker CLI. You can refer to the
-@uref{https://docs.docker.com/engine/reference/commandline/run/#env,upstream}
-documentation for semantics.
+Pair members can be strings, gexps or file-like objects. Strings are passed
+directly to the OCI runtime CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#env,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#env-e-env,Podman}
+upstream documentation for semantics.
@item @code{image} (type: string-or-oci-image)
The image used to build the container. It can be a string or an
-@code{oci-image} record. Strings are resolved by the Docker Engine, and
-follow the usual format
+@code{oci-image} record. Strings are resolved by the OCI runtime,
+and follow the usual format
@code{myregistry.local:5000/testing/test-image:tag}.
@item @code{provision} (default: @code{""}) (type: string)
@@ -42859,7 +42964,7 @@ Miscellaneous Services
by the service.
@item @code{network} (default: @code{""}) (type: string)
-Set a Docker network for the spawned container.
+Set an OCI network for the spawned container.
@item @code{ports} (default: @code{'()}) (type: list)
Set the port or port ranges to expose from the spawned container. This can be a
@@ -42870,10 +42975,11 @@ Miscellaneous Services
"10443:443")
@end lisp
-Pair members can be strings, gexps or file-like objects.
-Strings are passed directly to the Docker CLI. You can refer to the
-@uref{https://docs.docker.com/engine/reference/commandline/run/#publish,upstream}
-documentation for semantics.
+Pair members can be strings, gexps or file-like objects. Strings are passed
+directly to the OCI runtime CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#publish,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#publish-p-ip-hostport-containerport-protocol,Podman}
+upstream documentation for semantics.
@item @code{volumes} (default: @code{'()}) (type: list)
Set volume mappings for the spawned container. This can be a
@@ -42884,25 +42990,97 @@ Miscellaneous Services
"/gnu/store:/gnu/store")
@end lisp
-Pair members can be strings, gexps or file-like objects.
-Strings are passed directly to the Docker CLI. You can refer to the
-@uref{https://docs.docker.com/engine/reference/commandline/run/#volume,upstream}
-documentation for semantics.
+Pair members can be strings, gexps or file-like objects. Strings are passed
+directly to the OCI runtime CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#volume,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#volume-v-source-volume-host-dir-container-dir-options,Podman}
+upstream documentation for semantics.
@item @code{container-user} (default: @code{""}) (type: string)
Set the current user inside the spawned container. You can refer to the
-@url{https://docs.docker.com/engine/reference/run/#user,upstream}
-documentation for semantics.
+@url{https://docs.docker.com/engine/reference/run/#user,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#user-u-user-group,Podman}
+upstream documentation for semantics.
@item @code{workdir} (default: @code{""}) (type: string)
Set the current working directory for the spawned Shepherd service.
You can refer to the
-@url{https://docs.docker.com/engine/reference/run/#workdir,upstream}
-documentation for semantics.
+@url{https://docs.docker.com/engine/reference/run/#workdir,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#workdir-w-dir,Podman}
+upstream documentation for semantics.
+
+@item @code{extra-arguments} (default: @code{'()}) (type: list)
+A list of strings, gexps or file-like objects that will be directly passed
+to the @command{docker run} or @command{podman run} invokation.
+
+@end table
+
+@end deftp
+
+
+@c %end of fragment
+
+@c %start of fragment
+
+@deftp {Data Type} oci-network-configuration
+Available @code{oci-network-configuration} fields are:
+
+@table @asis
+@item @code{name} (type: string)
+The name of the OCI network to provision.
+
+@item @code{driver} (type: maybe-string)
+The driver to manage the network.
+
+@item @code{gateway} (type: maybe-string)
+IPv4 or IPv6 gateway for the subnet.
+
+@item @code{internal?} (default: @code{#f}) (type: boolean)
+Restrict external access to the network
+
+@item @code{ip-range} (type: maybe-string)
+Allocate container ip from a sub-range in CIDR format.
+
+@item @code{ipam-driver} (type: maybe-string)
+IP Address Management Driver.
+
+@item @code{ipv6?} (default: @code{#f}) (type: boolean)
+Enable IPv6 networking.
+
+@item @code{subnet} (type: maybe-string)
+Subnet in CIDR format that represents a network segment.
+
+@item @code{labels} (default: @code{'()}) (type: list)
+The list of labels that will be used to tag the current volume.
+
+@item @code{extra-arguments} (default: @code{'()}) (type: list)
+A list of strings, gexps or file-like objects that will be directly passed
+to the @command{docker network create} or @command{podman network create}
+invokation.
+
+@end table
+
+@end deftp
+
+
+@c %end of fragment
+
+@c %start of fragment
+
+@deftp {Data Type} oci-volume-configuration
+Available @code{oci-volume-configuration} fields are:
+
+@table @asis
+@item @code{name} (type: string)
+The name of the OCI volume to provision.
+
+@item @code{labels} (default: @code{'()}) (type: list)
+The list of labels that will be used to tag the current volume.
@item @code{extra-arguments} (default: @code{'()}) (type: list)
-A list of strings, gexps or file-like objects that will be directly
-passed to the @command{docker run} invocation.
+A list of strings, gexps or file-like objects that will be directly passed
+to the @command{docker volume create} or @command{podman volume create}
+invokation.
@end table
diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm
index 24f31c756b8..4600846ac3d 100644
--- a/gnu/services/containers.scm
+++ b/gnu/services/containers.scm
@@ -39,8 +39,10 @@ (define-module (gnu services containers)
#:use-module (guix packages)
#:use-module (guix profiles)
#:use-module ((guix scripts pack) #:prefix pack:)
+ #:use-module (guix records)
#:use-module (guix store)
#:use-module (srfi srfi-1)
+ #:use-module (ice-9 format)
#:use-module (ice-9 match)
#:export (rootless-podman-configuration
rootless-podman-configuration?
@@ -96,8 +98,80 @@ (define-module (gnu services containers)
oci-container-configuration-workdir
oci-container-configuration-extra-arguments
+ list-of-oci-containers?
+ list-of-oci-networks?
+ list-of-oci-volumes?
+
+ %oci-supported-runtimes
+ oci-sanitize-runtime
+ oci-runtime-system-environment
+ oci-runtime-system-extra-arguments
+ oci-runtime-system-group
+ oci-runtime-system-requirement
+ oci-runtime-cli
+ oci-runtime-system-cli
+ oci-runtime-home-cli
+ oci-runtime-name
+ oci-runtime-group
+
+ oci-network-configuration
+ oci-network-configuration?
+ oci-network-configuration-fields
+ oci-network-configuration-name
+ oci-network-configuration-driver
+ oci-network-configuration-gateway
+ oci-network-configuration-internal?
+ oci-network-configuration-ip-range
+ oci-network-configuration-ipam-driver
+ oci-network-configuration-ipv6?
+ oci-network-configuration-subnet
+ oci-network-configuration-labels
+ oci-network-configuration-extra-arguments
+
+ oci-volume-configuration
+ oci-volume-configuration?
+ oci-volume-configuration-fields
+ oci-volume-configuration-name
+ oci-volume-configuration-labels
+ oci-volume-configuration-extra-arguments
+
+ oci-configuration
+ oci-configuration?
+ oci-configuration-runtime
+ oci-configuration-runtime-cli
+ oci-configuration-runtime-extra-arguments
+ oci-configuration-user
+ oci-configuration-group
+ oci-configuration-containers
+ oci-configuration-networks
+ oci-configuration-volumes
+ oci-configuration-verbose?
+ oci-configuration-valid?
+
+ oci-extension
+ oci-extension?
+ oci-extension-fields
+ oci-extension-containers
+ oci-extension-networks
+ oci-extension-volumes
+
+ oci-container-shepherd-name
+ oci-networks-shepherd-name
+ oci-networks-home-shepherd-name
+ oci-volumes-shepherd-name
+ oci-volumes-home-shepherd-name
+
oci-container-shepherd-service
- %oci-container-accounts))
+ oci-objects-merge-lst
+ oci-extension-merge
+ oci-service-extension-wrap-validate
+ oci-service-type
+ oci-service-accounts
+ oci-service-profile
+ oci-service-subids
+ oci-state->shepherd-services
+ oci-configuration->shepherd-services
+ oci-configuration-extend))
(define (gexp-or-string? value)
(or (gexp? value)
@@ -296,9 +370,42 @@ (define rootless-podman-service-type
;;;
-;;; OCI container.
+;;; OCI provisioning service.
;;;
+(define %oci-supported-runtimes
+ '(docker podman))
+
+(define (oci-runtime-system-requirement runtime)
+ "Return a list of Shepherd service names required by a given OCI runtime,
+before it is able to run containers."
+ (if (eq? 'podman runtime)
+ '(cgroups2-fs-owner cgroups2-limits
+ rootless-podman-shared-root-fs user-processes)
+ '(dockerd user-processes)))
+
+(define (oci-runtime-name runtime)
+ "Return a human readable name for a given OCI runtime."
+ (if (eq? 'podman runtime)
+ "Podman" "Docker"))
+
+(define (oci-runtime-group runtime maybe-group)
+ "Implement the logic behind selection of the group that is to be used by
+Shepherd to execute OCI commands."
+ (if (eq? maybe-group #f)
+ (if (eq? 'podman runtime)
+ "cgroup"
+ "docker")
+ maybe-group))
+
+(define (oci-sanitize-runtime value)
+ (unless (member value %oci-supported-runtimes)
+ (raise
+ (formatted-message
+ (G_ "OCI runtime must be a symbol and one of ~a,
+but ~a was found") %oci-supported-runtimes value)))
+ value)
+
(define (oci-sanitize-pair pair delimiter)
(define (valid? member)
(or (string? member)
@@ -347,6 +454,11 @@ (define (oci-sanitize-volumes value)
;; '(("/mnt/dir" . "/dir") "/run/current-system/profile:/java")
(oci-sanitize-mixed-list "volumes" value ":"))
+(define (oci-sanitize-labels value)
+ ;; Expected spec format:
+ ;; '(("foo" . "bar") "foo=bar")
+ (oci-sanitize-mixed-list "labels" value "="))
+
(define (oci-sanitize-shepherd-actions value)
(map
(lambda (el)
@@ -374,10 +486,15 @@ (define (oci-sanitize-extra-arguments value)
value))
(define (oci-image-reference image)
- (if (string? image)
- image
- (string-append (oci-image-repository image)
- ":" (oci-image-tag image))))
+ "Return a string OCI image reference representing IMAGE."
+ (define reference
+ (if (string? image)
+ image
+ (string-append (oci-image-repository image)
+ ":" (oci-image-tag image))))
+ (if (> (length (string-split reference #\/)) 1)
+ reference
+ (string-append "localhost/" reference)))
(define (oci-lowerable-image? image)
(or (manifest? image)
@@ -392,7 +509,19 @@ (define (string-or-oci-image? image)
(define list-of-symbols?
(list-of symbol?))
+(define (list-of-oci-records? name predicate value)
+ (map
+ (lambda (el)
+ (if (predicate el)
+ el
+ (raise
+ (formatted-message
+ (G_ "~a contains an illegal value: ~a") name el))))
+ value))
+
(define-maybe/no-serialization string)
+(define-maybe/no-serialization package)
+(define-maybe/no-serialization subid-range)
(define-configuration/no-serialization oci-image
(repository
@@ -437,11 +566,15 @@ (define-configuration/no-serialization oci-image
(define-configuration/no-serialization oci-container-configuration
(user
- (string "oci-container")
- "The user under whose authority docker commands will be run.")
+ (maybe-string)
+ "The user name under whose authority OCI commands will be run. This field will
+override the @code{user} field of @code{oci-configuration}.")
(group
- (string "docker")
- "The group under whose authority docker commands will be run.")
+ (maybe-string)
+ "The group name under whose authority OCI commands will be run. When
+using the @code{'podman} OCI runtime, this field will be ignored and the
+default group of the user configured in the @code{user} field will be used.
+This field will override the @code{group} field of @code{oci-configuration}.")
(command
(list-of-strings '())
"Overwrite the default command (@code{CMD}) of the image.")
@@ -451,9 +584,9 @@ (define-configuration/no-serialization oci-container-configuration
(host-environment
(list '())
"Set environment variables in the host environment where @command{docker run}
-is invoked. This is especially useful to pass secrets from the host to the
-container without having them on the @command{docker run}'s command line: by
-setting the @code{MYSQL_PASSWORD} on the host and by passing
+or @command{podman run} are invoked. This is especially useful to pass secrets
+from the host to the container without having them on the OCI runtime command line,
+for example: by setting the @code{MYSQL_PASSWORD} on the host and by passing
@code{--env MYSQL_PASSWORD} through the @code{extra-arguments} field, it is
possible to securely set values in the container environment. This field's
value can be a list of pairs or strings, even mixed:
@@ -477,15 +610,16 @@ (define-configuration/no-serialization oci-container-configuration
@end lisp
Pair members can be strings, gexps or file-like objects. Strings are passed
-directly to the Docker CLI. You can refer to the
-@url{https://docs.docker.com/engine/reference/commandline/run/#env,upstream}
-documentation for semantics."
+directly to the OCI runtime CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#env,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#env-e-env,Podman}
+upstream documentation for semantics."
(sanitizer oci-sanitize-environment))
(image
(string-or-oci-image)
"The image used to build the container. It can be a string or an
-@code{oci-image} record. Strings are resolved by the Docker
-Engine, and follow the usual format
+@code{oci-image} record. Strings are resolved by the OCI runtime,
+and follow the usual format
@code{myregistry.local:5000/testing/test-image:tag}.")
(provision
(maybe-string)
@@ -514,7 +648,7 @@ (define-configuration/no-serialization oci-container-configuration
(sanitizer oci-sanitize-shepherd-actions))
(network
(maybe-string)
- "Set a Docker network for the spawned container.")
+ "Set an OCI network for the spawned container.")
(ports
(list '())
"Set the port or port ranges to expose from the spawned container. This can
@@ -526,9 +660,10 @@ (define-configuration/no-serialization oci-container-configuration
@end lisp
Pair members can be strings, gexps or file-like objects. Strings are passed
-directly to the Docker CLI. You can refer to the
-@url{https://docs.docker.com/engine/reference/commandline/run/#publish,upstream}
-documentation for semantics."
+directly to the OCI runtime CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#publish,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#publish-p-ip-hostport-containerport-protocol,Podman}
+upstream documentation for semantics."
(sanitizer oci-sanitize-ports))
(volumes
(list '())
@@ -541,71 +676,363 @@ (define-configuration/no-serialization oci-container-configuration
@end lisp
Pair members can be strings, gexps or file-like objects. Strings are passed
-directly to the Docker CLI. You can refer to the
-@url{https://docs.docker.com/engine/reference/commandline/run/#volume,upstream}
-documentation for semantics."
+directly to the OCI runtime CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#volume,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#volume-v-source-volume-host-dir-container-dir-options,Podman}
+upstream documentation for semantics."
(sanitizer oci-sanitize-volumes))
(container-user
(maybe-string)
"Set the current user inside the spawned container. You can refer to the
-@url{https://docs.docker.com/engine/reference/run/#user,upstream}
-documentation for semantics.")
+@url{https://docs.docker.com/engine/reference/run/#user,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#user-u-user-group,Podman}
+upstream documentation for semantics.")
(workdir
(maybe-string)
- "Set the current working for the spawned Shepherd service.
+ "Set the current working directory for the spawned Shepherd service.
You can refer to the
-@url{https://docs.docker.com/engine/reference/run/#workdir,upstream}
-documentation for semantics.")
+@url{https://docs.docker.com/engine/reference/run/#workdir,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#workdir-w-dir,Podman}
+upstream documentation for semantics.")
(extra-arguments
(list '())
"A list of strings, gexps or file-like objects that will be directly passed
-to the @command{docker run} invokation."
+to the @command{docker run} or @command{podman run} invocation."
(sanitizer oci-sanitize-extra-arguments)))
-(define oci-container-configuration->options
- (lambda (config)
- (let ((entrypoint
- (oci-container-configuration-entrypoint config))
- (network
- (oci-container-configuration-network config))
- (user
- (oci-container-configuration-container-user config))
- (workdir
- (oci-container-configuration-workdir config)))
- (apply append
- (filter (compose not unspecified?)
- `(,(if (maybe-value-set? entrypoint)
- `("--entrypoint" ,entrypoint)
- '())
- ,(append-map
- (lambda (spec)
- (list "--env" spec))
- (oci-container-configuration-environment config))
- ,(if (maybe-value-set? network)
- `("--network" ,network)
- '())
- ,(if (maybe-value-set? user)
- `("--user" ,user)
- '())
- ,(if (maybe-value-set? workdir)
- `("--workdir" ,workdir)
- '())
- ,(append-map
- (lambda (spec)
- (list "-p" spec))
- (oci-container-configuration-ports config))
- ,(append-map
- (lambda (spec)
- (list "-v" spec))
- (oci-container-configuration-volumes config))))))))
-
-(define* (get-keyword-value args keyword #:key (default #f))
- (let ((kv (memq keyword args)))
- (if (and kv (>= (length kv) 2))
- (cadr kv)
- default)))
+(define (list-of-oci-containers? value)
+ (list-of-oci-records? "containers" oci-container-configuration? value))
+
+(define-configuration/no-serialization oci-volume-configuration
+ (name
+ (string)
+ "The name of the OCI volume to provision.")
+ (labels
+ (list '())
+ "The list of labels that will be used to tag the current volume."
+ (sanitizer oci-sanitize-labels))
+ (extra-arguments
+ (list '())
+ "A list of strings, gexps or file-like objects that will be directly passed
+to the @command{docker volume create} or @command{podman volume create}
+invocation."
+ (sanitizer oci-sanitize-extra-arguments)))
+
+(define (list-of-oci-volumes? value)
+ (list-of-oci-records? "volumes" oci-volume-configuration? value))
+
+(define-configuration/no-serialization oci-network-configuration
+ (name
+ (string)
+ "The name of the OCI network to provision.")
+ (driver
+ (maybe-string)
+ "The driver to manage the network.")
+ (gateway
+ (maybe-string)
+ "IPv4 or IPv6 gateway for the subnet.")
+ (internal?
+ (boolean #f)
+ "Restrict external access to the network")
+ (ip-range
+ (maybe-string)
+ "Allocate container ip from a sub-range in CIDR format.")
+ (ipam-driver
+ (maybe-string)
+ "IP Address Management Driver.")
+ (ipv6?
+ (boolean #f)
+ "Enable IPv6 networking.")
+ (subnet
+ (maybe-string)
+ "Subnet in CIDR format that represents a network segment.")
+ (labels
+ (list '())
+ "The list of labels that will be used to tag the current volume."
+ (sanitizer oci-sanitize-labels))
+ (extra-arguments
+ (list '())
+ "A list of strings, gexps or file-like objects that will be directly passed
+to the @command{docker network create} or @command{podman network create}
+invocation."
+ (sanitizer oci-sanitize-extra-arguments)))
+
+(define (list-of-oci-networks? value)
+ (list-of-oci-records? "networks" oci-network-configuration? value))
+
+(define-record-type* <oci-configuration>
+ oci-configuration
+ make-oci-configuration
+ oci-configuration?
+ this-oci-configuration
+
+ (runtime oci-configuration-runtime
+ (default 'docker))
+ (runtime-cli oci-configuration-runtime-cli
+ (default #f)) ; package or string
+ (runtime-extra-arguments oci-configuration-runtime-extra-arguments ; strings or gexps
+ (default '())) ; or file-like objects
+ (user oci-configuration-user
+ (default "oci-container"))
+ (group oci-configuration-group ; string
+ (default #f))
+ (subuids-range oci-configuration-subuids-range ; subid-range
+ (default #f))
+ (subgids-range oci-configuration-subgids-range ; subid-range
+ (default #f))
+ (containers oci-configuration-containers ; oci-container-configurations
+ (default '()))
+ (networks oci-configuration-networks ; oci-network-configurations
+ (default '()))
+ (volumes oci-configuration-volumes ; oci-volume-configurations
+ (default '()))
+ (verbose? oci-configuration-verbose?
+ (default #f))
+ (home-service? oci-configuration-home-service?
+ (default for-home?) (innate)))
+
+(define (package-or-string? value)
+ (or (package? value) (string? value)))
+
+(define (oci-configuration-valid? config)
+ (define runtime-cli
+ (oci-configuration-runtime-cli config))
+ (define group
+ (oci-configuration-group config))
+ (define subuids-range
+ (oci-configuration-subuids-range config))
+ (define subgids-range
+ (oci-configuration-subgids-range config))
+ (and
+ (symbol?
+ (oci-sanitize-runtime (oci-configuration-runtime config)))
+ (or (eq? runtime-cli #f)
+ (package-or-string? runtime-cli))
+ (list? (oci-configuration-runtime-extra-arguments config))
+ (string? (oci-configuration-user config))
+ (or (eq? group #f)
+ (string? group))
+ (or (eq? subuids-range #f)
+ (subid-range? subuids-range))
+ (or (eq? subgids-range #f)
+ (subid-range? subgids-range))
+ (list-of-oci-containers?
+ (oci-configuration-containers config))
+ (list-of-oci-networks?
+ (oci-configuration-networks config))
+ (list-of-oci-volumes?
+ (oci-configuration-volumes config))
+ (boolean?
+ (oci-configuration-verbose? config))
+ (boolean?
+ (oci-configuration-home-service? config))))
+
+(define (oci-runtime-system-environment runtime user)
+ (if (eq? runtime 'podman)
+ (list
+ #~(string-append
+ "HOME=" (passwd:dir (getpwnam #$user))))
+ #~()))
+
+(define (oci-runtime-system-group runtime user group)
+ (if (eq? runtime 'podman)
+ #~(group:name
+ (getgrgid
+ (passwd:gid
+ (getpwnam #$user))))
+ group))
+
+(define (oci-runtime-cli runtime runtime-cli path)
+ "Return a gexp that, when lowered, evaluates to the file system path of the OCI
+runtime command requested by the user."
+ (if (string? runtime-cli)
+ ;; It is a user defined absolute path
+ runtime-cli
+ #~(string-append
+ #$(if (eq? runtime-cli #f)
+ path
+ runtime-cli)
+ #$(if (eq? 'podman runtime)
+ "/bin/podman"
+ "/bin/docker"))))
+
+(define* (oci-runtime-system-cli config #:key (path "/run/current-system/profile"))
+ (let ((runtime-cli
+ (oci-configuration-runtime-cli config))
+ (runtime
+ (oci-configuration-runtime config)))
+ (oci-runtime-cli runtime runtime-cli path)))
+
+(define (oci-runtime-home-cli config)
+ (let ((runtime-cli
+ (oci-configuration-runtime-cli config))
+ (runtime
+ (oci-configuration-runtime config)))
+ (oci-runtime-cli runtime runtime-cli
+ (string-append (getenv "HOME")
+ "/.guix-home/profile"))))
+
+(define-configuration/no-serialization oci-extension
+ (containers
+ (list-of-oci-containers '())
+ "The list of @code{oci-container-configuration} records representing the
+containers to add.")
+ (networks
+ (list-of-oci-networks '())
+ "The list of @code{oci-network-configuration} records representing the
+networks to add.")
+ (volumes
+ (list-of-oci-volumes '())
+ "The list of @code{oci-volume-configuration} records representing the
+volumes to add."))
+
+(define (oci-image->container-name image)
+ "Infer the name of an OCI backed Shepherd service from its OCI image."
+ (basename
+ (if (string? image)
+ (first (string-split image #\:))
+ (oci-image-repository image))))
+
+(define (oci-object-command-shepherd-action object-name invocation)
+ "Return a Shepherd action printing a given INVOCATION of an OCI command for the
+given OBJECT-NAME."
+ (shepherd-action
+ (name 'command-line)
+ (documentation
+ (format #f "Prints ~a's OCI runtime command line invocation."
+ object-name))
+ (procedure
+ #~(lambda _
+ (format #t "~a~%" #$invocation)))))
+
+(define (oci-container-shepherd-name runtime config)
+ "Return the name of an OCI backed Shepherd service based on CONFIG.
+The name configured in the configuration record is returned when
+CONFIG's name field has a value, otherwise a name is inferred from CONFIG's
+image field."
+ (define name (oci-container-configuration-provision config))
+ (define image (oci-container-configuration-image config))
+
+ (if (maybe-value-set? name)
+ name
+ (string-append (symbol->string runtime) "-"
+ (oci-image->container-name image))))
+
+(define (oci-networks-shepherd-name runtime)
+ "Return the name of the OCI networks provisioning Shepherd service based on
+RUNTIME."
+ (string-append (symbol->string runtime) "-networks"))
+
+(define (oci-volumes-shepherd-name runtime)
+ "Return the name of the OCI volumes provisioning Shepherd service based on
+RUNTIME."
+ (string-append (symbol->string runtime) "-volumes"))
+
+(define (oci-networks-home-shepherd-name runtime)
+ "Return the name of the OCI volumes provisioning Home Shepherd service based on
+RUNTIME."
+ (string-append "home-" (oci-networks-shepherd-name runtime)))
+
+(define (oci-volumes-home-shepherd-name runtime)
+ "Return the name of the OCI volumes provisioning Home Shepherd service based on
+RUNTIME."
+ (string-append "home-" (oci-volumes-shepherd-name runtime)))
+
+(define (oci-container-configuration->options config)
+ "Map CONFIG, an oci-container-configuration record, to a gexp that, upon
+lowering, will be evaluated to a list of strings containing command line options
+for the OCI runtime run command."
+ (let ((entrypoint
+ (oci-container-configuration-entrypoint config))
+ (network
+ (oci-container-configuration-network config))
+ (user
+ (oci-container-configuration-container-user config))
+ (workdir
+ (oci-container-configuration-workdir config)))
+ (apply append
+ (filter (compose not unspecified?)
+ `(,(if (maybe-value-set? entrypoint)
+ `("--entrypoint" ,entrypoint)
+ '())
+ ,(append-map
+ (lambda (spec)
+ (list "--env" spec))
+ (oci-container-configuration-environment config))
+ ,(if (maybe-value-set? network)
+ `("--network" ,network)
+ '())
+ ,(if (maybe-value-set? user)
+ `("--user" ,user)
+ '())
+ ,(if (maybe-value-set? workdir)
+ `("--workdir" ,workdir)
+ '())
+ ,(append-map
+ (lambda (spec)
+ (list "-p" spec))
+ (oci-container-configuration-ports config))
+ ,(append-map
+ (lambda (spec)
+ (list "-v" spec))
+ (oci-container-configuration-volumes config)))))))
+
+(define (oci-network-configuration->options config)
+ "Map CONFIG, an oci-network-configuration record, to a gexp that, upon
+lowering, will be evaluated to a list of strings containing command line options
+for the OCI runtime network create command."
+ (let ((driver (oci-network-configuration-driver config))
+ (gateway
+ (oci-network-configuration-gateway config))
+ (internal?
+ (oci-network-configuration-internal? config))
+ (ip-range
+ (oci-network-configuration-ip-range config))
+ (ipam-driver
+ (oci-network-configuration-ipam-driver config))
+ (ipv6?
+ (oci-network-configuration-ipv6? config))
+ (subnet
+ (oci-network-configuration-subnet config)))
+ (apply append
+ (filter (compose not unspecified?)
+ `(,(if (maybe-value-set? driver)
+ `("--driver" ,driver)
+ '())
+ ,(if (maybe-value-set? gateway)
+ `("--gateway" ,gateway)
+ '())
+ ,(if internal?
+ `("--internal")
+ '())
+ ,(if (maybe-value-set? ip-range)
+ `("--ip-range" ,ip-range)
+ '())
+ ,(if (maybe-value-set? ipam-driver)
+ `("--ipam-driver" ,ipam-driver)
+ '())
+ ,(if ipv6?
+ `("--ipv6")
+ '())
+ ,(if (maybe-value-set? subnet)
+ `("--subnet" ,subnet)
+ '())
+ ,(append-map
+ (lambda (spec)
+ (list "--label" spec))
+ (oci-network-configuration-labels config)))))))
+
+(define (oci-volume-configuration->options config)
+ "Map CONFIG, an oci-volume-configuration record, to a gexp that, upon
+lowering, will be evaluated to a list of strings containing command line options
+for the OCI runtime volume create command."
+ (append-map
+ (lambda (spec)
+ (list "--label" spec))
+ (oci-volume-configuration-labels config)))
(define (lower-operating-system os target system)
+ "Lower OS, an operating-system record, into a tarball containing an OCI image."
(mlet* %store-monad
((tarball
(lower-object
@@ -614,24 +1041,11 @@ (define (lower-operating-system os target system)
#:target target)))
(return tarball)))
-(define (lower-manifest name image target system)
- (define value (oci-image-value image))
- (define options (oci-image-pack-options image))
- (define image-reference
- (oci-image-reference image))
- (define image-tag
- (let* ((extra-options
- (get-keyword-value options #:extra-options))
- (image-tag-option
- (and extra-options
- (get-keyword-value extra-options #:image-tag))))
- (if image-tag-option
- '()
- `(#:extra-options (#:image-tag ,image-reference)))))
-
+(define (lower-manifest name value options image-reference
+ target system grafts?)
+ "Lower VALUE, a manifest record, into a tarball containing an OCI image."
(mlet* %store-monad
- ((_ (set-grafting
- (oci-image-grafts? image)))
+ ((_ (set-grafting grafts?))
(guile (set-guile-for-build (default-guile)))
(profile
(profile-derivation value
@@ -642,14 +1056,11 @@ (define (lower-manifest name image target system)
(tarball (apply pack:docker-image
`(,name ,profile
,@options
- ,@image-tag
#:localstatedir? #t))))
(return tarball)))
-(define (lower-oci-image name image)
- (define value (oci-image-value image))
- (define image-target (oci-image-target image))
- (define image-system (oci-image-system image))
+(define (lower-oci-image-state name value options reference
+ image-target image-system grafts?)
(define target
(if (maybe-value-set? image-target)
image-target
@@ -662,7 +1073,8 @@ (define (lower-oci-image name image)
(run-with-store store
(match value
((? manifest? value)
- (lower-manifest name image target system))
+ (lower-manifest name value options reference
+ target system grafts?))
((? operating-system? value)
(lower-operating-system value target system))
((or (? gexp? value)
@@ -677,113 +1089,671 @@ (define (lower-oci-image name image)
#:target target
#:system system)))
-(define (%oci-image-loader name image tag)
- (let ((docker (file-append docker-cli "/bin/docker"))
- (tarball (lower-oci-image name image)))
+(define (lower-oci-image name image)
+ "Lower IMAGE, a oci-image record, into a tarball containing an OCI image."
+ (lower-oci-image-state
+ name
+ (oci-image-value image)
+ (oci-image-pack-options image)
+ (oci-image-reference image)
+ (oci-image-target image)
+ (oci-image-system image)
+ (oci-image-grafts? image)))
+
+(define (oci-object-exists? runtime runtime-cli object verbose?)
+ #~(lambda* (name #:key (format-string "{{.Name}}"))
+ (use-modules (ice-9 format)
+ (ice-9 match)
+ (ice-9 popen)
+ (ice-9 rdelim)
+ (srfi srfi-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)))
+
+ #$(if (eq? runtime 'podman)
+ #~(let ((command
+ (list #$runtime-cli
+ #$object "exists" name)))
+ (when #$verbose?
+ (format #t "Running~{ ~a~}~%" command))
+ (define exit-code (status:exit-val (apply system* command)))
+ (when #$verbose?
+ (format #t "Exit code: ~a~%" exit-code))
+ (equal? EXIT_SUCCESS exit-code))
+ #~(let ((command
+ (string-append #$runtime-cli
+ " " #$object " ls --format "
+ "\"" format-string "\"")))
+ (when #$verbose?
+ (format #t "Running ~a~%" command))
+ (member name (read-lines (open-input-pipe command)))))))
+
+(define* (oci-image-loader runtime runtime-cli name image tag #:key (verbose? #f))
+ "Return a file-like object that, once lowered, will evaluate to a program able
+to load IMAGE through RUNTIME-CLI and to tag it with TAG afterwards."
+ (let ((tarball (lower-oci-image name image)))
(with-imported-modules '((guix build utils))
- (program-file (format #f "~a-image-loader" name)
+ (program-file
+ (format #f "~a-image-loader" name)
#~(begin
(use-modules (guix build utils)
+ (ice-9 match)
(ice-9 popen)
- (ice-9 rdelim))
-
- (format #t "Loading image for ~a from ~a...~%" #$name #$tarball)
- (define line
- (read-line
- (open-input-pipe
- (string-append #$docker " load -i " #$tarball))))
-
- (unless (or (eof-object? line)
- (string-null? line))
- (format #t "~a~%" line)
- (let ((repository&tag
- (string-drop line
- (string-length
- "Loaded image: "))))
-
- (invoke #$docker "tag" repository&tag #$tag)
- (format #t "Tagged ~a with ~a...~%" #$tarball #$tag))))))))
-
-(define (oci-container-shepherd-service config)
- (define (guess-name name image)
- (if (maybe-value-set? name)
- name
- (string-append "docker-"
- (basename
- (if (string? image)
- (first (string-split image #\:))
- (oci-image-repository image))))))
-
- (let* ((docker (file-append docker-cli "/bin/docker"))
- (actions (oci-container-configuration-shepherd-actions config))
+ (ice-9 rdelim)
+ (srfi srfi-1))
+ (define object-exists?
+ #$(oci-object-exists? runtime runtime-cli "image" verbose?))
+ (define load-command
+ (string-append #$runtime-cli
+ " load -i " #$tarball))
+
+ (if (object-exists? #$tag #:format-string "{{.Repository}}:{{.Tag}}")
+ (format #t "~a image already exists, skipping.~%" #$tag)
+ (begin
+ (format #t "Loading image for ~a from ~a...~%" #$name #$tarball)
+ (when #$verbose?
+ (format #t "Running ~a~%" load-command))
+ (let ((line (read-line
+ (open-input-pipe load-command))))
+ (unless (or (eof-object? line)
+ (string-null? line))
+ (format #t "~a~%" line)
+ (let* ((repository&tag
+ (string-drop line
+ (string-length
+ "Loaded image: ")))
+ (tag-command
+ (list #$runtime-cli "tag" repository&tag #$tag))
+ (drop-old-tag-command
+ (list #$runtime-cli "image" "rm" "-f" repository&tag)))
+
+ (unless (string=? repository&tag #$tag)
+ (when #$verbose?
+ (format #t "Running~{ ~a~}~%" tag-command))
+
+ (let ((exit-code
+ (status:exit-val (apply system* tag-command))))
+ (format #t "Tagged ~a with ~a...~%" #$tarball #$tag)
+
+ (when #$verbose?
+ (format #t "Exit code: ~a~%" exit-code))
+
+ (when (equal? EXIT_SUCCESS exit-code)
+ (when #$verbose?
+ (format #t "Running~{ ~a~}~%" drop-old-tag-command))
+ (let ((drop-exit-code
+ (status:exit-val (apply system* drop-old-tag-command))))
+ (when #$verbose?
+ (format #t "Exit code: ~a~%" drop-exit-code))))))))))))))))
+
+(define (oci-container-run-invocation runtime runtime-cli name command image-reference
+ options runtime-extra-arguments run-extra-arguments)
+ "Return a list representing the OCI runtime
+invocation for running containers."
+ ;; run [OPTIONS] IMAGE [COMMAND] [ARG...]
+ `(,runtime-cli ,@runtime-extra-arguments "run" "--rm"
+ ,@(if (eq? runtime 'podman)
+ ;; This is because podman takes some time to
+ ;; release container names. --replace seems
+ ;; to be required to be able to restart services.
+ '("--replace")
+ '())
+ "--name" ,name
+ ,@options ,@run-extra-arguments
+ ,image-reference ,@command))
+
+(define* (oci-container-entrypoint runtime runtime-cli name image image-reference
+ invocation #:key (verbose? #f))
+ "Return a file-like object that, once lowered, will evaluate to the entrypoint
+for the Shepherd service that will run IMAGE through RUNTIME-CLI."
+ (program-file
+ (string-append "oci-entrypoint-" name)
+ #~(begin
+ (use-modules (ice-9 format)
+ (srfi srfi-1))
+ (when #$verbose?
+ (format #t "Running in verbose mode...~%"))
+ (define invocation (list #$@invocation))
+ #$@(if (oci-image? image)
+ #~((system*
+ #$(oci-image-loader
+ runtime runtime-cli name image
+ image-reference #:verbose? verbose?)))
+ #~())
+ (when #$verbose?
+ (format #t "Running~{ ~a~}~%" invocation))
+ (apply execlp `(,(first invocation) ,@invocation)))))
+
+(define* (oci-container-shepherd-service runtime runtime-cli config
+ #:key
+ (runtime-environment #~())
+ (runtime-extra-arguments '())
+ (oci-requirement '())
+ (user #f)
+ (group #f)
+ (verbose? #f))
+ "Return a Shepherd service object that will run the OCI container represented
+by CONFIG through RUNTIME-CLI."
+ (let* ((actions (oci-container-configuration-shepherd-actions config))
(auto-start?
(oci-container-configuration-auto-start? config))
- (user (oci-container-configuration-user config))
- (group (oci-container-configuration-group config))
+ (maybe-user (oci-container-configuration-user config))
+ (maybe-group (oci-container-configuration-group config))
+ (user (if (maybe-value-set? maybe-user)
+ maybe-user
+ user))
+ (group (if (maybe-value-set? maybe-group)
+ maybe-group
+ group))
(host-environment
(oci-container-configuration-host-environment config))
(command (oci-container-configuration-command config))
(log-file (oci-container-configuration-log-file config))
- (provision (oci-container-configuration-provision config))
(requirement (oci-container-configuration-requirement config))
(respawn?
(oci-container-configuration-respawn? config))
(image (oci-container-configuration-image config))
(image-reference (oci-image-reference image))
(options (oci-container-configuration->options config))
- (name (guess-name provision image))
+ (name
+ (oci-container-shepherd-name runtime config))
(extra-arguments
- (oci-container-configuration-extra-arguments config)))
+ (oci-container-configuration-extra-arguments config))
+ (invocation
+ (oci-container-run-invocation
+ runtime runtime-cli name command image-reference
+ options runtime-extra-arguments extra-arguments))
+ (wrap-command
+ (lambda (command)
+ (if (eq? runtime 'podman)
+ (list
+ "/bin/sh" "-l" "-c"
+ #~(string-join (list #$@command) " "))
+ command)))
+ (container-action
+ (lambda* (command #:key (environment-variables #f))
+ #~(lambda _
+ (fork+exec-command
+ (list #$@command)
+ #$@(if user (list #:user user) '())
+ #$@(if group (list #:group group) '())
+ #$@(if (maybe-value-set? log-file)
+ (list #:log-file log-file)
+ '())
+ #$@(if (and user (eq? runtime 'podman))
+ (list #:directory
+ #~(passwd:dir (getpwnam #$user)))
+ '())
+ #$@(if environment-variables
+ (list #:environment-variables
+ environment-variables)
+ '()))))))
(shepherd-service (provision `(,(string->symbol name)))
- (requirement `(dockerd user-processes ,@requirement))
+ (requirement `(,@oci-requirement
+ ,@requirement))
(respawn? respawn?)
(auto-start? auto-start?)
(documentation
(string-append
- "Docker backed Shepherd service for "
+ (oci-runtime-name runtime) " backed Shepherd service for "
(if (oci-image? image) name image) "."))
(start
- #~(lambda ()
- #$@(if (oci-image? image)
- #~((invoke #$(%oci-image-loader
- name image image-reference)))
- #~())
- (fork+exec-command
- ;; docker run [OPTIONS] IMAGE [COMMAND] [ARG...]
- (list #$docker "run" "--rm" "--name" #$name
- #$@options #$@extra-arguments
- #$image-reference #$@command)
- #:user #$user
- #:group #$group
- #$@(if (maybe-value-set? log-file)
- (list #:log-file log-file)
- '())
- #:environment-variables
- (list #$@host-environment))))
+ (container-action
+ (list (oci-container-entrypoint
+ runtime runtime-cli name image image-reference
+ invocation #:verbose? verbose?))
+ #:environment-variables
+ #~(append
+ (list #$@host-environment)
+ (list #$@runtime-environment))))
(stop
- #~(lambda _
- (invoke #$docker "rm" "-f" #$name)))
+ (container-action
+ (wrap-command
+ (list runtime-cli "rm" "-f" name))))
(actions
- (if (oci-image? image)
- '()
- (append
+ (append
+ (list
+ (oci-object-command-shepherd-action
+ name #~(string-join (list #$@invocation) " ")))
+ (if (oci-image? image)
+ '()
(list
- (shepherd-action
- (name 'pull)
- (documentation
- (format #f "Pull ~a's image (~a)."
- name image))
- (procedure
- #~(lambda _
- (invoke #$docker "pull" #$image)))))
- actions))))))
-
-(define %oci-container-accounts
+ (let ((service-name name))
+ (shepherd-action
+ (name 'pull)
+ (documentation
+ (format #f "Pull ~a's image (~a)."
+ service-name image))
+ (procedure
+ (container-action
+ (wrap-command
+ (list runtime-cli "pull" image))))))))
+ actions)))))
+
+(define (oci-object-create-invocation object runtime-cli name options
+ runtime-extra-arguments
+ create-extra-arguments)
+ "Return a gexp that, upon lowering, will evaluate to the OCI runtime
+invocation for creating networks and volumes."
+ ;; network|volume create [options] [NAME]
+ #~(list #$runtime-cli #$@runtime-extra-arguments #$object "create"
+ #$@options #$@create-extra-arguments #$name))
+
+(define (format-oci-invocations invocations)
+ "Return a gexp that, upon lowering, will evaluate to a formatted message
+containing the INVOCATIONS that the OCI runtime will execute to provision
+networks or volumes."
+ #~(string-join (map (lambda (i) (string-join i " "))
+ (list #$@invocations))
+ "\n"))
+
+(define* (oci-object-create-script object runtime runtime-cli invocations
+ #:key (verbose? #f))
+ "Return a file-like object that, once lowered, will evaluate to a program able
+to create OCI networks and volumes through RUNTIME-CLI."
+ (define runtime-string (symbol->string runtime))
+ (program-file
+ (string-append runtime-string "-" object "s-create.scm")
+ #~(begin
+ (use-modules (ice-9 format)
+ (ice-9 match)
+ (ice-9 popen)
+ (ice-9 rdelim)
+ (srfi srfi-1))
+
+ (define object-exists?
+ #$(oci-object-exists? runtime runtime-cli object verbose?))
+
+ (for-each
+ (lambda (invocation)
+ (define name (last invocation))
+ (if (object-exists? name)
+ (format #t "~a ~a ~a already exists, skipping creation.~%"
+ #$(oci-runtime-name runtime) name #$object)
+ (begin
+ (when #$verbose?
+ (format #t "Running~{ ~a~}~%" invocation))
+ (let ((exit-code (status:exit-val (apply system* invocation))))
+ (when #$verbose?
+ (format #t "Exit code: ~a~%" exit-code))))))
+ (list #$@invocations)))))
+
+(define* (oci-object-shepherd-service object runtime runtime-cli name requirement invocations
+ #:key
+ (runtime-environment #~())
+ (user #f)
+ (group #f)
+ (verbose? #f))
+ "Return a Shepherd service object that will create the OBJECTs represented
+by INVOCATIONS through RUNTIME-CLI."
+ (shepherd-service (provision `(,(string->symbol name)))
+ (requirement requirement)
+ (one-shot? #t)
+ (documentation
+ (string-append
+ (oci-runtime-name runtime) " " object
+ " provisioning service"))
+ (start
+ #~(lambda _
+ (fork+exec-command
+ (list
+ #$(oci-object-create-script
+ object runtime runtime-cli
+ invocations
+ #:verbose? verbose?))
+ #$@(if user (list #:user user) '())
+ #$@(if group (list #:group group) '())
+ #:environment-variables
+ (list #$@runtime-environment))))
+ (actions
+ (list
+ (oci-object-command-shepherd-action
+ name (format-oci-invocations invocations))))))
+
+(define* (oci-networks-shepherd-service runtime runtime-cli name networks
+ #:key (user #f) (group #f) (verbose? #f)
+ (runtime-extra-arguments '())
+ (runtime-environment #~())
+ (runtime-requirement '()))
+ "Return a Shepherd service object that will create the networks represented
+in CONFIG."
+ (let ((invocations
+ (map
+ (lambda (network)
+ (oci-object-create-invocation
+ "network" runtime-cli
+ (oci-network-configuration-name network)
+ (oci-network-configuration->options network)
+ runtime-extra-arguments
+ (oci-network-configuration-extra-arguments network)))
+ networks)))
+
+ (oci-object-shepherd-service
+ "network" runtime runtime-cli name
+ runtime-requirement invocations
+ #:user user #:group group #:runtime-environment runtime-environment
+ #:verbose? verbose?)))
+
+(define* (oci-volumes-shepherd-service runtime runtime-cli name volumes
+ #:key (user #f) (group #f) (verbose? #f)
+ (runtime-extra-arguments '())
+ (runtime-environment #~())
+ (runtime-requirement '()))
+ "Return a Shepherd service object that will create the volumes represented
+in CONFIG."
+ (let ((invocations
+ (map
+ (lambda (volume)
+ (oci-object-create-invocation
+ "volume" runtime-cli
+ (oci-volume-configuration-name volume)
+ (oci-volume-configuration->options volume)
+ runtime-extra-arguments
+ (oci-volume-configuration-extra-arguments volume)))
+ volumes)))
+
+ (oci-object-shepherd-service
+ "volume" runtime runtime-cli name runtime-requirement invocations
+ #:user user #:group group #:runtime-environment runtime-environment
+ #:verbose? verbose?)))
+
+(define (oci-service-accounts config)
+ (define user (oci-configuration-user config))
+ (define maybe-group (oci-configuration-group config))
+ (define runtime (oci-configuration-runtime config))
(list (user-account
- (name "oci-container")
+ (name user)
(comment "OCI services account")
- (group "docker")
- (system? #t)
- (home-directory "/var/empty")
+ (group "users")
+ (supplementary-groups
+ (list (oci-runtime-group runtime maybe-group)))
+ (system? (eq? 'docker runtime))
+ (home-directory (if (eq? 'podman runtime)
+ (string-append "/home/" user)
+ "/var/empty"))
+ (create-home-directory? (eq? 'podman runtime))
(shell (file-append shadow "/sbin/nologin")))))
+
+(define* (oci-state->shepherd-services runtime runtime-cli containers networks volumes
+ #:key (user #f) (group #f) (verbose? #f)
+ (networks-name #f) (volumes-name #f)
+ (runtime-extra-arguments '())
+ (runtime-environment #~())
+ (runtime-requirement '())
+ (containers-requirement '())
+ (networks-requirement '())
+ (volumes-requirement '()))
+ "Returns a list of Shepherd services based on the input OCI state."
+ (let* ((networks-name
+ (if (string? networks-name)
+ networks-name
+ (oci-networks-shepherd-name runtime)))
+ (networks?
+ (> (length networks) 0))
+ (networks-service
+ (if networks?
+ (list
+ (string->symbol networks-name))
+ '()))
+ (volumes-name
+ (if (string? volumes-name)
+ volumes-name
+ (oci-volumes-shepherd-name runtime)))
+ (volumes?
+ (> (length volumes) 0))
+ (volumes-service
+ (if volumes?
+ (list (string->symbol volumes-name))
+ '())))
+ (append
+ (map
+ (lambda (c)
+ (oci-container-shepherd-service
+ runtime runtime-cli c
+ #:user user
+ #:group group
+ #:runtime-environment runtime-environment
+ #:runtime-extra-arguments runtime-extra-arguments
+ #:oci-requirement
+ (append containers-requirement
+ runtime-requirement
+ networks-service
+ volumes-service)
+ #:verbose? verbose?))
+ containers)
+ (if networks?
+ (list
+ (oci-networks-shepherd-service
+ runtime runtime-cli
+ networks-name networks
+ #:user user #:group group
+ #:runtime-extra-arguments runtime-extra-arguments
+ #:runtime-environment runtime-environment
+ #:runtime-requirement (append networks-requirement
+ runtime-requirement)
+ #:verbose? verbose?))
+ '())
+ (if volumes?
+ (list
+ (oci-volumes-shepherd-service
+ runtime runtime-cli
+ volumes-name volumes
+ #:user user #:group group
+ #:runtime-extra-arguments runtime-extra-arguments
+ #:runtime-environment runtime-environment
+ #:runtime-requirement (append runtime-requirement
+ volumes-requirement)
+ #:verbose? verbose?))
+ '()))))
+
+(define (oci-configuration->shepherd-services config)
+ (let* ((runtime (oci-configuration-runtime config))
+ (system-runtime-cli
+ (oci-runtime-system-cli config))
+ (home-runtime-cli
+ (oci-runtime-home-cli config))
+ (runtime-extra-arguments
+ (oci-configuration-runtime-extra-arguments config))
+ (containers (oci-configuration-containers config))
+ (networks (oci-configuration-networks config))
+ (volumes (oci-configuration-volumes config))
+ (user (oci-configuration-user config))
+ (group (oci-runtime-group
+ runtime (oci-configuration-group config)))
+ (verbose? (oci-configuration-verbose? config))
+ (home-service?
+ (oci-configuration-home-service? config)))
+ (if home-service?
+ (oci-state->shepherd-services runtime home-runtime-cli containers networks volumes
+ #:verbose? verbose?
+ #:networks-name
+ (oci-networks-home-shepherd-name runtime)
+ #:volumes-name
+ (oci-volumes-home-shepherd-name runtime))
+ (oci-state->shepherd-services runtime system-runtime-cli containers networks volumes
+ #:user user
+ #:group
+ (oci-runtime-system-group runtime user group)
+ #:verbose? verbose?
+ #:runtime-extra-arguments
+ runtime-extra-arguments
+ #:runtime-environment
+ (oci-runtime-system-environment runtime user)
+ #:runtime-requirement
+ (oci-runtime-system-requirement runtime)
+ #:networks-requirement '(networking)))))
+
+(define (oci-service-subids config)
+ "Return a subids-extension record representing subuids and subgids required by
+the rootless Podman backend."
+ (define (delete-duplicate-ranges ranges)
+ (delete-duplicates ranges
+ (lambda args
+ (apply string=? (map subid-range-name ranges)))))
+ (define runtime
+ (oci-configuration-runtime config))
+ (define user
+ (oci-configuration-user config))
+ (define subgids (oci-configuration-subgids-range config))
+ (define subuids (oci-configuration-subuids-range config))
+ (define container-users
+ (filter (lambda (range)
+ (and (maybe-value-set?
+ (subid-range-name range))
+ (not (string=? (subid-range-name range) user))))
+ (map (lambda (container)
+ (subid-range
+ (name
+ (oci-container-configuration-user container))))
+ (oci-configuration-containers config))))
+ (define subgid-ranges
+ (delete-duplicate-ranges
+ (cons
+ (if (eq? subgids #f)
+ (subid-range (name user))
+ subgids)
+ container-users)))
+ (define subuid-ranges
+ (delete-duplicate-ranges
+ (cons
+ (if (eq? subuids #f)
+ (subid-range (name user))
+ subuids)
+ container-users)))
+
+ (if (eq? 'podman runtime)
+ (subids-extension
+ (subgids
+ subgid-ranges)
+ (subuids
+ subuid-ranges))
+ (subids-extension)))
+
+(define (oci-objects-merge-lst a b object get-name)
+ (define (contains? value lst)
+ (member value (map get-name lst)))
+ (let loop ((merged '())
+ (lst (append a b)))
+ (if (null? lst)
+ merged
+ (loop
+ (let ((element (car lst)))
+ (when (contains? element merged)
+ (raise
+ (formatted-message
+ (G_ "Duplicated ~a: ~a. ~as names should be unique, please
+remove the duplicate.") object (get-name element) object)))
+ (cons element merged))
+ (cdr lst)))))
+
+(define (oci-extension-merge a b)
+ (oci-extension
+ (containers (oci-objects-merge-lst
+ (oci-extension-containers a)
+ (oci-extension-containers b)
+ "container"
+ (lambda (config)
+ (define maybe-name (oci-container-configuration-provision config))
+ (if (maybe-value-set? maybe-name)
+ maybe-name
+ (oci-image->container-name
+ (oci-container-configuration-image config))))))
+ (networks (oci-objects-merge-lst
+ (oci-extension-networks a)
+ (oci-extension-networks b)
+ "network"
+ oci-network-configuration-name))
+ (volumes (oci-objects-merge-lst
+ (oci-extension-volumes a)
+ (oci-extension-volumes b)
+ "volume"
+ oci-volume-configuration-name))))
+
+(define (oci-service-profile runtime runtime-cli)
+ `(,bash-minimal
+ ,@(if (string? runtime-cli)
+ '()
+ (list
+ (cond
+ ((not (eq? runtime-cli #f))
+ runtime-cli)
+ ((eq? 'podman runtime)
+ podman)
+ (else
+ docker-cli))))))
+
+(define (oci-service-extension-wrap-validate extension)
+ (lambda (config)
+ (if (oci-configuration-valid? config)
+ (extension config)
+ (raise
+ (formatted-message
+ (G_ "Invalide oci-configuration ~a.") config)))))
+
+(define (oci-configuration-extend config extension)
+ (oci-configuration
+ (inherit config)
+ (containers
+ (oci-objects-merge-lst
+ (oci-configuration-containers config)
+ (oci-extension-containers extension)
+ "container"
+ (lambda (oci-config)
+ (define runtime
+ (oci-configuration-runtime config))
+ (oci-container-shepherd-name runtime oci-config))))
+ (networks (oci-objects-merge-lst
+ (oci-configuration-networks config)
+ (oci-extension-networks extension)
+ "network"
+ oci-network-configuration-name))
+ (volumes (oci-objects-merge-lst
+ (oci-configuration-volumes config)
+ (oci-extension-volumes extension)
+ "volume"
+ oci-volume-configuration-name))))
+
+(define oci-service-type
+ (service-type (name 'oci)
+ (extensions
+ (list
+ (service-extension profile-service-type
+ (oci-service-extension-wrap-validate
+ (lambda (config)
+ (let ((runtime-cli
+ (oci-configuration-runtime-cli config))
+ (runtime
+ (oci-configuration-runtime config)))
+ (oci-service-profile runtime runtime-cli)))))
+ (service-extension subids-service-type
+ (oci-service-extension-wrap-validate
+ oci-service-subids))
+ (service-extension account-service-type
+ (oci-service-extension-wrap-validate
+ oci-service-accounts))
+ (service-extension shepherd-root-service-type
+ (oci-service-extension-wrap-validate
+ oci-configuration->shepherd-services))))
+ ;; Concatenate OCI object lists.
+ (compose (lambda (args)
+ (fold oci-extension-merge
+ (oci-extension)
+ args)))
+ (extend oci-configuration-extend)
+ (default-value (oci-configuration))
+ (description
+ "This service implements the provisioning of OCI object such
+as containers, networks and volumes.")))
diff --git a/gnu/services/docker.scm b/gnu/services/docker.scm
index 828ceea313a..125e748bb0e 100644
--- a/gnu/services/docker.scm
+++ b/gnu/services/docker.scm
@@ -31,7 +31,10 @@ (define-module (gnu services docker)
#:use-module (gnu system shadow)
#:use-module (gnu packages docker)
#:use-module (gnu packages linux) ;singularity
+ #:use-module (guix deprecation)
+ #:use-module (guix diagnostics)
#:use-module (guix gexp)
+ #:use-module (guix i18n)
#:use-module (guix records)
#:use-module (srfi srfi-1)
#:use-module (ice-9 format)
@@ -67,16 +70,18 @@ (define-module (gnu services docker)
oci-container-configuration-volumes
oci-container-configuration-container-user
oci-container-configuration-workdir
- oci-container-configuration-extra-arguments
- oci-container-shepherd-service
- %oci-container-accounts)
+ oci-container-configuration-extra-arguments)
#:export (containerd-configuration
containerd-service-type
docker-configuration
docker-service-type
singularity-service-type
- oci-container-service-type))
+ ;; for backwards compatibility, until the
+ ;; oci-container-service-type is fully deprecated
+ oci-container-shepherd-service
+ oci-container-service-type
+ %oci-container-accounts))
(define-maybe file-like)
@@ -297,17 +302,25 @@ (define singularity-service-type
;;; OCI container.
;;;
-(define (configs->shepherd-services configs)
- (map oci-container-shepherd-service configs))
+;; for backwards compatibility, until the
+;; oci-container-service-type is fully deprecated
+(define-deprecated (oci-container-shepherd-service config)
+ oci-service-type
+ ((@ (gnu services containers) oci-container-shepherd-service)
+ 'docker config))
+(define %oci-container-accounts
+ (filter user-account? (oci-service-accounts (oci-configuration))))
(define oci-container-service-type
(service-type (name 'oci-container)
- (extensions (list (service-extension profile-service-type
- (lambda _ (list docker-cli)))
- (service-extension account-service-type
- (const %oci-container-accounts))
- (service-extension shepherd-root-service-type
- configs->shepherd-services)))
+ (extensions
+ (list (service-extension oci-service-type
+ (lambda (containers)
+ (warning
+ (G_
+ "'oci-container-service-type' is deprecated, use 'oci-service-type' instead~%"))
+ (oci-extension
+ (containers containers))))))
(default-value '())
(extend append)
(compose concatenate)
diff --git a/gnu/tests/containers.scm b/gnu/tests/containers.scm
index 0ecc8ddb126..5e6f39387e7 100644
--- a/gnu/tests/containers.scm
+++ b/gnu/tests/containers.scm
@@ -27,6 +27,9 @@ (define-module (gnu tests containers)
#:use-module (gnu services)
#:use-module (gnu services containers)
#:use-module (gnu services desktop)
+ #:use-module ((gnu services docker)
+ #:select (containerd-service-type
+ docker-service-type))
#:use-module (gnu services dbus)
#:use-module (gnu services networking)
#:use-module (gnu system)
@@ -39,7 +42,9 @@ (define-module (gnu tests containers)
#:use-module (guix profiles)
#:use-module ((guix scripts pack) #:prefix pack:)
#:use-module (guix store)
- #:export (%test-rootless-podman))
+ #:export (%test-rootless-podman
+ %test-oci-service-rootless-podman
+ %test-oci-service-docker))
(define %rootless-podman-os
@@ -345,3 +350,995 @@ (define %test-rootless-podman
(name "rootless-podman")
(description "Test rootless Podman service.")
(value (build-tarball&run-rootless-podman-test))))
+
+
+(define %oci-rootless-podman-os
+ (simple-operating-system
+ (service dhcp-client-service-type)
+ (service dbus-root-service-type)
+ (service polkit-service-type)
+ (service elogind-service-type)
+ (service iptables-service-type)
+ (service rootless-podman-service-type)
+ (extra-special-file "/shared.txt"
+ (plain-file "shared.txt" "hello"))
+ (service oci-service-type
+ (oci-configuration
+ (runtime 'podman)
+ (verbose? #t)))
+ (simple-service 'oci-provisioning
+ oci-service-type
+ (oci-extension
+ (networks
+ (list (oci-network-configuration (name "my-network"))))
+ (volumes
+ (list (oci-volume-configuration (name "my-volume"))))
+ (containers
+ (list
+ (oci-container-configuration
+ (provision "first")
+ (image
+ (oci-image
+ (repository "guile")
+ (value
+ (specifications->manifest '("guile")))
+ (pack-options
+ '(#:symlinks (("/bin" -> "bin"))))))
+ (entrypoint "/bin/guile")
+ (network "my-network")
+ (command
+ '("-c" "(use-modules (web server))
+(define (handler request request-body)
+ (values '((content-type . (text/plain))) \"out of office\"))
+(run-server handler 'http `(#:addr ,(inet-pton AF_INET \"0.0.0.0\")))"))
+ (host-environment
+ '(("VARIABLE" . "value")))
+ (volumes
+ '(("my-volume" . "/my-volume")))
+ (extra-arguments
+ '("--env" "VARIABLE")))
+ (oci-container-configuration
+ (provision "second")
+ (image
+ (oci-image
+ (repository "guile")
+ (value
+ (specifications->manifest '("guile")))
+ (pack-options
+ '(#:symlinks (("/bin" -> "bin"))))))
+ (entrypoint "/bin/guile")
+ (network "my-network")
+ (command
+ '("-c" "(let l ((c 300))(display c)(sleep 1)(when(positive? c)(l (- c 1))))"))
+ (volumes
+ '(("my-volume" . "/my-volume")
+ ("/shared.txt" . "/shared.txt:ro"))))))))))
+
+(define (run-rootless-podman-oci-service-test)
+ (define os
+ (marionette-operating-system
+ (operating-system-with-gc-roots
+ %oci-rootless-podman-os
+ (list))
+ #: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))
+ #~(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-oci-service")
+
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (wait-for-service 'user-processes))
+ marionette)
+
+ (test-assert "rootless-podman services started successfully"
+ (begin
+ (define (run-test)
+ (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))
+ ;; Allow services to come up on slower machines
+ (let loop ((attempts 0))
+ (if (= attempts 60)
+ (error "Services didn't come up after more than 60 seconds")
+ (if (equal? '("cgroup" "cgroup")
+ (run-test))
+ #t
+ (begin
+ (sleep 1)
+ (format #t "Services didn't come up yet, retrying with attempt ~a~%"
+ (+ 1 attempts))
+ (loop (+ 1 attempts))))))))
+
+ (test-assert "podman-volumes running"
+ (begin
+ (define (run-test)
+ (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 6))
+ (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 "oci-container")))
+ (setuid (passwd:uid (getpw "oci-container")))
+
+ (let ((response (slurp
+ "/run/current-system/profile/bin/podman"
+ "volume" "ls" "-n" "--format" "\"{{.Name}}\""
+ "|" "tr" "' '" "'\n'")))
+
+ (call-with-output-file (string-append ,out-dir "/response")
+ (lambda (port)
+ (display (string-join response "\n") port)))))
+ (lambda ()
+ (primitive-exit 127))))
+ (pid
+ (cdr (waitpid pid))))
+
+ (wait-for-file (string-append ,out-dir "/response"))
+
+ (stable-sort
+ (slurp "cat" (string-append ,out-dir "/response"))
+ string<=?))
+ marionette))
+ ;; Allow services to come up on slower machines
+ (let loop ((attempts 0))
+ (if (= attempts 80)
+ (error "Service didn't come up after more than 80 seconds")
+ (if (equal? '("my-volume")
+ (run-test))
+ #t
+ (begin
+ (sleep 1)
+ (loop (+ 1 attempts))))))))
+
+ (test-assert "podman-networks running"
+ (begin
+ (define (run-test)
+ (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 6))
+ (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 "oci-container")))
+ (setuid (passwd:uid (getpw "oci-container")))
+
+ (let ((response (slurp
+ "/run/current-system/profile/bin/podman"
+ "network" "ls" "-n" "--format" "\"{{.Name}}\""
+ "|" "tr" "' '" "'\n'")))
+
+ (call-with-output-file (string-append ,out-dir "/response")
+ (lambda (port)
+ (display (string-join response "\n") port)))))
+ (lambda ()
+ (primitive-exit 127))))
+ (pid
+ (cdr (waitpid pid))))
+
+ (wait-for-file (string-append ,out-dir "/response"))
+
+ (stable-sort
+ (slurp "cat" (string-append ,out-dir "/response"))
+ string<=?))
+ marionette))
+ ;; Allow services to come up on slower machines
+ (let loop ((attempts 0))
+ (if (= attempts 80)
+ (error "Service didn't come up after more than 80 seconds")
+ (if (equal? '("my-network" "podman")
+ (run-test))
+ #t
+ (begin
+ (sleep 1)
+ (loop (+ 1 attempts))))))))
+
+ (test-assert "first container running"
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (wait-for-service 'first #:timeout 120)
+ #t)
+ marionette))
+
+ (test-assert "second container running"
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (wait-for-service 'second #:timeout 120)
+ #t)
+ marionette))
+
+ (test-assert "passing host environment variables"
+ (begin
+ (define (run-test)
+ (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 "oci-container")))
+ (setuid (passwd:uid (getpw "oci-container")))
+
+ (let ((response (slurp
+ "/run/current-system/profile/bin/podman"
+ "exec" "first"
+ "/bin/guile" "-c" "'(display (getenv \"VARIABLE\"))'")))
+ (call-with-output-file (string-append ,out-dir "/response")
+ (lambda (port)
+ (display (string-join response "\n") port)))))
+ (lambda ()
+ (primitive-exit 127))))
+ (pid
+ (cdr (waitpid pid))))
+
+ (wait-for-file (string-append ,out-dir "/response"))
+ (slurp "cat" (string-append ,out-dir "/response")))
+ marionette))
+ ;; Allow image to be loaded on slower machines
+ (let loop ((attempts 0))
+ (if (= attempts 180)
+ (error "Service didn't come up after more than 180 seconds")
+ (if (equal? (list "value")
+ (run-test))
+ #t
+ (begin
+ (sleep 1)
+ (loop (+ 1 attempts))))))))
+
+ (test-equal "mounting host files"
+ '("hello")
+ (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 "oci-container")))
+ (setuid (passwd:uid (getpw "oci-container")))
+
+ (let ((response (slurp
+ "/run/current-system/profile/bin/podman"
+ "exec" "second"
+ "/bin/guile" "-c" "'(begin (use-modules (ice-9 popen) (ice-9 rdelim))
+(display (call-with-input-file \"/shared.txt\" read-line)))'")))
+ (call-with-output-file (string-append ,out-dir "/response")
+ (lambda (port)
+ (display (string-join response " ") port)))))
+ (lambda ()
+ (primitive-exit 127))))
+ (pid
+ (cdr (waitpid pid))))
+
+ (wait-for-file (string-append ,out-dir "/response"))
+ (slurp "cat" (string-append ,out-dir "/response")))
+ marionette))
+
+ (test-equal "write to volumes"
+ '("world")
+ (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 "oci-container")))
+ (setuid (passwd:uid (getpw "oci-container")))
+
+ (slurp
+ "/run/current-system/profile/bin/podman"
+ "exec" "first"
+ "/bin/guile" "-c" "'(begin (use-modules (ice-9 popen) (ice-9 rdelim))
+(call-with-output-file \"/my-volume/out.txt\" (lambda (p) (display \"world\" p))))'")
+
+ (let ((response (slurp
+ "/run/current-system/profile/bin/podman"
+ "exec" "second"
+ "/bin/guile" "-c" "'(begin (use-modules (ice-9 popen) (ice-9 rdelim))
+(display (call-with-input-file \"/my-volume/out.txt\" read-line)))'")))
+ (call-with-output-file (string-append ,out-dir "/response")
+ (lambda (port)
+ (display (string-join response " ") port)))))
+ (lambda ()
+ (primitive-exit 127))))
+ (pid
+ (cdr (waitpid pid))))
+
+ (wait-for-file (string-append ,out-dir "/response"))
+ (slurp "cat" (string-append ,out-dir "/response")))
+ marionette))
+
+ (test-equal "can read ports over network"
+ '("out of office")
+ (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 "oci-container")))
+ (setuid (passwd:uid (getpw "oci-container")))
+
+ (let ((response (slurp
+ "/run/current-system/profile/bin/podman"
+ "exec" "second"
+ "/bin/guile" "-c" "'(begin (use-modules (web client))
+(define-values (response out)
+ (http-get \"http://first:8080\"))
+(display out))'")))
+ (call-with-output-file (string-append ,out-dir "/response")
+ (lambda (port)
+ (display (string-join response " ") port)))))
+ (lambda ()
+ (primitive-exit 127))))
+ (pid
+ (cdr (waitpid pid))))
+
+ (wait-for-file (string-append ,out-dir "/response"))
+ (slurp "cat" (string-append ,out-dir "/response")))
+ marionette))
+
+ (test-end))))
+
+ (gexp->derivation "rootless-podman-oci-service-test" test))
+
+(define %test-oci-service-rootless-podman
+ (system-test
+ (name "oci-service-rootless-podman")
+ (description "Test Rootless-Podman backed OCI provisioning service.")
+ (value (run-rootless-podman-oci-service-test))))
+
+(define %oci-docker-os
+ (simple-operating-system
+ (service dhcp-client-service-type)
+ (service dbus-root-service-type)
+ (service polkit-service-type)
+ (service elogind-service-type)
+ (service containerd-service-type)
+ (service docker-service-type)
+ (extra-special-file "/shared.txt"
+ (plain-file "shared.txt" "hello"))
+ (service oci-service-type
+ (oci-configuration
+ (verbose? #t)))
+ (simple-service 'oci-provisioning
+ oci-service-type
+ (oci-extension
+ (networks
+ (list (oci-network-configuration (name "my-network"))))
+ (volumes
+ (list (oci-volume-configuration (name "my-volume"))))
+ (containers
+ (list
+ (oci-container-configuration
+ (provision "first")
+ (image
+ (oci-image
+ (repository "guile")
+ (value
+ (specifications->manifest '("guile")))
+ (pack-options
+ '(#:symlinks (("/bin" -> "bin"))))))
+ (entrypoint "/bin/guile")
+ (network "my-network")
+ (command
+ '("-c" "(use-modules (web server))
+(define (handler request request-body)
+ (values '((content-type . (text/plain))) \"out of office\"))
+(run-server handler 'http `(#:addr ,(inet-pton AF_INET \"0.0.0.0\")))"))
+ (host-environment
+ '(("VARIABLE" . "value")))
+ (volumes
+ '(("my-volume" . "/my-volume")))
+ (extra-arguments
+ '("--env" "VARIABLE")))
+ (oci-container-configuration
+ (provision "second")
+ (image
+ (oci-image
+ (repository "guile")
+ (value
+ (specifications->manifest '("guile")))
+ (pack-options
+ '(#:symlinks (("/bin" -> "bin"))))))
+ (entrypoint "/bin/guile")
+ (network "my-network")
+ (command
+ '("-c" "(let l ((c 300))(display c)(sleep 1)(when(positive? c)(l (- c 1))))"))
+ (volumes
+ '(("my-volume" . "/my-volume")
+ ("/shared.txt" . "/shared.txt:ro"))))))))))
+
+(define (run-docker-oci-service-test)
+ (define os
+ (marionette-operating-system
+ (operating-system-with-gc-roots
+ %oci-docker-os
+ (list))
+ #: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))
+ #~(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))
+
+ (test-runner-current (system-test-runner #$output))
+ (test-begin "docker-oci-service")
+
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (wait-for-service 'dockerd))
+ marionette)
+
+ (test-assert "docker-volumes running"
+ (begin
+ (define (run-test)
+ (marionette-eval
+ `(begin
+ (use-modules (ice-9 popen)
+ (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
+ (list "sh" "-l" "-c"
+ (string-join
+ args
+ " "))))
+ (output (read-lines port))
+ (status (close-pipe port)))
+ output)))
+
+ (stable-sort
+ (slurp
+ "/run/current-system/profile/bin/docker"
+ "volume" "ls" "--format" "\"{{.Name}}\"")
+ string<=?))
+
+ marionette))
+ ;; Allow services to come up on slower machines
+ (let loop ((attempts 0))
+ (if (= attempts 80)
+ (error "Service didn't come up after more than 80 seconds")
+ (if (equal? '("my-volume")
+ (run-test))
+ #t
+ (begin
+ (sleep 1)
+ (loop (+ 1 attempts))))))))
+
+ (test-assert "docker-networks running"
+ (begin
+ (define (run-test)
+ (marionette-eval
+ `(begin
+ (use-modules (ice-9 popen)
+ (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
+ (list "sh" "-l" "-c"
+ (string-join
+ args
+ " "))))
+ (output (read-lines port))
+ (status (close-pipe port)))
+ output)))
+
+ (stable-sort
+ (slurp
+ "/run/current-system/profile/bin/docker"
+ "network" "ls" "--format" "\"{{.Name}}\"")
+ string<=?))
+
+ marionette))
+ ;; Allow services to come up on slower machines
+ (let loop ((attempts 0))
+ (if (= attempts 80)
+ (error "Service didn't come up after more than 80 seconds")
+ (if (equal? '("bridge" "host" "my-network" "none")
+ (run-test))
+ #t
+ (begin
+ (sleep 1)
+ (loop (+ 1 attempts))))))))
+
+ (test-assert "first container running"
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (wait-for-service 'first #:timeout 120)
+ #t)
+ marionette))
+
+ (test-assert "second container running"
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (wait-for-service 'second #:timeout 120)
+ #t)
+ marionette))
+
+ (test-assert "passing host environment variables"
+ (begin
+ (define (run-test)
+ (marionette-eval
+ `(begin
+ (use-modules (ice-9 popen)
+ (ice-9 rdelim))
+
+ (define slurp
+ (lambda args
+ (let* ((port (apply open-pipe* OPEN_READ args))
+ (output (let ((line (read-line port)))
+ (if (eof-object? line)
+ ""
+ line)))
+ (status (close-pipe port)))
+ output)))
+
+ (slurp
+ "/run/current-system/profile/bin/docker"
+ "exec" "first"
+ "/bin/guile" "-c" "(display (getenv \"VARIABLE\"))"))
+ marionette))
+ ;; Allow image to be loaded on slower machines
+ (let loop ((attempts 0))
+ (if (= attempts 180)
+ (error "Service didn't come up after more than 180 seconds")
+ (if (equal? "value"
+ (run-test))
+ #t
+ (begin
+ (sleep 1)
+ (loop (+ 1 attempts))))))))
+
+ (test-equal "mounting host files"
+ "hello"
+ (marionette-eval
+ `(begin
+ (use-modules (ice-9 popen)
+ (ice-9 rdelim))
+
+ (define slurp
+ (lambda args
+ (let* ((port (apply open-pipe* OPEN_READ args))
+ (output (let ((line (read-line port)))
+ (if (eof-object? line)
+ ""
+ line)))
+ (status (close-pipe port)))
+ output)))
+
+ (slurp
+ "/run/current-system/profile/bin/docker"
+ "exec" "second"
+ "/bin/guile" "-c" "(begin (use-modules (ice-9 popen) (ice-9 rdelim))
+(display (call-with-input-file \"/shared.txt\" read-line)))"))
+ marionette))
+
+ (test-equal "write to volumes"
+ "world"
+ (marionette-eval
+ `(begin
+ (use-modules (ice-9 popen)
+ (ice-9 rdelim))
+
+ (define slurp
+ (lambda args
+ (let* ((port (apply open-pipe* OPEN_READ args))
+ (output (let ((line (read-line port)))
+ (if (eof-object? line)
+ ""
+ line)))
+ (status (close-pipe port)))
+ output)))
+
+ (slurp
+ "/run/current-system/profile/bin/docker"
+ "exec" "first"
+ "/bin/guile" "-c" "(begin (use-modules (ice-9 popen) (ice-9 rdelim))
+(call-with-output-file \"/my-volume/out.txt\" (lambda (p) (display \"world\" p))))")
+ (slurp
+ "/run/current-system/profile/bin/docker"
+ "exec" "second"
+ "/bin/guile" "-c" "(begin (use-modules (ice-9 popen) (ice-9 rdelim))
+(display (call-with-input-file \"/my-volume/out.txt\" read-line)))"))
+ marionette))
+
+ (test-equal "can read ports over network"
+ "out of office"
+ (marionette-eval
+ `(begin
+ (use-modules (ice-9 popen)
+ (ice-9 rdelim))
+
+ (define slurp
+ (lambda args
+ (let* ((port (apply open-pipe* OPEN_READ args))
+ (output (let ((line (read-line port)))
+ (if (eof-object? line)
+ ""
+ line)))
+ (status (close-pipe port)))
+ output)))
+
+ (slurp
+ "/run/current-system/profile/bin/docker"
+ "exec" "second"
+ "/bin/guile" "-c" "(begin (use-modules (web client))
+(define-values (response out)
+ (http-get \"http://first:8080\"))
+(display out))"))
+ marionette))
+
+ (test-end))))
+
+ (gexp->derivation "docker-oci-service-test" test))
+
+(define %test-oci-service-docker
+ (system-test
+ (name "oci-service-docker")
+ (description "Test Docker backed OCI provisioning service.")
+ (value (run-docker-oci-service-test))))
--
2.48.1
guix-patches <at> gnu.org:bug#76081; Package guix-patches.
(Tue, 04 Mar 2025 12:42:02 GMT) Full text and rfc822 format available.Message #107 received at 76081 <at> debbugs.gnu.org (full text, mbox):
From: Giacomo Leidi <goodoldpaul <at> autistici.org> To: 76081 <at> debbugs.gnu.org Cc: Giacomo Leidi <goodoldpaul <at> autistici.org> Subject: [PATCH v7 4/5] tests: Use lower-oci-image-state in container tests. Date: Tue, 4 Mar 2025 13:40:01 +0100
This patch replaces boilerplate in container related tests with
oci-image plumbing from (gnu services containers).
* gnu/services/containers.scm: Export lower-oci-image-state.
* gnu/tests/containers.scm (%oci-tarball): New variable;
(run-rootless-podman-test): use %oci-tarball;
(build-tarball&run-rootless-podman-test): drop procedure.
* gnu/tests/docker.scm (%docker-tarball): New variable;
(build-tarball&run-docker-test): use %docker-tarball;
(%docker-system-tarball): New variable;
(build-tarball&run-docker-system-test): new procedure.
Change-Id: Iad6f0704aee188d89464c83722dea0bb7adb084a
---
gnu/services/containers.scm | 2 +
gnu/tests/containers.scm | 80 ++++++++++++++---------------
gnu/tests/docker.scm | 100 ++++++++++++++++++++----------------
3 files changed, 95 insertions(+), 87 deletions(-)
diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm
index 4600846ac3d..57b14868f1a 100644
--- a/gnu/services/containers.scm
+++ b/gnu/services/containers.scm
@@ -75,6 +75,8 @@ (define-module (gnu services containers)
oci-image-system
oci-image-grafts?
+ lower-oci-image-state
+
oci-container-configuration
oci-container-configuration?
oci-container-configuration-fields
diff --git a/gnu/tests/containers.scm b/gnu/tests/containers.scm
index 5e6f39387e7..8cdd86e7ae3 100644
--- a/gnu/tests/containers.scm
+++ b/gnu/tests/containers.scm
@@ -69,13 +69,47 @@ (define %rootless-podman-os
(supplementary-groups '("wheel" "netdev" "cgroup"
"audio" "video")))))))
-(define (run-rootless-podman-test oci-tarball)
+(define %oci-tarball
+ (lower-oci-image-state
+ "guile-guest"
+ (packages->manifest
+ (list
+ guile-3.0 guile-json-3
+ (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))))
+ '(#:entry-point "bin/guile"
+ #:localstatedir? #t
+ #:extra-options (#:image-tag "guile-guest")
+ #:symlinks (("/bin/Guile" -> "bin/guile")
+ ("aa.scm" -> "a.scm")))
+ "guile-guest"
+ (%current-target-system)
+ (%current-system)
+ #f))
+
+(define (run-rootless-podman-test)
(define os
(marionette-operating-system
(operating-system-with-gc-roots
%rootless-podman-os
- (list oci-tarball))
+ (list %oci-tarball))
#:imported-modules '((gnu services herd)
(guix combinators))))
@@ -254,7 +288,7 @@ (define (run-rootless-podman-test oci-tarball)
(let* ((loaded (slurp ,(string-append #$podman
"/bin/podman")
"load" "-i"
- ,#$oci-tarball))
+ ,#$%oci-tarball))
(repository&tag "localhost/guile-guest:latest")
(response1 (slurp
,(string-append #$podman "/bin/podman")
@@ -307,49 +341,11 @@ (define (run-rootless-podman-test oci-tarball)
(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))))
+ (value (run-rootless-podman-test))))
(define %oci-rootless-podman-os
diff --git a/gnu/tests/docker.scm b/gnu/tests/docker.scm
index 5dcf05a17e3..07edd9d5341 100644
--- a/gnu/tests/docker.scm
+++ b/gnu/tests/docker.scm
@@ -26,6 +26,7 @@ (define-module (gnu tests docker)
#:use-module (gnu system image)
#:use-module (gnu system vm)
#:use-module (gnu services)
+ #:use-module (gnu services containers)
#:use-module (gnu services dbus)
#:use-module (gnu services networking)
#:use-module (gnu services docker)
@@ -57,6 +58,40 @@ (define %docker-os
(service containerd-service-type)
(service docker-service-type)))
+(define %docker-tarball
+ (lower-oci-image-state
+ "guile-guest"
+ (packages->manifest
+ (list
+ guile-3.0 guile-json-3
+ (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))))
+ '(#:entry-point "bin/guile"
+ #:localstatedir? #t
+ #:extra-options (#:image-tag "guile-guest")
+ #:symlinks (("/bin/Guile" -> "bin/guile")
+ ("aa.scm" -> "a.scm")))
+ "guile-guest"
+ (%current-target-system)
+ (%current-system)
+ #f))
+
(define (run-docker-test docker-tarball)
"Load DOCKER-TARBALL as Docker image and run it in a Docker container,
inside %DOCKER-OS."
@@ -173,40 +208,7 @@ (define (run-docker-test docker-tarball)
(gexp->derivation "docker-test" test))
(define (build-tarball&run-docker-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"))
- #:entry-point "bin/guile"
- #:localstatedir? #t)))
- (run-docker-test tarball)))
+ (run-docker-test %docker-tarball))
(define %test-docker
(system-test
@@ -215,8 +217,22 @@ (define %test-docker
(value (build-tarball&run-docker-test))))
+(define %docker-system-tarball
+ (lower-oci-image-state
+ "guix-system-guest"
+ (operating-system
+ (inherit (simple-operating-system))
+ ;; Use locales for a single libc to
+ ;; reduce space requirements.
+ (locale-libcs (list glibc)))
+ '()
+ "guix-system-guest"
+ (%current-target-system)
+ (%current-system)
+ #f))
+
(define (run-docker-system-test tarball)
- "Load DOCKER-TARBALL as Docker image and run it in a Docker container,
+ "Load TARBALL as Docker image and run it in a Docker container,
inside %DOCKER-OS."
(define os
(marionette-operating-system
@@ -333,21 +349,15 @@ (define (run-docker-system-test tarball)
(gexp->derivation "docker-system-test" test))
+(define (build-tarball&run-docker-system-test)
+ (run-docker-system-test %docker-system-tarball))
+
(define %test-docker-system
(system-test
(name "docker-system")
(description "Run a system image as produced by @command{guix system
docker-image} inside Docker.")
- (value (with-monad %store-monad
- (>>= (lower-object
- (system-image (os->image
- (operating-system
- (inherit (simple-operating-system))
- ;; Use locales for a single libc to
- ;; reduce space requirements.
- (locale-libcs (list glibc)))
- #:type docker-image-type)))
- run-docker-system-test)))))
+ (value (build-tarball&run-docker-system-test))))
(define %oci-os
--
2.48.1
guix-patches <at> gnu.org:bug#76081; Package guix-patches.
(Tue, 04 Mar 2025 12:42:02 GMT) Full text and rfc822 format available.Message #110 received at 76081 <at> debbugs.gnu.org (full text, mbox):
From: Giacomo Leidi <goodoldpaul <at> autistici.org> To: 76081 <at> debbugs.gnu.org Cc: Giacomo Leidi <goodoldpaul <at> autistici.org> Subject: [PATCH v7 1/5] services: rootless-podman: Use login shell. Date: Tue, 4 Mar 2025 13:39:58 +0100
This commit allows for having PATH set when changing the owner of
/sys/fs/group.
* gnu/services/containers.scm (crgroups-fs-owner): Use login shell.
Change-Id: I9510c637a5332325e05ca5ebc9dfd4de32685c50
---
gnu/services/containers.scm | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm
index b3cd109ce6c..d5a211765a6 100644
--- a/gnu/services/containers.scm
+++ b/gnu/services/containers.scm
@@ -140,7 +140,7 @@ (define (cgroups-fs-owner-entrypoint config)
(rootless-podman-configuration-group-name config))
(program-file "cgroups2-fs-owner-entrypoint"
#~(system*
- (string-append #+bash-minimal "/bin/bash") "-c"
+ (string-append #+bash-minimal "/bin/bash") "-l" "-c"
(string-append "echo Setting /sys/fs/cgroup "
"group ownership to " #$group " && chown -v "
"root:" #$group " /sys/fs/cgroup && "
base-commit: 72923a75af53a819f2be9dc4ae3c096aa3147d3f
--
2.48.1
andrew <at> trop.in, janneke <at> gnu.org, ludo <at> gnu.org, maxim.cournoyer <at> gmail.com, tanguy <at> bioneland.org, guix-patches <at> gnu.org:bug#76081; Package guix-patches.
(Tue, 04 Mar 2025 12:42:03 GMT) Full text and rfc822 format available.Message #113 received at 76081 <at> debbugs.gnu.org (full text, mbox):
From: Giacomo Leidi <goodoldpaul <at> autistici.org> To: 76081 <at> debbugs.gnu.org Cc: Giacomo Leidi <goodoldpaul <at> autistici.org> Subject: [PATCH v7 5/5] home: Add home-oci-service-type. Date: Tue, 4 Mar 2025 13:40:02 +0100
* gnu/home/service/containers.scm: New file;
* gnu/local.mk (GNU_SYSTEM_MODULES): Add it.
* doc/guix.texi (OCI backed services): Document it.
Change-Id: I8ce5b301e8032d0a7b2a9ca46752738cdee1f030
---
doc/guix.texi | 114 +++++++++++++++++++++++++++++++
gnu/home/services/containers.scm | 50 ++++++++++++++
gnu/local.mk | 1 +
3 files changed, 165 insertions(+)
create mode 100644 gnu/home/services/containers.scm
diff --git a/doc/guix.texi b/doc/guix.texi
index be5c8cf8fad..6c09f929049 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -50288,6 +50288,120 @@ Miscellaneous Home Services
(dicod-configuration @dots{})))
@end lisp
+@subsubheading OCI backed services
+
+@cindex OCI-backed, for Home
+The @code{(gnu home services containers)} module provides the following service:
+
+@defvar home-oci-service-type
+This is the type of the service that allows to manage your OCI containers with
+the same consistent interface you use for your other Home Shepherd services.
+@end defvar
+
+This service is a direct mapping of the @code{oci-service-type} system
+service (@pxref{Miscellaneous Services, OCI backed services}). You can
+use it like this:
+
+@lisp
+(use-modules (gnu services containers)
+ (gnu home services containers))
+
+(simple-service 'home-oci-provisioning
+ home-oci-service-type
+ (oci-extension
+ (volumes
+ (list
+ (oci-volume-configuration (name "prometheus"))
+ (oci-volume-configuration (name "grafana"))))
+ (networks
+ (list
+ (oci-network-configuration (name "monitoring"))))
+ (containers
+ (list
+ (oci-container-configuration
+ (network "monitoring")
+ (image
+ (oci-image
+ (repository "guile")
+ (tag "3")
+ (value (specifications->manifest '("guile")))
+ (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile"))
+ #:max-layers 2))))
+ (entrypoint "/bin/guile")
+ (command
+ '("-c" "(display \"hello!\n\")")))
+ (oci-container-configuration
+ (image "prom/prometheus")
+ (network "monitoring")
+ (ports
+ '(("9000" . "9000")
+ ("9090" . "9090")))
+ (volumes
+ (list
+ '(("prometheus" . "/var/lib/prometheus")))))
+ (oci-container-configuration
+ (image "grafana/grafana:10.0.1")
+ (network "monitoring")
+ (volumes
+ '(("grafana:/var/lib/grafana"))))))))
+
+@end lisp
+
+You may specify a custom configuration by providing a
+@code{oci-configuration} record, exactly like for
+@code{oci-service-type}, but wrapping it in @code{for-home}:
+
+@lisp
+(use-modules (gnu services)
+ (gnu services containers)
+ (gnu home services containers))
+
+(service home-oci-service-type
+ (for-home
+ (oci-configuration
+ (runtime 'podman)
+ (verbose? #t))))
+
+(simple-service 'home-oci-provisioning
+ home-oci-service-type
+ (oci-extension
+ (volumes
+ (list
+ (oci-volume-configuration (name "prometheus"))
+ (oci-volume-configuration (name "grafana"))))
+ (networks
+ (list
+ (oci-network-configuration (name "monitoring"))))
+ (containers
+ (list
+ (oci-container-configuration
+ (network "monitoring")
+ (image
+ (oci-image
+ (repository "guile")
+ (tag "3")
+ (value (specifications->manifest '("guile")))
+ (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile"))
+ #:max-layers 2))))
+ (entrypoint "/bin/guile")
+ (command
+ '("-c" "(display \"hello!\n\")")))
+ (oci-container-configuration
+ (image "prom/prometheus")
+ (network "monitoring")
+ (ports
+ '(("9000" . "9000")
+ ("9090" . "9090")))
+ (volumes
+ (list
+ '(("prometheus" . "/var/lib/prometheus")))))
+ (oci-container-configuration
+ (image "grafana/grafana:10.0.1")
+ (network "monitoring")
+ (volumes
+ '(("grafana:/var/lib/grafana"))))))))
+@end lisp
+
@node Invoking guix home
@section Invoking @command{guix home}
diff --git a/gnu/home/services/containers.scm b/gnu/home/services/containers.scm
new file mode 100644
index 00000000000..938dde2f37a
--- /dev/null
+++ b/gnu/home/services/containers.scm
@@ -0,0 +1,50 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2025 Giacomo Leidi <goodoldpaul <at> 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 home services containers)
+ #:use-module (gnu home services)
+ #:use-module (gnu home services shepherd)
+ #:use-module (gnu services)
+ #:use-module (gnu services configuration)
+ #:use-module (gnu services containers)
+ #:use-module (guix gexp)
+ #:use-module (guix packages)
+ #:use-module (srfi srfi-1)
+ #:export (home-oci-service-type))
+
+(define home-oci-service-type
+ (service-type (inherit (system->home-service-type oci-service-type))
+ (extensions
+ (list
+ (service-extension home-profile-service-type
+ (oci-service-extension-wrap-validate
+ (lambda (config)
+ (let ((runtime-cli
+ (oci-configuration-runtime-cli config))
+ (runtime
+ (oci-configuration-runtime config)))
+ (oci-service-profile runtime runtime-cli)))))
+ (service-extension home-shepherd-service-type
+ (oci-service-extension-wrap-validate
+ oci-configuration->shepherd-services))))
+ (extend
+ (lambda (config extension)
+ (for-home
+ (oci-configuration
+ (inherit (oci-configuration-extend config extension))))))
+ (default-value (for-home (oci-configuration)))))
diff --git a/gnu/local.mk b/gnu/local.mk
index a7a3238669d..d48e767154c 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -103,6 +103,7 @@ GNU_SYSTEM_MODULES = \
%D%/home.scm \
%D%/home/services.scm \
%D%/home/services/admin.scm \
+ %D%/home/services/containers.scm \
%D%/home/services/desktop.scm \
%D%/home/services/dict.scm \
%D%/home/services/dotfiles.scm \
--
2.48.1
guix-patches <at> gnu.org:bug#76081; Package guix-patches.
(Tue, 04 Mar 2025 12:42:03 GMT) Full text and rfc822 format available.Message #116 received at 76081 <at> debbugs.gnu.org (full text, mbox):
From: Giacomo Leidi <goodoldpaul <at> autistici.org> To: 76081 <at> debbugs.gnu.org Cc: Giacomo Leidi <goodoldpaul <at> autistici.org> Subject: [PATCH v7 2/5] services: oci-container-configuration: Move to (gnu services containers). Date: Tue, 4 Mar 2025 13:39:59 +0100
This patch moves the oci-container-configuration and related
configuration records to (gnu services containers).
Public symbols are still exported for backwards
compatibility but since the oci-container-service-type will be
deprecated in favor of the more general oci-service-type, everything is
moved outside of the docker related module.
* gnu/services/docker.scm: Move everything related to oci-container-configuration
to...
* gnu/services/containers.scm: ...here.scm.
* gnu/tests/docker.scm: Simplify %test-oci-container test case.
Change-Id: Iae599dd5cc7442eb632f0c1b3b12f6b928397ae7
---
gnu/services/containers.scm | 549 +++++++++++++++++++++++++++++++++-
gnu/services/docker.scm | 577 +++---------------------------------
gnu/tests/docker.scm | 99 +++----
3 files changed, 625 insertions(+), 600 deletions(-)
diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm
index d5a211765a6..24f31c756b8 100644
--- a/gnu/services/containers.scm
+++ b/gnu/services/containers.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2024 Giacomo Leidi <goodoldpaul <at> autistici.org>
+;;; Copyright © 2024, 2025 Giacomo Leidi <goodoldpaul <at> autistici.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -17,19 +17,31 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu services containers)
+ #:use-module (gnu image)
+ #:use-module (gnu packages admin)
#:use-module (gnu packages bash)
#:use-module (gnu packages containers)
+ #:use-module (gnu packages docker)
#: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)
#:use-module (gnu system accounts)
+ #:use-module (gnu system image)
#:use-module (gnu system shadow)
#:use-module (gnu system pam)
+ #:use-module (guix diagnostics)
#:use-module (guix gexp)
+ #:use-module (guix i18n)
+ #:use-module (guix monads)
#:use-module (guix packages)
+ #:use-module (guix profiles)
+ #:use-module ((guix scripts pack) #:prefix pack:)
+ #:use-module (guix store)
#:use-module (srfi srfi-1)
+ #:use-module (ice-9 match)
#:export (rootless-podman-configuration
rootless-podman-configuration?
rootless-podman-configuration-fields
@@ -48,7 +60,44 @@ (define-module (gnu services containers)
rootless-podman-shepherd-services
rootless-podman-service-etc
- rootless-podman-service-type))
+ rootless-podman-service-type
+
+ oci-image
+ oci-image?
+ oci-image-fields
+ oci-image-repository
+ oci-image-tag
+ oci-image-value
+ oci-image-pack-options
+ oci-image-target
+ oci-image-system
+ oci-image-grafts?
+
+ oci-container-configuration
+ oci-container-configuration?
+ oci-container-configuration-fields
+ oci-container-configuration-user
+ oci-container-configuration-group
+ oci-container-configuration-command
+ oci-container-configuration-entrypoint
+ oci-container-configuration-host-environment
+ oci-container-configuration-environment
+ oci-container-configuration-image
+ oci-container-configuration-provision
+ oci-container-configuration-requirement
+ oci-container-configuration-log-file
+ oci-container-configuration-auto-start?
+ oci-container-configuration-respawn?
+ oci-container-configuration-shepherd-actions
+ oci-container-configuration-network
+ oci-container-configuration-ports
+ oci-container-configuration-volumes
+ oci-container-configuration-container-user
+ oci-container-configuration-workdir
+ oci-container-configuration-extra-arguments
+
+ oci-container-shepherd-service
+ %oci-container-accounts))
(define (gexp-or-string? value)
(or (gexp? value)
@@ -190,7 +239,7 @@ (define (rootless-podman-cgroups-limits-service config)
rootless-podman-shared-root-fs))
(one-shot? #t)
(documentation
- "Allow setting cgroups limits: cpu, cpuset, memory and
+ "Allow setting cgroups limits: cpu, cpuset, io, memory and
pids.")
(start
#~(make-forkexec-constructor
@@ -244,3 +293,497 @@ (define rootless-podman-service-type
(default-value (rootless-podman-configuration))
(description
"This service configures rootless @code{podman} on the Guix System.")))
+
+
+;;;
+;;; OCI container.
+;;;
+
+(define (oci-sanitize-pair pair delimiter)
+ (define (valid? member)
+ (or (string? member)
+ (gexp? member)
+ (file-like? member)))
+ (match pair
+ (((? valid? key) . (? valid? value))
+ #~(string-append #$key #$delimiter #$value))
+ (_
+ (raise
+ (formatted-message
+ (G_ "pair members must contain only strings, gexps or file-like objects
+but ~a was found")
+ pair)))))
+
+(define (oci-sanitize-mixed-list name value delimiter)
+ (map
+ (lambda (el)
+ (cond ((string? el) el)
+ ((pair? el) (oci-sanitize-pair el delimiter))
+ (else
+ (raise
+ (formatted-message
+ (G_ "~a members must be either a string or a pair but ~a was
+found!")
+ name el)))))
+ value))
+
+(define (oci-sanitize-host-environment value)
+ ;; Expected spec format:
+ ;; '(("HOME" . "/home/nobody") "JAVA_HOME=/java")
+ (oci-sanitize-mixed-list "host-environment" value "="))
+
+(define (oci-sanitize-environment value)
+ ;; Expected spec format:
+ ;; '(("HOME" . "/home/nobody") "JAVA_HOME=/java")
+ (oci-sanitize-mixed-list "environment" value "="))
+
+(define (oci-sanitize-ports value)
+ ;; Expected spec format:
+ ;; '(("8088" . "80") "2022:22")
+ (oci-sanitize-mixed-list "ports" value ":"))
+
+(define (oci-sanitize-volumes value)
+ ;; Expected spec format:
+ ;; '(("/mnt/dir" . "/dir") "/run/current-system/profile:/java")
+ (oci-sanitize-mixed-list "volumes" value ":"))
+
+(define (oci-sanitize-shepherd-actions value)
+ (map
+ (lambda (el)
+ (if (shepherd-action? el)
+ el
+ (raise
+ (formatted-message
+ (G_ "shepherd-actions may only be shepherd-action records
+but ~a was found") el))))
+ value))
+
+(define (oci-sanitize-extra-arguments value)
+ (define (valid? member)
+ (or (string? member)
+ (gexp? member)
+ (file-like? member)))
+ (map
+ (lambda (el)
+ (if (valid? el)
+ el
+ (raise
+ (formatted-message
+ (G_ "extra arguments may only be strings, gexps or file-like objects
+but ~a was found") el))))
+ value))
+
+(define (oci-image-reference image)
+ (if (string? image)
+ image
+ (string-append (oci-image-repository image)
+ ":" (oci-image-tag image))))
+
+(define (oci-lowerable-image? image)
+ (or (manifest? image)
+ (operating-system? image)
+ (gexp? image)
+ (file-like? image)))
+
+(define (string-or-oci-image? image)
+ (or (string? image)
+ (oci-image? image)))
+
+(define list-of-symbols?
+ (list-of symbol?))
+
+(define-maybe/no-serialization string)
+
+(define-configuration/no-serialization oci-image
+ (repository
+ (string)
+ "A string like @code{myregistry.local:5000/testing/test-image} that names
+the OCI image.")
+ (tag
+ (string "latest")
+ "A string representing the OCI image tag. Defaults to @code{latest}.")
+ (value
+ (oci-lowerable-image)
+ "A @code{manifest} or @code{operating-system} record that will be lowered
+into an OCI compatible tarball. Otherwise this field's value can be a gexp
+or a file-like object that evaluates to an OCI compatible tarball.")
+ (pack-options
+ (list '())
+ "An optional set of keyword arguments that will be passed to the
+@code{docker-image} procedure from @code{guix scripts pack}. They can be used
+to replicate @command{guix pack} behavior:
+
+@lisp
+(oci-image
+ (repository \"guile\")
+ (tag \"3\")
+ (manifest (specifications->manifest '(\"guile\")))
+ (pack-options
+ '(#:symlinks ((\"/bin/guile\" -> \"bin/guile\"))
+ #:max-layers 2)))
+@end lisp
+
+If the @code{value} field is an @code{operating-system} record, this field's
+value will be ignored.")
+ (system
+ (maybe-string)
+ "Attempt to build for a given system, e.g. \"i686-linux\"")
+ (target
+ (maybe-string)
+ "Attempt to cross-build for a given triple, e.g. \"aarch64-linux-gnu\"")
+ (grafts?
+ (boolean #f)
+ "Whether to allow grafting or not in the pack build."))
+
+(define-configuration/no-serialization oci-container-configuration
+ (user
+ (string "oci-container")
+ "The user under whose authority docker commands will be run.")
+ (group
+ (string "docker")
+ "The group under whose authority docker commands will be run.")
+ (command
+ (list-of-strings '())
+ "Overwrite the default command (@code{CMD}) of the image.")
+ (entrypoint
+ (maybe-string)
+ "Overwrite the default entrypoint (@code{ENTRYPOINT}) of the image.")
+ (host-environment
+ (list '())
+ "Set environment variables in the host environment where @command{docker run}
+is invoked. This is especially useful to pass secrets from the host to the
+container without having them on the @command{docker run}'s command line: by
+setting the @code{MYSQL_PASSWORD} on the host and by passing
+@code{--env MYSQL_PASSWORD} through the @code{extra-arguments} field, it is
+possible to securely set values in the container environment. This field's
+value can be a list of pairs or strings, even mixed:
+
+@lisp
+(list '(\"LANGUAGE\" . \"eo:ca:eu\")
+ \"JAVA_HOME=/opt/java\")
+@end lisp
+
+Pair members can be strings, gexps or file-like objects. Strings are passed
+directly to @code{make-forkexec-constructor}."
+ (sanitizer oci-sanitize-host-environment))
+ (environment
+ (list '())
+ "Set environment variables inside the container. This can be a list of pairs
+or strings, even mixed:
+
+@lisp
+(list '(\"LANGUAGE\" . \"eo:ca:eu\")
+ \"JAVA_HOME=/opt/java\")
+@end lisp
+
+Pair members can be strings, gexps or file-like objects. Strings are passed
+directly to the Docker CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#env,upstream}
+documentation for semantics."
+ (sanitizer oci-sanitize-environment))
+ (image
+ (string-or-oci-image)
+ "The image used to build the container. It can be a string or an
+@code{oci-image} record. Strings are resolved by the Docker
+Engine, and follow the usual format
+@code{myregistry.local:5000/testing/test-image:tag}.")
+ (provision
+ (maybe-string)
+ "Set the name of the provisioned Shepherd service.")
+ (requirement
+ (list-of-symbols '())
+ "Set additional Shepherd services dependencies to the provisioned Shepherd
+service.")
+ (log-file
+ (maybe-string)
+ "When @code{log-file} is set, it names the file to which the service’s
+standard output and standard error are redirected. @code{log-file} is created
+if it does not exist, otherwise it is appended to.")
+ (auto-start?
+ (boolean #t)
+ "Whether this service should be started automatically by the Shepherd. If it
+is @code{#f} the service has to be started manually with @command{herd start}.")
+ (respawn?
+ (boolean #f)
+ "Whether to restart the service when it stops, for instance when the
+underlying process dies.")
+ (shepherd-actions
+ (list '())
+ "This is a list of @code{shepherd-action} records defining actions supported
+by the service."
+ (sanitizer oci-sanitize-shepherd-actions))
+ (network
+ (maybe-string)
+ "Set a Docker network for the spawned container.")
+ (ports
+ (list '())
+ "Set the port or port ranges to expose from the spawned container. This can
+be a list of pairs or strings, even mixed:
+
+@lisp
+(list '(\"8080\" . \"80\")
+ \"10443:443\")
+@end lisp
+
+Pair members can be strings, gexps or file-like objects. Strings are passed
+directly to the Docker CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#publish,upstream}
+documentation for semantics."
+ (sanitizer oci-sanitize-ports))
+ (volumes
+ (list '())
+ "Set volume mappings for the spawned container. This can be a
+list of pairs or strings, even mixed:
+
+@lisp
+(list '(\"/root/data/grafana\" . \"/var/lib/grafana\")
+ \"/gnu/store:/gnu/store\")
+@end lisp
+
+Pair members can be strings, gexps or file-like objects. Strings are passed
+directly to the Docker CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#volume,upstream}
+documentation for semantics."
+ (sanitizer oci-sanitize-volumes))
+ (container-user
+ (maybe-string)
+ "Set the current user inside the spawned container. You can refer to the
+@url{https://docs.docker.com/engine/reference/run/#user,upstream}
+documentation for semantics.")
+ (workdir
+ (maybe-string)
+ "Set the current working for the spawned Shepherd service.
+You can refer to the
+@url{https://docs.docker.com/engine/reference/run/#workdir,upstream}
+documentation for semantics.")
+ (extra-arguments
+ (list '())
+ "A list of strings, gexps or file-like objects that will be directly passed
+to the @command{docker run} invokation."
+ (sanitizer oci-sanitize-extra-arguments)))
+
+(define oci-container-configuration->options
+ (lambda (config)
+ (let ((entrypoint
+ (oci-container-configuration-entrypoint config))
+ (network
+ (oci-container-configuration-network config))
+ (user
+ (oci-container-configuration-container-user config))
+ (workdir
+ (oci-container-configuration-workdir config)))
+ (apply append
+ (filter (compose not unspecified?)
+ `(,(if (maybe-value-set? entrypoint)
+ `("--entrypoint" ,entrypoint)
+ '())
+ ,(append-map
+ (lambda (spec)
+ (list "--env" spec))
+ (oci-container-configuration-environment config))
+ ,(if (maybe-value-set? network)
+ `("--network" ,network)
+ '())
+ ,(if (maybe-value-set? user)
+ `("--user" ,user)
+ '())
+ ,(if (maybe-value-set? workdir)
+ `("--workdir" ,workdir)
+ '())
+ ,(append-map
+ (lambda (spec)
+ (list "-p" spec))
+ (oci-container-configuration-ports config))
+ ,(append-map
+ (lambda (spec)
+ (list "-v" spec))
+ (oci-container-configuration-volumes config))))))))
+
+(define* (get-keyword-value args keyword #:key (default #f))
+ (let ((kv (memq keyword args)))
+ (if (and kv (>= (length kv) 2))
+ (cadr kv)
+ default)))
+
+(define (lower-operating-system os target system)
+ (mlet* %store-monad
+ ((tarball
+ (lower-object
+ (system-image (os->image os #:type docker-image-type))
+ system
+ #:target target)))
+ (return tarball)))
+
+(define (lower-manifest name image target system)
+ (define value (oci-image-value image))
+ (define options (oci-image-pack-options image))
+ (define image-reference
+ (oci-image-reference image))
+ (define image-tag
+ (let* ((extra-options
+ (get-keyword-value options #:extra-options))
+ (image-tag-option
+ (and extra-options
+ (get-keyword-value extra-options #:image-tag))))
+ (if image-tag-option
+ '()
+ `(#:extra-options (#:image-tag ,image-reference)))))
+
+ (mlet* %store-monad
+ ((_ (set-grafting
+ (oci-image-grafts? image)))
+ (guile (set-guile-for-build (default-guile)))
+ (profile
+ (profile-derivation value
+ #:target target
+ #:system system
+ #:hooks '()
+ #:locales? #f))
+ (tarball (apply pack:docker-image
+ `(,name ,profile
+ ,@options
+ ,@image-tag
+ #:localstatedir? #t))))
+ (return tarball)))
+
+(define (lower-oci-image name image)
+ (define value (oci-image-value image))
+ (define image-target (oci-image-target image))
+ (define image-system (oci-image-system image))
+ (define target
+ (if (maybe-value-set? image-target)
+ image-target
+ (%current-target-system)))
+ (define system
+ (if (maybe-value-set? image-system)
+ image-system
+ (%current-system)))
+ (with-store store
+ (run-with-store store
+ (match value
+ ((? manifest? value)
+ (lower-manifest name image target system))
+ ((? operating-system? value)
+ (lower-operating-system value target system))
+ ((or (? gexp? value)
+ (? file-like? value))
+ value)
+ (_
+ (raise
+ (formatted-message
+ (G_ "oci-image value must contain only manifest,
+operating-system, gexp or file-like records but ~a was found")
+ value))))
+ #:target target
+ #:system system)))
+
+(define (%oci-image-loader name image tag)
+ (let ((docker (file-append docker-cli "/bin/docker"))
+ (tarball (lower-oci-image name image)))
+ (with-imported-modules '((guix build utils))
+ (program-file (format #f "~a-image-loader" name)
+ #~(begin
+ (use-modules (guix build utils)
+ (ice-9 popen)
+ (ice-9 rdelim))
+
+ (format #t "Loading image for ~a from ~a...~%" #$name #$tarball)
+ (define line
+ (read-line
+ (open-input-pipe
+ (string-append #$docker " load -i " #$tarball))))
+
+ (unless (or (eof-object? line)
+ (string-null? line))
+ (format #t "~a~%" line)
+ (let ((repository&tag
+ (string-drop line
+ (string-length
+ "Loaded image: "))))
+
+ (invoke #$docker "tag" repository&tag #$tag)
+ (format #t "Tagged ~a with ~a...~%" #$tarball #$tag))))))))
+
+(define (oci-container-shepherd-service config)
+ (define (guess-name name image)
+ (if (maybe-value-set? name)
+ name
+ (string-append "docker-"
+ (basename
+ (if (string? image)
+ (first (string-split image #\:))
+ (oci-image-repository image))))))
+
+ (let* ((docker (file-append docker-cli "/bin/docker"))
+ (actions (oci-container-configuration-shepherd-actions config))
+ (auto-start?
+ (oci-container-configuration-auto-start? config))
+ (user (oci-container-configuration-user config))
+ (group (oci-container-configuration-group config))
+ (host-environment
+ (oci-container-configuration-host-environment config))
+ (command (oci-container-configuration-command config))
+ (log-file (oci-container-configuration-log-file config))
+ (provision (oci-container-configuration-provision config))
+ (requirement (oci-container-configuration-requirement config))
+ (respawn?
+ (oci-container-configuration-respawn? config))
+ (image (oci-container-configuration-image config))
+ (image-reference (oci-image-reference image))
+ (options (oci-container-configuration->options config))
+ (name (guess-name provision image))
+ (extra-arguments
+ (oci-container-configuration-extra-arguments config)))
+
+ (shepherd-service (provision `(,(string->symbol name)))
+ (requirement `(dockerd user-processes ,@requirement))
+ (respawn? respawn?)
+ (auto-start? auto-start?)
+ (documentation
+ (string-append
+ "Docker backed Shepherd service for "
+ (if (oci-image? image) name image) "."))
+ (start
+ #~(lambda ()
+ #$@(if (oci-image? image)
+ #~((invoke #$(%oci-image-loader
+ name image image-reference)))
+ #~())
+ (fork+exec-command
+ ;; docker run [OPTIONS] IMAGE [COMMAND] [ARG...]
+ (list #$docker "run" "--rm" "--name" #$name
+ #$@options #$@extra-arguments
+ #$image-reference #$@command)
+ #:user #$user
+ #:group #$group
+ #$@(if (maybe-value-set? log-file)
+ (list #:log-file log-file)
+ '())
+ #:environment-variables
+ (list #$@host-environment))))
+ (stop
+ #~(lambda _
+ (invoke #$docker "rm" "-f" #$name)))
+ (actions
+ (if (oci-image? image)
+ '()
+ (append
+ (list
+ (shepherd-action
+ (name 'pull)
+ (documentation
+ (format #f "Pull ~a's image (~a)."
+ name image))
+ (procedure
+ #~(lambda _
+ (invoke #$docker "pull" #$image)))))
+ actions))))))
+
+(define %oci-container-accounts
+ (list (user-account
+ (name "oci-container")
+ (comment "OCI services account")
+ (group "docker")
+ (system? #t)
+ (home-directory "/var/empty")
+ (shell (file-append shadow "/sbin/nologin")))))
diff --git a/gnu/services/docker.scm b/gnu/services/docker.scm
index 9ab3e583345..828ceea313a 100644
--- a/gnu/services/docker.scm
+++ b/gnu/services/docker.scm
@@ -5,7 +5,7 @@
;;; Copyright © 2020 Efraim Flashner <efraim <at> flashner.co.il>
;;; Copyright © 2020 Jesse Dowell <jessedowell <at> gmail.com>
;;; Copyright © 2021 Brice Waegeneire <brice <at> waegenei.re>
-;;; Copyright © 2023, 2024 Giacomo Leidi <goodoldpaul <at> autistici.org>
+;;; Copyright © 2023, 2024, 2025 Giacomo Leidi <goodoldpaul <at> autistici.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -23,72 +23,60 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu services docker)
- #:use-module (gnu image)
#:use-module (gnu services)
#:use-module (gnu services configuration)
- #:use-module (gnu services base)
- #:use-module (gnu services dbus)
+ #:use-module (gnu services containers)
#:use-module (gnu services shepherd)
- #:use-module (gnu system)
- #:use-module (gnu system image)
#:use-module (gnu system privilege)
#:use-module (gnu system shadow)
- #:use-module (gnu packages admin) ;shadow
#:use-module (gnu packages docker)
#:use-module (gnu packages linux) ;singularity
- #:use-module (guix records)
- #:use-module (guix diagnostics)
#:use-module (guix gexp)
- #:use-module (guix i18n)
- #:use-module (guix monads)
- #:use-module (guix packages)
- #:use-module (guix profiles)
- #:use-module ((guix scripts pack) #:prefix pack:)
- #:use-module (guix store)
+ #:use-module (guix records)
#:use-module (srfi srfi-1)
#:use-module (ice-9 format)
#:use-module (ice-9 match)
+ #:re-export (oci-image ;for backwards compatibility, until the
+ oci-image? ;oci-container-service-type is fully deprecated
+ oci-image-fields
+ oci-image-repository
+ oci-image-tag
+ oci-image-value
+ oci-image-pack-options
+ oci-image-target
+ oci-image-system
+ oci-image-grafts?
+ oci-container-configuration
+ oci-container-configuration?
+ oci-container-configuration-fields
+ oci-container-configuration-user
+ oci-container-configuration-group
+ oci-container-configuration-command
+ oci-container-configuration-entrypoint
+ oci-container-configuration-host-environment
+ oci-container-configuration-environment
+ oci-container-configuration-image
+ oci-container-configuration-provision
+ oci-container-configuration-requirement
+ oci-container-configuration-log-file
+ oci-container-configuration-auto-start?
+ oci-container-configuration-respawn?
+ oci-container-configuration-shepherd-actions
+ oci-container-configuration-network
+ oci-container-configuration-ports
+ oci-container-configuration-volumes
+ oci-container-configuration-container-user
+ oci-container-configuration-workdir
+ oci-container-configuration-extra-arguments
+ oci-container-shepherd-service
+ %oci-container-accounts)
#:export (containerd-configuration
containerd-service-type
docker-configuration
docker-service-type
singularity-service-type
- oci-image
- oci-image?
- oci-image-fields
- oci-image-repository
- oci-image-tag
- oci-image-value
- oci-image-pack-options
- oci-image-target
- oci-image-system
- oci-image-grafts?
- oci-container-configuration
- oci-container-configuration?
- oci-container-configuration-fields
- oci-container-configuration-user
- oci-container-configuration-group
- oci-container-configuration-command
- oci-container-configuration-entrypoint
- oci-container-configuration-host-environment
- oci-container-configuration-environment
- oci-container-configuration-image
- oci-container-configuration-provision
- oci-container-configuration-requirement
- oci-container-configuration-log-file
- oci-container-configuration-auto-start?
- oci-container-configuration-respawn?
- oci-container-configuration-shepherd-actions
- oci-container-configuration-network
- oci-container-configuration-ports
- oci-container-configuration-volumes
- oci-container-configuration-container-user
- oci-container-configuration-workdir
- oci-container-configuration-extra-arguments
- oci-container-service-type
- oci-container-shepherd-service
- %oci-container-accounts))
+ oci-container-service-type))
(define-maybe file-like)
@@ -309,495 +297,6 @@ (define singularity-service-type
;;; OCI container.
;;;
-(define (oci-sanitize-pair pair delimiter)
- (define (valid? member)
- (or (string? member)
- (gexp? member)
- (file-like? member)))
- (match pair
- (((? valid? key) . (? valid? value))
- #~(string-append #$key #$delimiter #$value))
- (_
- (raise
- (formatted-message
- (G_ "pair members must contain only strings, gexps or file-like objects
-but ~a was found")
- pair)))))
-
-(define (oci-sanitize-mixed-list name value delimiter)
- (map
- (lambda (el)
- (cond ((string? el) el)
- ((pair? el) (oci-sanitize-pair el delimiter))
- (else
- (raise
- (formatted-message
- (G_ "~a members must be either a string or a pair but ~a was
-found!")
- name el)))))
- value))
-
-(define (oci-sanitize-host-environment value)
- ;; Expected spec format:
- ;; '(("HOME" . "/home/nobody") "JAVA_HOME=/java")
- (oci-sanitize-mixed-list "host-environment" value "="))
-
-(define (oci-sanitize-environment value)
- ;; Expected spec format:
- ;; '(("HOME" . "/home/nobody") "JAVA_HOME=/java")
- (oci-sanitize-mixed-list "environment" value "="))
-
-(define (oci-sanitize-ports value)
- ;; Expected spec format:
- ;; '(("8088" . "80") "2022:22")
- (oci-sanitize-mixed-list "ports" value ":"))
-
-(define (oci-sanitize-volumes value)
- ;; Expected spec format:
- ;; '(("/mnt/dir" . "/dir") "/run/current-system/profile:/java")
- (oci-sanitize-mixed-list "volumes" value ":"))
-
-(define (oci-sanitize-shepherd-actions value)
- (map
- (lambda (el)
- (if (shepherd-action? el)
- el
- (raise
- (formatted-message
- (G_ "shepherd-actions may only be shepherd-action records
-but ~a was found") el))))
- value))
-
-(define (oci-sanitize-extra-arguments value)
- (define (valid? member)
- (or (string? member)
- (gexp? member)
- (file-like? member)))
- (map
- (lambda (el)
- (if (valid? el)
- el
- (raise
- (formatted-message
- (G_ "extra arguments may only be strings, gexps or file-like objects
-but ~a was found") el))))
- value))
-
-(define (oci-image-reference image)
- (if (string? image)
- image
- (string-append (oci-image-repository image)
- ":" (oci-image-tag image))))
-
-(define (oci-lowerable-image? image)
- (or (manifest? image)
- (operating-system? image)
- (gexp? image)
- (file-like? image)))
-
-(define (string-or-oci-image? image)
- (or (string? image)
- (oci-image? image)))
-
-(define list-of-symbols?
- (list-of symbol?))
-
-(define-maybe/no-serialization string)
-
-(define-configuration/no-serialization oci-image
- (repository
- (string)
- "A string like @code{myregistry.local:5000/testing/test-image} that names
-the OCI image.")
- (tag
- (string "latest")
- "A string representing the OCI image tag. Defaults to @code{latest}.")
- (value
- (oci-lowerable-image)
- "A @code{manifest} or @code{operating-system} record that will be lowered
-into an OCI compatible tarball. Otherwise this field's value can be a gexp
-or a file-like object that evaluates to an OCI compatible tarball.")
- (pack-options
- (list '())
- "An optional set of keyword arguments that will be passed to the
-@code{docker-image} procedure from @code{guix scripts pack}. They can be used
-to replicate @command{guix pack} behavior:
-
-@lisp
-(oci-image
- (repository \"guile\")
- (tag \"3\")
- (manifest (specifications->manifest '(\"guile\")))
- (pack-options
- '(#:symlinks ((\"/bin/guile\" -> \"bin/guile\"))
- #:max-layers 2)))
-@end lisp
-
-If the @code{value} field is an @code{operating-system} record, this field's
-value will be ignored.")
- (system
- (maybe-string)
- "Attempt to build for a given system, e.g. \"i686-linux\"")
- (target
- (maybe-string)
- "Attempt to cross-build for a given triple, e.g. \"aarch64-linux-gnu\"")
- (grafts?
- (boolean #f)
- "Whether to allow grafting or not in the pack build."))
-
-(define-configuration/no-serialization oci-container-configuration
- (user
- (string "oci-container")
- "The user under whose authority docker commands will be run.")
- (group
- (string "docker")
- "The group under whose authority docker commands will be run.")
- (command
- (list-of-strings '())
- "Overwrite the default command (@code{CMD}) of the image.")
- (entrypoint
- (maybe-string)
- "Overwrite the default entrypoint (@code{ENTRYPOINT}) of the image.")
- (host-environment
- (list '())
- "Set environment variables in the host environment where @command{docker run}
-is invoked. This is especially useful to pass secrets from the host to the
-container without having them on the @command{docker run}'s command line: by
-setting the @code{MYSQL_PASSWORD} on the host and by passing
-@code{--env MYSQL_PASSWORD} through the @code{extra-arguments} field, it is
-possible to securely set values in the container environment. This field's
-value can be a list of pairs or strings, even mixed:
-
-@lisp
-(list '(\"LANGUAGE\" . \"eo:ca:eu\")
- \"JAVA_HOME=/opt/java\")
-@end lisp
-
-Pair members can be strings, gexps or file-like objects. Strings are passed
-directly to @code{make-forkexec-constructor}."
- (sanitizer oci-sanitize-host-environment))
- (environment
- (list '())
- "Set environment variables inside the container. This can be a list of pairs
-or strings, even mixed:
-
-@lisp
-(list '(\"LANGUAGE\" . \"eo:ca:eu\")
- \"JAVA_HOME=/opt/java\")
-@end lisp
-
-Pair members can be strings, gexps or file-like objects. Strings are passed
-directly to the Docker CLI. You can refer to the
-@url{https://docs.docker.com/engine/reference/commandline/run/#env,upstream}
-documentation for semantics."
- (sanitizer oci-sanitize-environment))
- (image
- (string-or-oci-image)
- "The image used to build the container. It can be a string or an
-@code{oci-image} record. Strings are resolved by the Docker
-Engine, and follow the usual format
-@code{myregistry.local:5000/testing/test-image:tag}.")
- (provision
- (maybe-string)
- "Set the name of the provisioned Shepherd service.")
- (requirement
- (list-of-symbols '())
- "Set additional Shepherd services dependencies to the provisioned Shepherd
-service.")
- (log-file
- (maybe-string)
- "When @code{log-file} is set, it names the file to which the service’s
-standard output and standard error are redirected. @code{log-file} is created
-if it does not exist, otherwise it is appended to.")
- (auto-start?
- (boolean #t)
- "Whether this service should be started automatically by the Shepherd. If it
-is @code{#f} the service has to be started manually with @command{herd start}.")
- (respawn?
- (boolean #f)
- "Whether to restart the service when it stops, for instance when the
-underlying process dies.")
- (shepherd-actions
- (list '())
- "This is a list of @code{shepherd-action} records defining actions supported
-by the service."
- (sanitizer oci-sanitize-shepherd-actions))
- (network
- (maybe-string)
- "Set a Docker network for the spawned container.")
- (ports
- (list '())
- "Set the port or port ranges to expose from the spawned container. This can
-be a list of pairs or strings, even mixed:
-
-@lisp
-(list '(\"8080\" . \"80\")
- \"10443:443\")
-@end lisp
-
-Pair members can be strings, gexps or file-like objects. Strings are passed
-directly to the Docker CLI. You can refer to the
-@url{https://docs.docker.com/engine/reference/commandline/run/#publish,upstream}
-documentation for semantics."
- (sanitizer oci-sanitize-ports))
- (volumes
- (list '())
- "Set volume mappings for the spawned container. This can be a
-list of pairs or strings, even mixed:
-
-@lisp
-(list '(\"/root/data/grafana\" . \"/var/lib/grafana\")
- \"/gnu/store:/gnu/store\")
-@end lisp
-
-Pair members can be strings, gexps or file-like objects. Strings are passed
-directly to the Docker CLI. You can refer to the
-@url{https://docs.docker.com/engine/reference/commandline/run/#volume,upstream}
-documentation for semantics."
- (sanitizer oci-sanitize-volumes))
- (container-user
- (maybe-string)
- "Set the current user inside the spawned container. You can refer to the
-@url{https://docs.docker.com/engine/reference/run/#user,upstream}
-documentation for semantics.")
- (workdir
- (maybe-string)
- "Set the current working for the spawned Shepherd service.
-You can refer to the
-@url{https://docs.docker.com/engine/reference/run/#workdir,upstream}
-documentation for semantics.")
- (extra-arguments
- (list '())
- "A list of strings, gexps or file-like objects that will be directly passed
-to the @command{docker run} invocation."
- (sanitizer oci-sanitize-extra-arguments)))
-
-(define oci-container-configuration->options
- (lambda (config)
- (let ((entrypoint
- (oci-container-configuration-entrypoint config))
- (network
- (oci-container-configuration-network config))
- (user
- (oci-container-configuration-container-user config))
- (workdir
- (oci-container-configuration-workdir config)))
- (apply append
- (filter (compose not unspecified?)
- `(,(if (maybe-value-set? entrypoint)
- `("--entrypoint" ,entrypoint)
- '())
- ,(append-map
- (lambda (spec)
- (list "--env" spec))
- (oci-container-configuration-environment config))
- ,(if (maybe-value-set? network)
- `("--network" ,network)
- '())
- ,(if (maybe-value-set? user)
- `("--user" ,user)
- '())
- ,(if (maybe-value-set? workdir)
- `("--workdir" ,workdir)
- '())
- ,(append-map
- (lambda (spec)
- (list "-p" spec))
- (oci-container-configuration-ports config))
- ,(append-map
- (lambda (spec)
- (list "-v" spec))
- (oci-container-configuration-volumes config))))))))
-
-(define* (get-keyword-value args keyword #:key (default #f))
- (let ((kv (memq keyword args)))
- (if (and kv (>= (length kv) 2))
- (cadr kv)
- default)))
-
-(define (lower-operating-system os target system)
- (mlet* %store-monad
- ((tarball
- (lower-object
- (system-image (os->image os #:type docker-image-type))
- system
- #:target target)))
- (return tarball)))
-
-(define (lower-manifest name image target system)
- (define value (oci-image-value image))
- (define options (oci-image-pack-options image))
- (define image-reference
- (oci-image-reference image))
- (define image-tag
- (let* ((extra-options
- (get-keyword-value options #:extra-options))
- (image-tag-option
- (and extra-options
- (get-keyword-value extra-options #:image-tag))))
- (if image-tag-option
- '()
- `(#:extra-options (#:image-tag ,image-reference)))))
-
- (mlet* %store-monad
- ((_ (set-grafting
- (oci-image-grafts? image)))
- (guile (set-guile-for-build (default-guile)))
- (profile
- (profile-derivation value
- #:target target
- #:system system
- #:hooks '()
- #:locales? #f))
- (tarball (apply pack:docker-image
- `(,name ,profile
- ,@options
- ,@image-tag
- #:localstatedir? #t))))
- (return tarball)))
-
-(define (lower-oci-image name image)
- (define value (oci-image-value image))
- (define image-target (oci-image-target image))
- (define image-system (oci-image-system image))
- (define target
- (if (maybe-value-set? image-target)
- image-target
- (%current-target-system)))
- (define system
- (if (maybe-value-set? image-system)
- image-system
- (%current-system)))
- (with-store store
- (run-with-store store
- (match value
- ((? manifest? value)
- (lower-manifest name image target system))
- ((? operating-system? value)
- (lower-operating-system value target system))
- ((or (? gexp? value)
- (? file-like? value))
- value)
- (_
- (raise
- (formatted-message
- (G_ "oci-image value must contain only manifest,
-operating-system, gexp or file-like records but ~a was found")
- value))))
- #:target target
- #:system system)))
-
-(define (%oci-image-loader name image tag)
- (let ((docker (file-append docker-cli "/bin/docker"))
- (tarball (lower-oci-image name image)))
- (with-imported-modules '((guix build utils))
- (program-file (format #f "~a-image-loader" name)
- #~(begin
- (use-modules (guix build utils)
- (ice-9 popen)
- (ice-9 rdelim))
-
- (format #t "Loading image for ~a from ~a...~%" #$name #$tarball)
- (define line
- (read-line
- (open-input-pipe
- (string-append #$docker " load -i " #$tarball))))
-
- (unless (or (eof-object? line)
- (string-null? line))
- (format #t "~a~%" line)
- (let ((repository&tag
- (string-drop line
- (string-length
- "Loaded image: "))))
-
- (invoke #$docker "tag" repository&tag #$tag)
- (format #t "Tagged ~a with ~a...~%" #$tarball #$tag))))))))
-
-(define (oci-container-shepherd-service config)
- (define (guess-name name image)
- (if (maybe-value-set? name)
- name
- (string-append "docker-"
- (basename
- (if (string? image)
- (first (string-split image #\:))
- (oci-image-repository image))))))
-
- (let* ((docker (file-append docker-cli "/bin/docker"))
- (actions (oci-container-configuration-shepherd-actions config))
- (auto-start?
- (oci-container-configuration-auto-start? config))
- (user (oci-container-configuration-user config))
- (group (oci-container-configuration-group config))
- (host-environment
- (oci-container-configuration-host-environment config))
- (command (oci-container-configuration-command config))
- (log-file (oci-container-configuration-log-file config))
- (provision (oci-container-configuration-provision config))
- (requirement (oci-container-configuration-requirement config))
- (respawn?
- (oci-container-configuration-respawn? config))
- (image (oci-container-configuration-image config))
- (image-reference (oci-image-reference image))
- (options (oci-container-configuration->options config))
- (name (guess-name provision image))
- (extra-arguments
- (oci-container-configuration-extra-arguments config)))
-
- (shepherd-service (provision `(,(string->symbol name)))
- (requirement `(dockerd user-processes ,@requirement))
- (respawn? respawn?)
- (auto-start? auto-start?)
- (documentation
- (string-append
- "Docker backed Shepherd service for "
- (if (oci-image? image) name image) "."))
- (start
- #~(lambda ()
- #$@(if (oci-image? image)
- #~((invoke #$(%oci-image-loader
- name image image-reference)))
- #~())
- (fork+exec-command
- ;; docker run [OPTIONS] IMAGE [COMMAND] [ARG...]
- (list #$docker "run" "--rm" "--name" #$name
- #$@options #$@extra-arguments
- #$image-reference #$@command)
- #:user #$user
- #:group #$group
- #$@(if (maybe-value-set? log-file)
- (list #:log-file log-file)
- '())
- #:environment-variables
- (list #$@host-environment))))
- (stop
- #~(lambda _
- (invoke #$docker "rm" "-f" #$name)))
- (actions
- (if (oci-image? image)
- '()
- (append
- (list
- (shepherd-action
- (name 'pull)
- (documentation
- (format #f "Pull ~a's image (~a)."
- name image))
- (procedure
- #~(lambda _
- (invoke #$docker "pull" #$image)))))
- actions))))))
-
-(define %oci-container-accounts
- (list (user-account
- (name "oci-container")
- (comment "OCI services account")
- (group "docker")
- (system? #t)
- (home-directory "/var/empty")
- (shell (file-append shadow "/sbin/nologin")))))
-
(define (configs->shepherd-services configs)
(map oci-container-shepherd-service configs))
diff --git a/gnu/tests/docker.scm b/gnu/tests/docker.scm
index 90c8d0f8508..5dcf05a17e3 100644
--- a/gnu/tests/docker.scm
+++ b/gnu/tests/docker.scm
@@ -1,7 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019 Danny Milosavljevic <dannym <at> scratchpost.org>
;;; Copyright © 2019-2023 Ludovic Courtès <ludo <at> gnu.org>
-;;; Copyright © 2024 Giacomo Leidi <goodoldpaul <at> autistici.org>
+;;; Copyright © 2024, 2025 Giacomo Leidi <goodoldpaul <at> autistici.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -414,71 +414,54 @@ (define (run-oci-container-test)
(test-runner-current (system-test-runner #$output))
(test-begin "oci-container")
- (test-assert "containerd service running"
- (marionette-eval
- '(begin
- (use-modules (gnu services herd))
- (match (start-service 'containerd)
- (#f #f)
- (('service response-parts ...)
- (match (assq-ref response-parts 'running)
- ((pid) pid)))))
- marionette))
-
- (test-assert "containerd PID file present"
- (wait-for-file "/run/containerd/containerd.pid" marionette))
-
- (test-assert "dockerd running"
- (marionette-eval
- '(begin
- (use-modules (gnu services herd))
- (match (start-service 'dockerd)
- (#f #f)
- (('service response-parts ...)
- (match (assq-ref response-parts 'running)
- ((pid) pid)))))
- marionette))
-
- (sleep 10) ; let service start
+ (wait-for-file "/run/containerd/containerd.pid" marionette)
(test-assert "docker-guile running"
(marionette-eval
'(begin
(use-modules (gnu services herd))
- (match (start-service 'docker-guile)
- (#f #f)
- (('service response-parts ...)
- (match (assq-ref response-parts 'running)
- ((pid) pid)))))
+ (wait-for-service 'docker-guile #:timeout 120)
+ #t)
marionette))
- (test-equal "passing host environment variables and volumes"
- '("value" "hello")
- (marionette-eval
- `(begin
- (use-modules (ice-9 popen)
- (ice-9 rdelim))
-
- (define slurp
- (lambda args
- (let* ((port (apply open-pipe* OPEN_READ args))
- (output (let ((line (read-line port)))
- (if (eof-object? line)
- ""
- line)))
- (status (close-pipe port)))
- output)))
- (let* ((response1 (slurp
- ,(string-append #$docker-cli "/bin/docker")
- "exec" "docker-guile"
- "/bin/guile" "-c" "(display (getenv \"VARIABLE\"))"))
- (response2 (slurp
- ,(string-append #$docker-cli "/bin/docker")
- "exec" "docker-guile"
- "/bin/guile" "-c" "(begin (use-modules (ice-9 popen) (ice-9 rdelim))
+ (test-assert "passing host environment variables and volumes"
+ (begin
+ (define (run-test)
+ (marionette-eval
+ `(begin
+ (use-modules (ice-9 popen)
+ (ice-9 rdelim))
+
+ (define slurp
+ (lambda args
+ (let* ((port (apply open-pipe* OPEN_READ args))
+ (output (let ((line (read-line port)))
+ (if (eof-object? line)
+ ""
+ line)))
+ (status (close-pipe port)))
+ output)))
+ (let* ((response1 (slurp
+ ,(string-append #$docker-cli "/bin/docker")
+ "exec" "docker-guile"
+ "/bin/guile" "-c" "(display (getenv \"VARIABLE\"))"))
+ (response2 (slurp
+ ,(string-append #$docker-cli "/bin/docker")
+ "exec" "docker-guile"
+ "/bin/guile" "-c" "(begin (use-modules (ice-9 popen) (ice-9 rdelim))
(display (call-with-input-file \"/shared.txt\" read-line)))")))
- (list response1 response2)))
- marionette))
+ (list response1 response2)))
+ marionette))
+ ;; Allow services to come up on slower machines
+ (let loop ((attempts 0))
+ (if (= attempts 60)
+ (error "Service didn't come up after more than 60 seconds")
+ (if (equal? '("value" "hello")
+ (run-test))
+ #t
+ (begin
+ (sleep 1)
+ (loop (+ 1 attempts))))))))
(test-end))))
--
2.48.1
guix-patches <at> gnu.org:bug#76081; Package guix-patches.
(Sun, 09 Mar 2025 00:28:02 GMT) Full text and rfc822 format available.Message #119 received at 76081 <at> debbugs.gnu.org (full text, mbox):
From: paul <goodoldpaul <at> autistici.org> To: 76081 <at> debbugs.gnu.org Subject: Re: OCI provisioning service Date: Sun, 9 Mar 2025 01:27:48 +0100
Hi, On 3/4/25 13:39, paul wrote: > Hi, > > On 2/27/25 00:01, paul wrote: >> Hi guix, >> >> On 2/18/25 02:20, paul wrote: >>> Hi, >>> >>> On 2/12/25 02:09, paul wrote: >>>> Hi guix, >>>> >>>> On 2/9/25 21:38, paul wrote: >>>>> I'm sending a v3 fixing a bug in the merge algorithm for volumes >>>>> and networks. >>>>> >>>>> On 2/9/25 20:14, paul wrote: >>>>>> Hi, >>>>>> >>>>>> I'm about to send a v2. v2 compared to the first revision features: >>>>>> >>>>>> >>>>>> - it actually compiles all the times :) (rev 1 referenced >>>>>> oci-image too early for it to be working and generated a compile >>>>>> time error, if you recompiled it sometimes went away so I thought >>>>>> it was a problem of my setup. CI caught this) >>>>>> - it allows more values to be overridden by eventual users of the >>>>>> Scheme API >>>>>> - it allows passing extra arguments directly after each podman or >>>>>> docker invokation, allowing for example for overriding podman >>>>>> --root and similar options. >>>>>> >>>>>> All of these tests should pass: >>>>>> >>>>>> guix shell -D guix -CPW -- make check-system TESTS="oci-container >>>>>> oci-service-rootless-podman docker docker-system rootless-podman >>>>>> oci-service-docker" >>>>>> >>>> I'm sending a v4 changing slightly the image loader, the same tests >>>> as before are supposed to pass. Now the Home service [0] is working >>>> for me with rootless podman. I'll try it on different distros if I >>>> manage to. >>> >>> I'm sending a v5 implementing a Home service. The changes compared >>> to v4 are pretty trivial as the plumbing was already there, the only >>> downside is that I'm not able to use for-home? in >>> define-configuration, so I had to reimplement oci-configuration with >>> (guix records) and had to reimplement some validation (gnu services >>> configuration) would figure out magically. >> >> I'm sending a v6. Compared to v5 it resolves the conflicts with >> master and it should fix the stop action for rootless podman backed >> services. > > I'm sending a v7 fixing the restart action for podman backed services. I'm sending a v8 fixing some further bugs wrt to the start and stop of podman backed services. Thank you for your work, cheers giacomo
ludo <at> gnu.org, maxim.cournoyer <at> gmail.com, guix-patches <at> gnu.org:bug#76081; Package guix-patches.
(Sun, 09 Mar 2025 01:07:02 GMT) Full text and rfc822 format available.Message #122 received at 76081 <at> debbugs.gnu.org (full text, mbox):
From: Giacomo Leidi <goodoldpaul <at> autistici.org> To: 76081 <at> debbugs.gnu.org Cc: Giacomo Leidi <goodoldpaul <at> autistici.org> Subject: [PATCH v8 3/5] services: Add oci-service-type. Date: Sun, 9 Mar 2025 02:06:13 +0100
This patch implements a generalization of the
oci-container-service-type, which consequently is made deprecated. The
oci-service-type, in addition to all the features from the
oci-container-service-type, can now provision OCI networks and volumes.
It only handles OCI objects creation, the user is supposed to handle
state once the objects are provsioned.
It currently supports two different OCI runtimes: Docker and rootless
Podman. Both runtimes are tested to make sure provisioned containers
can connect to each other through provisioned networks and can
read/write data with provisioned volumes.
At last the Scheme API is thought to facilitate the implementation of a
Guix Home service in the future.
* gnu/services/containers.scm (%oci-supported-runtimes): New variable;
(oci-runtime-cli): new variable;
(oci-runtime-name): new variable;
(oci-network-configuration): new variable;
(oci-volume-configuration): new variable;
(oci-configuration): new variable;
(oci-extension): new variable;
(oci-networks-shepherd-name): new variable;
(oci-service-type): new variable;
(oci-state->shepherd-services): new variable.
* doc/guix.texi: Document it.
* gnu/tests/containers.scm: Test it.
* gnu/services/docker.scm: Deprecate the oci-container-service-type.
Change-Id: I656b3db85832e42d53072fcbfb91d1226f39ef38
---
doc/guix.texi | 306 ++++++--
gnu/services/containers.scm | 1335 ++++++++++++++++++++++++++++++-----
gnu/services/docker.scm | 37 +-
gnu/tests/containers.scm | 999 +++++++++++++++++++++++++-
4 files changed, 2425 insertions(+), 252 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index 7d8a5243ed8..8686380669b 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -42839,59 +42839,162 @@ Miscellaneous Services
@cindex OCI-backed, Shepherd services
@subsubheading OCI backed services
-Should you wish to manage your Docker containers with the same consistent
-interface you use for your other Shepherd services,
-@var{oci-container-service-type} is the tool to use: given an
-@acronym{Open Container Initiative, OCI} container image, it will run it in a
+Should you wish to manage your @acronym{Open Container Initiative, OCI} containers
+with the same consistent interface you use for your other Shepherd services,
+@var{oci-service-type} is the tool to use: given an
+OCI container image, it will run it in a
Shepherd service. One example where this is useful: it lets you run services
-that are available as Docker/OCI images but not yet packaged for Guix.
+that are available as OCI images but not yet packaged for Guix.
-@defvar oci-container-service-type
+@defvar oci-service-type
-This is a thin wrapper around Docker's CLI that executes OCI images backed
+This is a thin wrapper around Docker's or Podman's CLI that executes OCI images backed
processes as Shepherd Services.
@lisp
-(service oci-container-service-type
- (list
- (oci-container-configuration
- (network "host")
- (image
- (oci-image
- (repository "guile")
- (tag "3")
- (value (specifications->manifest '("guile")))
- (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile"))
- #:max-layers 2))))
- (entrypoint "/bin/guile")
- (command
- '("-c" "(display \"hello!\n\")")))
- (oci-container-configuration
- (image "prom/prometheus")
- (ports
- '(("9000" . "9000")
- ("9090" . "9090"))))
- (oci-container-configuration
- (image "grafana/grafana:10.0.1")
- (network "host")
- (volumes
- '("/var/lib/grafana:/var/lib/grafana")))))
+(simple-service 'oci-provisioning
+ oci-service-type
+ (oci-extension
+ (networks
+ (list
+ (oci-network-configuration (name "monitoring"))))
+ (containers
+ (list
+ (oci-container-configuration
+ (network "monitoring")
+ (image
+ (oci-image
+ (repository "guile")
+ (tag "3")
+ (value (specifications->manifest '("guile")))
+ (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile"))
+ #:max-layers 2))))
+ (entrypoint "/bin/guile")
+ (command
+ '("-c" "(display \"hello!\n\")")))
+ (oci-container-configuration
+ (image "prom/prometheus")
+ (network "host")
+ (ports
+ '(("9000" . "9000")
+ ("9090" . "9090"))))
+ (oci-container-configuration
+ (image "grafana/grafana:10.0.1")
+ (network "host")
+ (volumes
+ '("/var/lib/grafana:/var/lib/grafana")))))))
@end lisp
In this example three different Shepherd services are going to be added to the
system. Each @code{oci-container-configuration} record translates to a
-@code{docker run} invocation and its fields directly map to options. You can
-refer to the
-@url{https://docs.docker.com/engine/reference/commandline/run,upstream}
-documentation for the semantics of each value. If the images are not found,
-they will be
-@url{https://docs.docker.com/engine/reference/commandline/pull/,pulled}. The
+@command{docker run} or @command{podman run} invocation and its fields directly
+map to options. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html,Podman}
+upstream documentation for semantics of each value. If the images are not found,
+they will be pulled. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/pull/,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-pull.1.html,Podman}
+upstream documentation for semantics. The
services with @code{(network "host")} are going to be attached to the
host network and are supposed to behave like native processes with regard to
networking.
@end defvar
+@c %start of fragment
+
+@deftp {Data Type} oci-configuration
+Available @code{oci-configuration} fields are:
+
+@table @asis
+@item @code{runtime} (default: @code{'docker}) (type: symbol)
+The OCI runtime to use to run commands. It can be either @code{'docker} or
+@code{'podman}.
+
+@item @code{runtime-cli} (type: maybe-package-or-string)
+The OCI runtime command line to be installed in the system profile and used
+to provision OCI resources. When unset it will default to @code{docker-cli}
+package for the @code{'docker} runtime or to @code{podman} package for the
+@code{'podman} runtime. When a string is passed it will be interpreted as the
+absolute file-system path of the selected OCI runtime command.
+
+@item @code{runtime-extra-arguments} (default: @code{'()}) (type: list)
+A list of strings, gexps or file-like objects that will be placed
+after each @command{docker} or @command{podman} invokation.
+
+@item @code{user} (type: maybe-string)
+The user name under whose authority OCI commands will be run. This field will
+override the @code{user} field of @code{oci-configuration}.
+
+@item @code{group} (type: maybe-string)
+The group name under whose authority OCI commands will be run. When
+using the @code{'podman} OCI runtime, this field will be ignored and the
+default group of the user configured in the @code{user} field will be used.
+This field will override the @code{group} field of @code{oci-configuration}.
+
+@item @code{subuids-range} (type: maybe-subid-range)
+An optional @code{subid-range} record allocating subuids for the user from
+the @code{user} field. When unset, with the rootless Podman OCI runtime, it
+defaults to @code{(subid-range (name "oci-container"))}.
+
+@item @code{subgids-range} (type: maybe-subid-range)
+An optional @code{subid-range} record allocating subgids for the user from
+the @code{user} field. When unset, with the rootless Podman OCI runtime, it
+defaults to @code{(subid-range (name "oci-container"))}.
+
+@item @code{containers} (default: @code{'()}) (type: list-of-oci-containers)
+The list of @code{oci-container-configuration} records representing the
+containers to provision. Most users are supposed not to use this field and use
+the @code{oci-extension} record instead.
+
+@item @code{networks} (default: @code{'()}) (type: list-of-oci-networks)
+The list of @code{oci-network-configuration} records representing the
+containers to provision. Most users are supposed not to use this field and use
+the @code{oci-extension} record instead.
+
+@item @code{volumes} (default: @code{'()}) (type: list-of-oci-volumes)
+The list of @code{oci-volumes-configuration} records representing the
+containers to provision. Most users are supposed not to use this field and use
+the @code{oci-extension} record instead.
+
+@item @code{verbose?} (default: @code{#f}) (type: boolean)
+When true, additional output will be printed, allowing to better follow the
+flow of execution.
+
+@end table
+
+@end deftp
+
+
+@c %end of fragment
+
+@c %start of fragment
+
+@deftp {Data Type} oci-extension
+Available @code{oci-extension} fields are:
+
+@table @asis
+@item @code{containers} (default: @code{'()}) (type: list-of-oci-containers)
+The list of @code{oci-container-configuration} records representing the
+containers to provision.
+
+@item @code{networks} (default: @code{'()}) (type: list-of-oci-networks)
+The list of @code{oci-network-configuration} records representing the
+containers to provision.
+
+@item @code{volumes} (default: @code{'()}) (type: list-of-oci-volumes)
+The list of @code{oci-volumes-configuration} records representing the
+containers to provision.
+
+@end table
+
+@end deftp
+
+
+@c %end of fragment
+
+
@c %start of fragment
@deftp {Data Type} oci-container-configuration
@@ -42911,16 +43014,16 @@ Miscellaneous Services
Overwrite the default entrypoint (@code{ENTRYPOINT}) of the image.
@item @code{host-environment} (default: @code{'()}) (type: list)
-Set environment variables in the host environment where @command{docker
-run} is invoked. This is especially useful to pass secrets from the
-host to the container without having them on the @command{docker run}'s
-command line: by setting the @code{MYSQL_PASSWORD} on the host and by passing
+Set environment variables in the host environment where @command{docker run}
+or @command{podman run} are invoked. This is especially useful to pass secrets
+from the host to the container without having them on the OCI runtime command line,
+for example: by setting the @code{MYSQL_PASSWORD} on the host and by passing
@code{--env MYSQL_PASSWORD} through the @code{extra-arguments} field, it is
possible to securely set values in the container environment. This field's
value can be a list of pairs or strings, even mixed:
@lisp
-(list '("LANGUAGE\" . "eo:ca:eu")
+(list '("LANGUAGE" . "eo:ca:eu")
"JAVA_HOME=/opt/java")
@end lisp
@@ -42928,22 +43031,24 @@ Miscellaneous Services
directly to @code{make-forkexec-constructor}.
@item @code{environment} (default: @code{'()}) (type: list)
-Set environment variables. This can be a list of pairs or strings, even mixed:
+Set environment variables inside the container. This can be a list of pairs
+or strings, even mixed:
@lisp
(list '("LANGUAGE" . "eo:ca:eu")
"JAVA_HOME=/opt/java")
@end lisp
-Pair members can be strings, gexps or file-like objects.
-Strings are passed directly to the Docker CLI. You can refer to the
-@uref{https://docs.docker.com/engine/reference/commandline/run/#env,upstream}
-documentation for semantics.
+Pair members can be strings, gexps or file-like objects. Strings are passed
+directly to the OCI runtime CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#env,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#env-e-env,Podman}
+upstream documentation for semantics.
@item @code{image} (type: string-or-oci-image)
The image used to build the container. It can be a string or an
-@code{oci-image} record. Strings are resolved by the Docker Engine, and
-follow the usual format
+@code{oci-image} record. Strings are resolved by the OCI runtime,
+and follow the usual format
@code{myregistry.local:5000/testing/test-image:tag}.
@item @code{provision} (default: @code{""}) (type: string)
@@ -42971,7 +43076,7 @@ Miscellaneous Services
by the service.
@item @code{network} (default: @code{""}) (type: string)
-Set a Docker network for the spawned container.
+Set an OCI network for the spawned container.
@item @code{ports} (default: @code{'()}) (type: list)
Set the port or port ranges to expose from the spawned container. This can be a
@@ -42982,10 +43087,11 @@ Miscellaneous Services
"10443:443")
@end lisp
-Pair members can be strings, gexps or file-like objects.
-Strings are passed directly to the Docker CLI. You can refer to the
-@uref{https://docs.docker.com/engine/reference/commandline/run/#publish,upstream}
-documentation for semantics.
+Pair members can be strings, gexps or file-like objects. Strings are passed
+directly to the OCI runtime CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#publish,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#publish-p-ip-hostport-containerport-protocol,Podman}
+upstream documentation for semantics.
@item @code{volumes} (default: @code{'()}) (type: list)
Set volume mappings for the spawned container. This can be a
@@ -42996,25 +43102,97 @@ Miscellaneous Services
"/gnu/store:/gnu/store")
@end lisp
-Pair members can be strings, gexps or file-like objects.
-Strings are passed directly to the Docker CLI. You can refer to the
-@uref{https://docs.docker.com/engine/reference/commandline/run/#volume,upstream}
-documentation for semantics.
+Pair members can be strings, gexps or file-like objects. Strings are passed
+directly to the OCI runtime CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#volume,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#volume-v-source-volume-host-dir-container-dir-options,Podman}
+upstream documentation for semantics.
@item @code{container-user} (default: @code{""}) (type: string)
Set the current user inside the spawned container. You can refer to the
-@url{https://docs.docker.com/engine/reference/run/#user,upstream}
-documentation for semantics.
+@url{https://docs.docker.com/engine/reference/run/#user,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#user-u-user-group,Podman}
+upstream documentation for semantics.
@item @code{workdir} (default: @code{""}) (type: string)
Set the current working directory for the spawned Shepherd service.
You can refer to the
-@url{https://docs.docker.com/engine/reference/run/#workdir,upstream}
-documentation for semantics.
+@url{https://docs.docker.com/engine/reference/run/#workdir,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#workdir-w-dir,Podman}
+upstream documentation for semantics.
+
+@item @code{extra-arguments} (default: @code{'()}) (type: list)
+A list of strings, gexps or file-like objects that will be directly passed
+to the @command{docker run} or @command{podman run} invokation.
+
+@end table
+
+@end deftp
+
+
+@c %end of fragment
+
+@c %start of fragment
+
+@deftp {Data Type} oci-network-configuration
+Available @code{oci-network-configuration} fields are:
+
+@table @asis
+@item @code{name} (type: string)
+The name of the OCI network to provision.
+
+@item @code{driver} (type: maybe-string)
+The driver to manage the network.
+
+@item @code{gateway} (type: maybe-string)
+IPv4 or IPv6 gateway for the subnet.
+
+@item @code{internal?} (default: @code{#f}) (type: boolean)
+Restrict external access to the network
+
+@item @code{ip-range} (type: maybe-string)
+Allocate container ip from a sub-range in CIDR format.
+
+@item @code{ipam-driver} (type: maybe-string)
+IP Address Management Driver.
+
+@item @code{ipv6?} (default: @code{#f}) (type: boolean)
+Enable IPv6 networking.
+
+@item @code{subnet} (type: maybe-string)
+Subnet in CIDR format that represents a network segment.
+
+@item @code{labels} (default: @code{'()}) (type: list)
+The list of labels that will be used to tag the current volume.
+
+@item @code{extra-arguments} (default: @code{'()}) (type: list)
+A list of strings, gexps or file-like objects that will be directly passed
+to the @command{docker network create} or @command{podman network create}
+invokation.
+
+@end table
+
+@end deftp
+
+
+@c %end of fragment
+
+@c %start of fragment
+
+@deftp {Data Type} oci-volume-configuration
+Available @code{oci-volume-configuration} fields are:
+
+@table @asis
+@item @code{name} (type: string)
+The name of the OCI volume to provision.
+
+@item @code{labels} (default: @code{'()}) (type: list)
+The list of labels that will be used to tag the current volume.
@item @code{extra-arguments} (default: @code{'()}) (type: list)
-A list of strings, gexps or file-like objects that will be directly
-passed to the @command{docker run} invocation.
+A list of strings, gexps or file-like objects that will be directly passed
+to the @command{docker volume create} or @command{podman volume create}
+invokation.
@end table
diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm
index 24f31c756b8..a78be00f038 100644
--- a/gnu/services/containers.scm
+++ b/gnu/services/containers.scm
@@ -39,8 +39,10 @@ (define-module (gnu services containers)
#:use-module (guix packages)
#:use-module (guix profiles)
#:use-module ((guix scripts pack) #:prefix pack:)
+ #:use-module (guix records)
#:use-module (guix store)
#:use-module (srfi srfi-1)
+ #:use-module (ice-9 format)
#:use-module (ice-9 match)
#:export (rootless-podman-configuration
rootless-podman-configuration?
@@ -96,8 +98,80 @@ (define-module (gnu services containers)
oci-container-configuration-workdir
oci-container-configuration-extra-arguments
+ list-of-oci-containers?
+ list-of-oci-networks?
+ list-of-oci-volumes?
+
+ %oci-supported-runtimes
+ oci-sanitize-runtime
+ oci-runtime-system-environment
+ oci-runtime-system-extra-arguments
+ oci-runtime-system-group
+ oci-runtime-system-requirement
+ oci-runtime-cli
+ oci-runtime-system-cli
+ oci-runtime-home-cli
+ oci-runtime-name
+ oci-runtime-group
+
+ oci-network-configuration
+ oci-network-configuration?
+ oci-network-configuration-fields
+ oci-network-configuration-name
+ oci-network-configuration-driver
+ oci-network-configuration-gateway
+ oci-network-configuration-internal?
+ oci-network-configuration-ip-range
+ oci-network-configuration-ipam-driver
+ oci-network-configuration-ipv6?
+ oci-network-configuration-subnet
+ oci-network-configuration-labels
+ oci-network-configuration-extra-arguments
+
+ oci-volume-configuration
+ oci-volume-configuration?
+ oci-volume-configuration-fields
+ oci-volume-configuration-name
+ oci-volume-configuration-labels
+ oci-volume-configuration-extra-arguments
+
+ oci-configuration
+ oci-configuration?
+ oci-configuration-runtime
+ oci-configuration-runtime-cli
+ oci-configuration-runtime-extra-arguments
+ oci-configuration-user
+ oci-configuration-group
+ oci-configuration-containers
+ oci-configuration-networks
+ oci-configuration-volumes
+ oci-configuration-verbose?
+ oci-configuration-valid?
+
+ oci-extension
+ oci-extension?
+ oci-extension-fields
+ oci-extension-containers
+ oci-extension-networks
+ oci-extension-volumes
+
+ oci-container-shepherd-name
+ oci-networks-shepherd-name
+ oci-networks-home-shepherd-name
+ oci-volumes-shepherd-name
+ oci-volumes-home-shepherd-name
+
oci-container-shepherd-service
- %oci-container-accounts))
+ oci-objects-merge-lst
+ oci-extension-merge
+ oci-service-extension-wrap-validate
+ oci-service-type
+ oci-service-accounts
+ oci-service-profile
+ oci-service-subids
+ oci-state->shepherd-services
+ oci-configuration->shepherd-services
+ oci-configuration-extend))
(define (gexp-or-string? value)
(or (gexp? value)
@@ -296,9 +370,42 @@ (define rootless-podman-service-type
;;;
-;;; OCI container.
+;;; OCI provisioning service.
;;;
+(define %oci-supported-runtimes
+ '(docker podman))
+
+(define (oci-runtime-system-requirement runtime)
+ "Return a list of Shepherd service names required by a given OCI runtime,
+before it is able to run containers."
+ (if (eq? 'podman runtime)
+ '(cgroups2-fs-owner cgroups2-limits
+ rootless-podman-shared-root-fs user-processes)
+ '(dockerd user-processes)))
+
+(define (oci-runtime-name runtime)
+ "Return a human readable name for a given OCI runtime."
+ (if (eq? 'podman runtime)
+ "Podman" "Docker"))
+
+(define (oci-runtime-group runtime maybe-group)
+ "Implement the logic behind selection of the group that is to be used by
+Shepherd to execute OCI commands."
+ (if (eq? maybe-group #f)
+ (if (eq? 'podman runtime)
+ "cgroup"
+ "docker")
+ maybe-group))
+
+(define (oci-sanitize-runtime value)
+ (unless (member value %oci-supported-runtimes)
+ (raise
+ (formatted-message
+ (G_ "OCI runtime must be a symbol and one of ~a,
+but ~a was found") %oci-supported-runtimes value)))
+ value)
+
(define (oci-sanitize-pair pair delimiter)
(define (valid? member)
(or (string? member)
@@ -347,6 +454,11 @@ (define (oci-sanitize-volumes value)
;; '(("/mnt/dir" . "/dir") "/run/current-system/profile:/java")
(oci-sanitize-mixed-list "volumes" value ":"))
+(define (oci-sanitize-labels value)
+ ;; Expected spec format:
+ ;; '(("foo" . "bar") "foo=bar")
+ (oci-sanitize-mixed-list "labels" value "="))
+
(define (oci-sanitize-shepherd-actions value)
(map
(lambda (el)
@@ -374,10 +486,15 @@ (define (oci-sanitize-extra-arguments value)
value))
(define (oci-image-reference image)
- (if (string? image)
- image
- (string-append (oci-image-repository image)
- ":" (oci-image-tag image))))
+ "Return a string OCI image reference representing IMAGE."
+ (define reference
+ (if (string? image)
+ image
+ (string-append (oci-image-repository image)
+ ":" (oci-image-tag image))))
+ (if (> (length (string-split reference #\/)) 1)
+ reference
+ (string-append "localhost/" reference)))
(define (oci-lowerable-image? image)
(or (manifest? image)
@@ -392,7 +509,19 @@ (define (string-or-oci-image? image)
(define list-of-symbols?
(list-of symbol?))
+(define (list-of-oci-records? name predicate value)
+ (map
+ (lambda (el)
+ (if (predicate el)
+ el
+ (raise
+ (formatted-message
+ (G_ "~a contains an illegal value: ~a") name el))))
+ value))
+
(define-maybe/no-serialization string)
+(define-maybe/no-serialization package)
+(define-maybe/no-serialization subid-range)
(define-configuration/no-serialization oci-image
(repository
@@ -437,11 +566,15 @@ (define-configuration/no-serialization oci-image
(define-configuration/no-serialization oci-container-configuration
(user
- (string "oci-container")
- "The user under whose authority docker commands will be run.")
+ (maybe-string)
+ "The user name under whose authority OCI commands will be run. This field will
+override the @code{user} field of @code{oci-configuration}.")
(group
- (string "docker")
- "The group under whose authority docker commands will be run.")
+ (maybe-string)
+ "The group name under whose authority OCI commands will be run. When
+using the @code{'podman} OCI runtime, this field will be ignored and the
+default group of the user configured in the @code{user} field will be used.
+This field will override the @code{group} field of @code{oci-configuration}.")
(command
(list-of-strings '())
"Overwrite the default command (@code{CMD}) of the image.")
@@ -451,9 +584,9 @@ (define-configuration/no-serialization oci-container-configuration
(host-environment
(list '())
"Set environment variables in the host environment where @command{docker run}
-is invoked. This is especially useful to pass secrets from the host to the
-container without having them on the @command{docker run}'s command line: by
-setting the @code{MYSQL_PASSWORD} on the host and by passing
+or @command{podman run} are invoked. This is especially useful to pass secrets
+from the host to the container without having them on the OCI runtime command line,
+for example: by setting the @code{MYSQL_PASSWORD} on the host and by passing
@code{--env MYSQL_PASSWORD} through the @code{extra-arguments} field, it is
possible to securely set values in the container environment. This field's
value can be a list of pairs or strings, even mixed:
@@ -477,15 +610,16 @@ (define-configuration/no-serialization oci-container-configuration
@end lisp
Pair members can be strings, gexps or file-like objects. Strings are passed
-directly to the Docker CLI. You can refer to the
-@url{https://docs.docker.com/engine/reference/commandline/run/#env,upstream}
-documentation for semantics."
+directly to the OCI runtime CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#env,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#env-e-env,Podman}
+upstream documentation for semantics."
(sanitizer oci-sanitize-environment))
(image
(string-or-oci-image)
"The image used to build the container. It can be a string or an
-@code{oci-image} record. Strings are resolved by the Docker
-Engine, and follow the usual format
+@code{oci-image} record. Strings are resolved by the OCI runtime,
+and follow the usual format
@code{myregistry.local:5000/testing/test-image:tag}.")
(provision
(maybe-string)
@@ -514,7 +648,7 @@ (define-configuration/no-serialization oci-container-configuration
(sanitizer oci-sanitize-shepherd-actions))
(network
(maybe-string)
- "Set a Docker network for the spawned container.")
+ "Set an OCI network for the spawned container.")
(ports
(list '())
"Set the port or port ranges to expose from the spawned container. This can
@@ -526,9 +660,10 @@ (define-configuration/no-serialization oci-container-configuration
@end lisp
Pair members can be strings, gexps or file-like objects. Strings are passed
-directly to the Docker CLI. You can refer to the
-@url{https://docs.docker.com/engine/reference/commandline/run/#publish,upstream}
-documentation for semantics."
+directly to the OCI runtime CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#publish,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#publish-p-ip-hostport-containerport-protocol,Podman}
+upstream documentation for semantics."
(sanitizer oci-sanitize-ports))
(volumes
(list '())
@@ -541,71 +676,363 @@ (define-configuration/no-serialization oci-container-configuration
@end lisp
Pair members can be strings, gexps or file-like objects. Strings are passed
-directly to the Docker CLI. You can refer to the
-@url{https://docs.docker.com/engine/reference/commandline/run/#volume,upstream}
-documentation for semantics."
+directly to the OCI runtime CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#volume,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#volume-v-source-volume-host-dir-container-dir-options,Podman}
+upstream documentation for semantics."
(sanitizer oci-sanitize-volumes))
(container-user
(maybe-string)
"Set the current user inside the spawned container. You can refer to the
-@url{https://docs.docker.com/engine/reference/run/#user,upstream}
-documentation for semantics.")
+@url{https://docs.docker.com/engine/reference/run/#user,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#user-u-user-group,Podman}
+upstream documentation for semantics.")
(workdir
(maybe-string)
- "Set the current working for the spawned Shepherd service.
+ "Set the current working directory for the spawned Shepherd service.
You can refer to the
-@url{https://docs.docker.com/engine/reference/run/#workdir,upstream}
-documentation for semantics.")
+@url{https://docs.docker.com/engine/reference/run/#workdir,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#workdir-w-dir,Podman}
+upstream documentation for semantics.")
(extra-arguments
(list '())
"A list of strings, gexps or file-like objects that will be directly passed
-to the @command{docker run} invokation."
+to the @command{docker run} or @command{podman run} invocation."
(sanitizer oci-sanitize-extra-arguments)))
-(define oci-container-configuration->options
- (lambda (config)
- (let ((entrypoint
- (oci-container-configuration-entrypoint config))
- (network
- (oci-container-configuration-network config))
- (user
- (oci-container-configuration-container-user config))
- (workdir
- (oci-container-configuration-workdir config)))
- (apply append
- (filter (compose not unspecified?)
- `(,(if (maybe-value-set? entrypoint)
- `("--entrypoint" ,entrypoint)
- '())
- ,(append-map
- (lambda (spec)
- (list "--env" spec))
- (oci-container-configuration-environment config))
- ,(if (maybe-value-set? network)
- `("--network" ,network)
- '())
- ,(if (maybe-value-set? user)
- `("--user" ,user)
- '())
- ,(if (maybe-value-set? workdir)
- `("--workdir" ,workdir)
- '())
- ,(append-map
- (lambda (spec)
- (list "-p" spec))
- (oci-container-configuration-ports config))
- ,(append-map
- (lambda (spec)
- (list "-v" spec))
- (oci-container-configuration-volumes config))))))))
-
-(define* (get-keyword-value args keyword #:key (default #f))
- (let ((kv (memq keyword args)))
- (if (and kv (>= (length kv) 2))
- (cadr kv)
- default)))
+(define (list-of-oci-containers? value)
+ (list-of-oci-records? "containers" oci-container-configuration? value))
+
+(define-configuration/no-serialization oci-volume-configuration
+ (name
+ (string)
+ "The name of the OCI volume to provision.")
+ (labels
+ (list '())
+ "The list of labels that will be used to tag the current volume."
+ (sanitizer oci-sanitize-labels))
+ (extra-arguments
+ (list '())
+ "A list of strings, gexps or file-like objects that will be directly passed
+to the @command{docker volume create} or @command{podman volume create}
+invocation."
+ (sanitizer oci-sanitize-extra-arguments)))
+
+(define (list-of-oci-volumes? value)
+ (list-of-oci-records? "volumes" oci-volume-configuration? value))
+
+(define-configuration/no-serialization oci-network-configuration
+ (name
+ (string)
+ "The name of the OCI network to provision.")
+ (driver
+ (maybe-string)
+ "The driver to manage the network.")
+ (gateway
+ (maybe-string)
+ "IPv4 or IPv6 gateway for the subnet.")
+ (internal?
+ (boolean #f)
+ "Restrict external access to the network")
+ (ip-range
+ (maybe-string)
+ "Allocate container ip from a sub-range in CIDR format.")
+ (ipam-driver
+ (maybe-string)
+ "IP Address Management Driver.")
+ (ipv6?
+ (boolean #f)
+ "Enable IPv6 networking.")
+ (subnet
+ (maybe-string)
+ "Subnet in CIDR format that represents a network segment.")
+ (labels
+ (list '())
+ "The list of labels that will be used to tag the current volume."
+ (sanitizer oci-sanitize-labels))
+ (extra-arguments
+ (list '())
+ "A list of strings, gexps or file-like objects that will be directly passed
+to the @command{docker network create} or @command{podman network create}
+invocation."
+ (sanitizer oci-sanitize-extra-arguments)))
+
+(define (list-of-oci-networks? value)
+ (list-of-oci-records? "networks" oci-network-configuration? value))
+
+(define-record-type* <oci-configuration>
+ oci-configuration
+ make-oci-configuration
+ oci-configuration?
+ this-oci-configuration
+
+ (runtime oci-configuration-runtime
+ (default 'docker))
+ (runtime-cli oci-configuration-runtime-cli
+ (default #f)) ; package or string
+ (runtime-extra-arguments oci-configuration-runtime-extra-arguments ; strings or gexps
+ (default '())) ; or file-like objects
+ (user oci-configuration-user
+ (default "oci-container"))
+ (group oci-configuration-group ; string
+ (default #f))
+ (subuids-range oci-configuration-subuids-range ; subid-range
+ (default #f))
+ (subgids-range oci-configuration-subgids-range ; subid-range
+ (default #f))
+ (containers oci-configuration-containers ; oci-container-configurations
+ (default '()))
+ (networks oci-configuration-networks ; oci-network-configurations
+ (default '()))
+ (volumes oci-configuration-volumes ; oci-volume-configurations
+ (default '()))
+ (verbose? oci-configuration-verbose?
+ (default #f))
+ (home-service? oci-configuration-home-service?
+ (default for-home?) (innate)))
+
+(define (package-or-string? value)
+ (or (package? value) (string? value)))
+
+(define (oci-configuration-valid? config)
+ (define runtime-cli
+ (oci-configuration-runtime-cli config))
+ (define group
+ (oci-configuration-group config))
+ (define subuids-range
+ (oci-configuration-subuids-range config))
+ (define subgids-range
+ (oci-configuration-subgids-range config))
+ (and
+ (symbol?
+ (oci-sanitize-runtime (oci-configuration-runtime config)))
+ (or (eq? runtime-cli #f)
+ (package-or-string? runtime-cli))
+ (list? (oci-configuration-runtime-extra-arguments config))
+ (string? (oci-configuration-user config))
+ (or (eq? group #f)
+ (string? group))
+ (or (eq? subuids-range #f)
+ (subid-range? subuids-range))
+ (or (eq? subgids-range #f)
+ (subid-range? subgids-range))
+ (list-of-oci-containers?
+ (oci-configuration-containers config))
+ (list-of-oci-networks?
+ (oci-configuration-networks config))
+ (list-of-oci-volumes?
+ (oci-configuration-volumes config))
+ (boolean?
+ (oci-configuration-verbose? config))
+ (boolean?
+ (oci-configuration-home-service? config))))
+
+(define (oci-runtime-system-environment runtime user)
+ (if (eq? runtime 'podman)
+ (list
+ #~(string-append
+ "HOME=" (passwd:dir (getpwnam #$user))))
+ #~()))
+
+(define (oci-runtime-system-group runtime user group)
+ (if (eq? runtime 'podman)
+ #~(group:name
+ (getgrgid
+ (passwd:gid
+ (getpwnam #$user))))
+ group))
+
+(define (oci-runtime-cli runtime runtime-cli path)
+ "Return a gexp that, when lowered, evaluates to the file system path of the OCI
+runtime command requested by the user."
+ (if (string? runtime-cli)
+ ;; It is a user defined absolute path
+ runtime-cli
+ #~(string-append
+ #$(if (eq? runtime-cli #f)
+ path
+ runtime-cli)
+ #$(if (eq? 'podman runtime)
+ "/bin/podman"
+ "/bin/docker"))))
+
+(define* (oci-runtime-system-cli config #:key (path "/run/current-system/profile"))
+ (let ((runtime-cli
+ (oci-configuration-runtime-cli config))
+ (runtime
+ (oci-configuration-runtime config)))
+ (oci-runtime-cli runtime runtime-cli path)))
+
+(define (oci-runtime-home-cli config)
+ (let ((runtime-cli
+ (oci-configuration-runtime-cli config))
+ (runtime
+ (oci-configuration-runtime config)))
+ (oci-runtime-cli runtime runtime-cli
+ (string-append (getenv "HOME")
+ "/.guix-home/profile"))))
+
+(define-configuration/no-serialization oci-extension
+ (containers
+ (list-of-oci-containers '())
+ "The list of @code{oci-container-configuration} records representing the
+containers to add.")
+ (networks
+ (list-of-oci-networks '())
+ "The list of @code{oci-network-configuration} records representing the
+networks to add.")
+ (volumes
+ (list-of-oci-volumes '())
+ "The list of @code{oci-volume-configuration} records representing the
+volumes to add."))
+
+(define (oci-image->container-name image)
+ "Infer the name of an OCI backed Shepherd service from its OCI image."
+ (basename
+ (if (string? image)
+ (first (string-split image #\:))
+ (oci-image-repository image))))
+
+(define (oci-object-command-shepherd-action object-name invocation)
+ "Return a Shepherd action printing a given INVOCATION of an OCI command for the
+given OBJECT-NAME."
+ (shepherd-action
+ (name 'command-line)
+ (documentation
+ (format #f "Prints ~a's OCI runtime command line invocation."
+ object-name))
+ (procedure
+ #~(lambda _
+ (format #t "~a~%" #$invocation)))))
+
+(define (oci-container-shepherd-name runtime config)
+ "Return the name of an OCI backed Shepherd service based on CONFIG.
+The name configured in the configuration record is returned when
+CONFIG's name field has a value, otherwise a name is inferred from CONFIG's
+image field."
+ (define name (oci-container-configuration-provision config))
+ (define image (oci-container-configuration-image config))
+
+ (if (maybe-value-set? name)
+ name
+ (string-append (symbol->string runtime) "-"
+ (oci-image->container-name image))))
+
+(define (oci-networks-shepherd-name runtime)
+ "Return the name of the OCI networks provisioning Shepherd service based on
+RUNTIME."
+ (string-append (symbol->string runtime) "-networks"))
+
+(define (oci-volumes-shepherd-name runtime)
+ "Return the name of the OCI volumes provisioning Shepherd service based on
+RUNTIME."
+ (string-append (symbol->string runtime) "-volumes"))
+
+(define (oci-networks-home-shepherd-name runtime)
+ "Return the name of the OCI volumes provisioning Home Shepherd service based on
+RUNTIME."
+ (string-append "home-" (oci-networks-shepherd-name runtime)))
+
+(define (oci-volumes-home-shepherd-name runtime)
+ "Return the name of the OCI volumes provisioning Home Shepherd service based on
+RUNTIME."
+ (string-append "home-" (oci-volumes-shepherd-name runtime)))
+
+(define (oci-container-configuration->options config)
+ "Map CONFIG, an oci-container-configuration record, to a gexp that, upon
+lowering, will be evaluated to a list of strings containing command line options
+for the OCI runtime run command."
+ (let ((entrypoint
+ (oci-container-configuration-entrypoint config))
+ (network
+ (oci-container-configuration-network config))
+ (user
+ (oci-container-configuration-container-user config))
+ (workdir
+ (oci-container-configuration-workdir config)))
+ (apply append
+ (filter (compose not unspecified?)
+ `(,(if (maybe-value-set? entrypoint)
+ `("--entrypoint" ,entrypoint)
+ '())
+ ,(append-map
+ (lambda (spec)
+ (list "--env" spec))
+ (oci-container-configuration-environment config))
+ ,(if (maybe-value-set? network)
+ `("--network" ,network)
+ '())
+ ,(if (maybe-value-set? user)
+ `("--user" ,user)
+ '())
+ ,(if (maybe-value-set? workdir)
+ `("--workdir" ,workdir)
+ '())
+ ,(append-map
+ (lambda (spec)
+ (list "-p" spec))
+ (oci-container-configuration-ports config))
+ ,(append-map
+ (lambda (spec)
+ (list "-v" spec))
+ (oci-container-configuration-volumes config)))))))
+
+(define (oci-network-configuration->options config)
+ "Map CONFIG, an oci-network-configuration record, to a gexp that, upon
+lowering, will be evaluated to a list of strings containing command line options
+for the OCI runtime network create command."
+ (let ((driver (oci-network-configuration-driver config))
+ (gateway
+ (oci-network-configuration-gateway config))
+ (internal?
+ (oci-network-configuration-internal? config))
+ (ip-range
+ (oci-network-configuration-ip-range config))
+ (ipam-driver
+ (oci-network-configuration-ipam-driver config))
+ (ipv6?
+ (oci-network-configuration-ipv6? config))
+ (subnet
+ (oci-network-configuration-subnet config)))
+ (apply append
+ (filter (compose not unspecified?)
+ `(,(if (maybe-value-set? driver)
+ `("--driver" ,driver)
+ '())
+ ,(if (maybe-value-set? gateway)
+ `("--gateway" ,gateway)
+ '())
+ ,(if internal?
+ `("--internal")
+ '())
+ ,(if (maybe-value-set? ip-range)
+ `("--ip-range" ,ip-range)
+ '())
+ ,(if (maybe-value-set? ipam-driver)
+ `("--ipam-driver" ,ipam-driver)
+ '())
+ ,(if ipv6?
+ `("--ipv6")
+ '())
+ ,(if (maybe-value-set? subnet)
+ `("--subnet" ,subnet)
+ '())
+ ,(append-map
+ (lambda (spec)
+ (list "--label" spec))
+ (oci-network-configuration-labels config)))))))
+
+(define (oci-volume-configuration->options config)
+ "Map CONFIG, an oci-volume-configuration record, to a gexp that, upon
+lowering, will be evaluated to a list of strings containing command line options
+for the OCI runtime volume create command."
+ (append-map
+ (lambda (spec)
+ (list "--label" spec))
+ (oci-volume-configuration-labels config)))
(define (lower-operating-system os target system)
+ "Lower OS, an operating-system record, into a tarball containing an OCI image."
(mlet* %store-monad
((tarball
(lower-object
@@ -614,24 +1041,11 @@ (define (lower-operating-system os target system)
#:target target)))
(return tarball)))
-(define (lower-manifest name image target system)
- (define value (oci-image-value image))
- (define options (oci-image-pack-options image))
- (define image-reference
- (oci-image-reference image))
- (define image-tag
- (let* ((extra-options
- (get-keyword-value options #:extra-options))
- (image-tag-option
- (and extra-options
- (get-keyword-value extra-options #:image-tag))))
- (if image-tag-option
- '()
- `(#:extra-options (#:image-tag ,image-reference)))))
-
+(define (lower-manifest name value options image-reference
+ target system grafts?)
+ "Lower VALUE, a manifest record, into a tarball containing an OCI image."
(mlet* %store-monad
- ((_ (set-grafting
- (oci-image-grafts? image)))
+ ((_ (set-grafting grafts?))
(guile (set-guile-for-build (default-guile)))
(profile
(profile-derivation value
@@ -642,14 +1056,11 @@ (define (lower-manifest name image target system)
(tarball (apply pack:docker-image
`(,name ,profile
,@options
- ,@image-tag
#:localstatedir? #t))))
(return tarball)))
-(define (lower-oci-image name image)
- (define value (oci-image-value image))
- (define image-target (oci-image-target image))
- (define image-system (oci-image-system image))
+(define (lower-oci-image-state name value options reference
+ image-target image-system grafts?)
(define target
(if (maybe-value-set? image-target)
image-target
@@ -662,7 +1073,8 @@ (define (lower-oci-image name image)
(run-with-store store
(match value
((? manifest? value)
- (lower-manifest name image target system))
+ (lower-manifest name value options reference
+ target system grafts?))
((? operating-system? value)
(lower-operating-system value target system))
((or (? gexp? value)
@@ -677,113 +1089,686 @@ (define (lower-oci-image name image)
#:target target
#:system system)))
-(define (%oci-image-loader name image tag)
- (let ((docker (file-append docker-cli "/bin/docker"))
- (tarball (lower-oci-image name image)))
+(define (lower-oci-image name image)
+ "Lower IMAGE, a oci-image record, into a tarball containing an OCI image."
+ (lower-oci-image-state
+ name
+ (oci-image-value image)
+ (oci-image-pack-options image)
+ (oci-image-reference image)
+ (oci-image-target image)
+ (oci-image-system image)
+ (oci-image-grafts? image)))
+
+(define (oci-object-exists? runtime runtime-cli object verbose?)
+ #~(lambda* (name #:key (format-string "{{.Name}}"))
+ (use-modules (ice-9 format)
+ (ice-9 match)
+ (ice-9 popen)
+ (ice-9 rdelim)
+ (srfi srfi-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)))
+
+ #$(if (eq? runtime 'podman)
+ #~(let ((command
+ (list #$runtime-cli
+ #$object "exists" name)))
+ (when #$verbose?
+ (format #t "Running~{ ~a~}~%" command))
+ (define exit-code (status:exit-val (apply system* command)))
+ (when #$verbose?
+ (format #t "Exit code: ~a~%" exit-code))
+ (equal? EXIT_SUCCESS exit-code))
+ #~(let ((command
+ (string-append #$runtime-cli
+ " " #$object " ls --format "
+ "\"" format-string "\"")))
+ (when #$verbose?
+ (format #t "Running ~a~%" command))
+ (member name (read-lines (open-input-pipe command)))))))
+
+(define* (oci-image-loader runtime runtime-cli name image tag #:key (verbose? #f))
+ "Return a file-like object that, once lowered, will evaluate to a program able
+to load IMAGE through RUNTIME-CLI and to tag it with TAG afterwards."
+ (let ((tarball (lower-oci-image name image)))
(with-imported-modules '((guix build utils))
- (program-file (format #f "~a-image-loader" name)
+ (program-file
+ (format #f "~a-image-loader" name)
#~(begin
(use-modules (guix build utils)
+ (ice-9 match)
(ice-9 popen)
- (ice-9 rdelim))
-
- (format #t "Loading image for ~a from ~a...~%" #$name #$tarball)
- (define line
- (read-line
- (open-input-pipe
- (string-append #$docker " load -i " #$tarball))))
-
- (unless (or (eof-object? line)
- (string-null? line))
- (format #t "~a~%" line)
- (let ((repository&tag
- (string-drop line
- (string-length
- "Loaded image: "))))
-
- (invoke #$docker "tag" repository&tag #$tag)
- (format #t "Tagged ~a with ~a...~%" #$tarball #$tag))))))))
-
-(define (oci-container-shepherd-service config)
- (define (guess-name name image)
- (if (maybe-value-set? name)
- name
- (string-append "docker-"
- (basename
- (if (string? image)
- (first (string-split image #\:))
- (oci-image-repository image))))))
-
- (let* ((docker (file-append docker-cli "/bin/docker"))
- (actions (oci-container-configuration-shepherd-actions config))
+ (ice-9 rdelim)
+ (srfi srfi-1))
+ (define object-exists?
+ #$(oci-object-exists? runtime runtime-cli "image" verbose?))
+ (define load-command
+ (string-append #$runtime-cli
+ " load -i " #$tarball))
+
+ (if (object-exists? #$tag #:format-string "{{.Repository}}:{{.Tag}}")
+ (format #t "~a image already exists, skipping.~%" #$tag)
+ (begin
+ (format #t "Loading image for ~a from ~a...~%" #$name #$tarball)
+ (when #$verbose?
+ (format #t "Running ~a~%" load-command))
+ (let ((line (read-line
+ (open-input-pipe load-command))))
+ (unless (or (eof-object? line)
+ (string-null? line))
+ (format #t "~a~%" line)
+ (let* ((repository&tag
+ (string-drop line
+ (string-length
+ "Loaded image: ")))
+ (tag-command
+ (list #$runtime-cli "tag" repository&tag #$tag))
+ (drop-old-tag-command
+ (list #$runtime-cli "image" "rm" "-f" repository&tag)))
+
+ (unless (string=? repository&tag #$tag)
+ (when #$verbose?
+ (format #t "Running~{ ~a~}~%" tag-command))
+
+ (let ((exit-code
+ (status:exit-val (apply system* tag-command))))
+ (format #t "Tagged ~a with ~a...~%" #$tarball #$tag)
+
+ (when #$verbose?
+ (format #t "Exit code: ~a~%" exit-code))
+
+ (when (equal? EXIT_SUCCESS exit-code)
+ (when #$verbose?
+ (format #t "Running~{ ~a~}~%" drop-old-tag-command))
+ (let ((drop-exit-code
+ (status:exit-val (apply system* drop-old-tag-command))))
+ (when #$verbose?
+ (format #t "Exit code: ~a~%" drop-exit-code))))))))))))))))
+
+(define (oci-container-run-invocation runtime runtime-cli name command image-reference
+ options runtime-extra-arguments run-extra-arguments)
+ "Return a list representing the OCI runtime
+invocation for running containers."
+ ;; run [OPTIONS] IMAGE [COMMAND] [ARG...]
+ `(,runtime-cli ,@runtime-extra-arguments "run" "--rm"
+ ,@(if (eq? runtime 'podman)
+ ;; This is because podman takes some time to
+ ;; release container names. --replace seems
+ ;; to be required to be able to restart services.
+ '("--replace")
+ '())
+ "--name" ,name
+ ,@options ,@run-extra-arguments
+ ,image-reference ,@command))
+
+(define* (oci-container-entrypoint runtime runtime-cli name image image-reference
+ invocation #:key (verbose? #f) (pre-script #~()))
+ "Return a file-like object that, once lowered, will evaluate to the entrypoint
+for the Shepherd service that will run IMAGE through RUNTIME-CLI."
+ (program-file
+ (string-append "oci-entrypoint-" name)
+ #~(begin
+ (use-modules (ice-9 format)
+ (srfi srfi-1))
+ (when #$verbose?
+ (format #t "Running in verbose mode...~%")
+ (format #t "Current user: ~a ~a~%"
+ (getuid) (passwd:name (getpwuid (getuid))))
+ (format #t "Current group: ~a ~a~%"
+ (getgid) (group:name (getgrgid (getgid))))
+ (format #t "Current directory ~a~%" (getcwd)))
+ (define invocation (list #$@invocation))
+ #$@pre-script
+ (when #$verbose?
+ (format #t "Running~{ ~a~}~%" invocation))
+ (apply execlp `(,(first invocation) ,@invocation)))))
+
+(define* (oci-container-shepherd-service runtime runtime-cli config
+ #:key
+ (runtime-environment #~())
+ (runtime-extra-arguments '())
+ (oci-requirement '())
+ (user #f)
+ (group #f)
+ (verbose? #f))
+ "Return a Shepherd service object that will run the OCI container represented
+by CONFIG through RUNTIME-CLI."
+ (let* ((actions (oci-container-configuration-shepherd-actions config))
(auto-start?
(oci-container-configuration-auto-start? config))
- (user (oci-container-configuration-user config))
- (group (oci-container-configuration-group config))
+ (maybe-user (oci-container-configuration-user config))
+ (maybe-group (oci-container-configuration-group config))
+ (user (if (maybe-value-set? maybe-user)
+ maybe-user
+ user))
+ (group (if (maybe-value-set? maybe-group)
+ maybe-group
+ group))
(host-environment
(oci-container-configuration-host-environment config))
(command (oci-container-configuration-command config))
(log-file (oci-container-configuration-log-file config))
- (provision (oci-container-configuration-provision config))
(requirement (oci-container-configuration-requirement config))
(respawn?
(oci-container-configuration-respawn? config))
(image (oci-container-configuration-image config))
(image-reference (oci-image-reference image))
(options (oci-container-configuration->options config))
- (name (guess-name provision image))
+ (name
+ (oci-container-shepherd-name runtime config))
(extra-arguments
- (oci-container-configuration-extra-arguments config)))
+ (oci-container-configuration-extra-arguments config))
+ (invocation
+ (oci-container-run-invocation
+ runtime runtime-cli name command image-reference
+ options runtime-extra-arguments extra-arguments))
+ (container-action
+ (lambda* (command #:key (environment-variables #f))
+ #~(lambda _
+ (fork+exec-command
+ (list #$@command)
+ #$@(if user (list #:user user) '())
+ #$@(if group (list #:group group) '())
+ #$@(if (maybe-value-set? log-file)
+ (list #:log-file log-file)
+ '())
+ #$@(if (and user (eq? runtime 'podman))
+ (list #:directory
+ #~(passwd:dir (getpwnam #$user)))
+ '())
+ #$@(if environment-variables
+ (list #:environment-variables
+ environment-variables)
+ '()))))))
(shepherd-service (provision `(,(string->symbol name)))
- (requirement `(dockerd user-processes ,@requirement))
+ (requirement `(,@oci-requirement
+ ,@requirement))
(respawn? respawn?)
(auto-start? auto-start?)
(documentation
(string-append
- "Docker backed Shepherd service for "
+ (oci-runtime-name runtime) " backed Shepherd service for "
(if (oci-image? image) name image) "."))
(start
- #~(lambda ()
- #$@(if (oci-image? image)
- #~((invoke #$(%oci-image-loader
- name image image-reference)))
- #~())
- (fork+exec-command
- ;; docker run [OPTIONS] IMAGE [COMMAND] [ARG...]
- (list #$docker "run" "--rm" "--name" #$name
- #$@options #$@extra-arguments
- #$image-reference #$@command)
- #:user #$user
- #:group #$group
- #$@(if (maybe-value-set? log-file)
- (list #:log-file log-file)
- '())
- #:environment-variables
- (list #$@host-environment))))
+ (container-action
+ (list (oci-container-entrypoint
+ runtime runtime-cli name image image-reference
+ invocation #:verbose? verbose?
+ #:pre-script
+ (if (oci-image? image)
+ #~((system*
+ #$(oci-image-loader
+ runtime runtime-cli name image
+ image-reference #:verbose? verbose?)))
+ #~())))
+ #:environment-variables
+ #~(append
+ (list #$@host-environment)
+ (list #$@runtime-environment))))
(stop
- #~(lambda _
- (invoke #$docker "rm" "-f" #$name)))
+ (container-action
+ (list
+ (oci-container-entrypoint
+ runtime runtime-cli name image image-reference
+ (list runtime-cli "rm" "-f" name)
+ #:verbose? verbose?))
+ #:environment-variables
+ #~(append
+ (list #$@host-environment)
+ (list #$@runtime-environment))))
(actions
- (if (oci-image? image)
- '()
- (append
+ (append
+ (list
+ (oci-object-command-shepherd-action
+ name #~(string-join (list #$@invocation) " ")))
+ (if (oci-image? image)
+ '()
(list
- (shepherd-action
- (name 'pull)
- (documentation
- (format #f "Pull ~a's image (~a)."
- name image))
- (procedure
- #~(lambda _
- (invoke #$docker "pull" #$image)))))
- actions))))))
-
-(define %oci-container-accounts
+ (let ((service-name name))
+ (shepherd-action
+ (name 'pull)
+ (documentation
+ (format #f "Pull ~a's image (~a)."
+ service-name image))
+ (procedure
+ (container-action
+ (list
+ (oci-container-entrypoint
+ runtime runtime-cli service-name image
+ image-reference
+ (list runtime-cli "pull" image)
+ #:verbose? verbose?))
+ #:environment-variables
+ #~(append
+ (list #$@host-environment)
+ (list #$@runtime-environment))))))))
+ actions)))))
+
+(define (oci-object-create-invocation object runtime-cli name options
+ runtime-extra-arguments
+ create-extra-arguments)
+ "Return a gexp that, upon lowering, will evaluate to the OCI runtime
+invocation for creating networks and volumes."
+ ;; network|volume create [options] [NAME]
+ #~(list #$runtime-cli #$@runtime-extra-arguments #$object "create"
+ #$@options #$@create-extra-arguments #$name))
+
+(define (format-oci-invocations invocations)
+ "Return a gexp that, upon lowering, will evaluate to a formatted message
+containing the INVOCATIONS that the OCI runtime will execute to provision
+networks or volumes."
+ #~(string-join (map (lambda (i) (string-join i " "))
+ (list #$@invocations))
+ "\n"))
+
+(define* (oci-object-create-script object runtime runtime-cli invocations
+ #:key (verbose? #f))
+ "Return a file-like object that, once lowered, will evaluate to a program able
+to create OCI networks and volumes through RUNTIME-CLI."
+ (define runtime-string (symbol->string runtime))
+ (program-file
+ (string-append runtime-string "-" object "s-create.scm")
+ #~(begin
+ (use-modules (ice-9 format)
+ (ice-9 match)
+ (ice-9 popen)
+ (ice-9 rdelim)
+ (srfi srfi-1))
+
+ (define object-exists?
+ #$(oci-object-exists? runtime runtime-cli object verbose?))
+
+ (for-each
+ (lambda (invocation)
+ (define name (last invocation))
+ (if (object-exists? name)
+ (format #t "~a ~a ~a already exists, skipping creation.~%"
+ #$(oci-runtime-name runtime) name #$object)
+ (begin
+ (when #$verbose?
+ (format #t "Running~{ ~a~}~%" invocation))
+ (let ((exit-code (status:exit-val (apply system* invocation))))
+ (when #$verbose?
+ (format #t "Exit code: ~a~%" exit-code))))))
+ (list #$@invocations)))))
+
+(define* (oci-object-shepherd-service object runtime runtime-cli name requirement invocations
+ #:key
+ (runtime-environment #~())
+ (user #f)
+ (group #f)
+ (verbose? #f))
+ "Return a Shepherd service object that will create the OBJECTs represented
+by INVOCATIONS through RUNTIME-CLI."
+ (shepherd-service (provision `(,(string->symbol name)))
+ (requirement requirement)
+ (one-shot? #t)
+ (documentation
+ (string-append
+ (oci-runtime-name runtime) " " object
+ " provisioning service"))
+ (start
+ #~(lambda _
+ (fork+exec-command
+ (list
+ #$(oci-object-create-script
+ object runtime runtime-cli
+ invocations
+ #:verbose? verbose?))
+ #$@(if user (list #:user user) '())
+ #$@(if group (list #:group group) '())
+ #:environment-variables
+ (list #$@runtime-environment))))
+ (actions
+ (list
+ (oci-object-command-shepherd-action
+ name (format-oci-invocations invocations))))))
+
+(define* (oci-networks-shepherd-service runtime runtime-cli name networks
+ #:key (user #f) (group #f) (verbose? #f)
+ (runtime-extra-arguments '())
+ (runtime-environment #~())
+ (runtime-requirement '()))
+ "Return a Shepherd service object that will create the networks represented
+in CONFIG."
+ (let ((invocations
+ (map
+ (lambda (network)
+ (oci-object-create-invocation
+ "network" runtime-cli
+ (oci-network-configuration-name network)
+ (oci-network-configuration->options network)
+ runtime-extra-arguments
+ (oci-network-configuration-extra-arguments network)))
+ networks)))
+
+ (oci-object-shepherd-service
+ "network" runtime runtime-cli name
+ runtime-requirement invocations
+ #:user user #:group group #:runtime-environment runtime-environment
+ #:verbose? verbose?)))
+
+(define* (oci-volumes-shepherd-service runtime runtime-cli name volumes
+ #:key (user #f) (group #f) (verbose? #f)
+ (runtime-extra-arguments '())
+ (runtime-environment #~())
+ (runtime-requirement '()))
+ "Return a Shepherd service object that will create the volumes represented
+in CONFIG."
+ (let ((invocations
+ (map
+ (lambda (volume)
+ (oci-object-create-invocation
+ "volume" runtime-cli
+ (oci-volume-configuration-name volume)
+ (oci-volume-configuration->options volume)
+ runtime-extra-arguments
+ (oci-volume-configuration-extra-arguments volume)))
+ volumes)))
+
+ (oci-object-shepherd-service
+ "volume" runtime runtime-cli name runtime-requirement invocations
+ #:user user #:group group #:runtime-environment runtime-environment
+ #:verbose? verbose?)))
+
+(define (oci-service-accounts config)
+ (define user (oci-configuration-user config))
+ (define maybe-group (oci-configuration-group config))
+ (define runtime (oci-configuration-runtime config))
(list (user-account
- (name "oci-container")
+ (name user)
(comment "OCI services account")
- (group "docker")
- (system? #t)
- (home-directory "/var/empty")
+ (group "users")
+ (supplementary-groups
+ (list (oci-runtime-group runtime maybe-group)))
+ (system? (eq? 'docker runtime))
+ (home-directory (if (eq? 'podman runtime)
+ (string-append "/home/" user)
+ "/var/empty"))
+ (create-home-directory? (eq? 'podman runtime))
(shell (file-append shadow "/sbin/nologin")))))
+
+(define* (oci-state->shepherd-services runtime runtime-cli containers networks volumes
+ #:key (user #f) (group #f) (verbose? #f)
+ (networks-name #f) (volumes-name #f)
+ (runtime-extra-arguments '())
+ (runtime-environment #~())
+ (runtime-requirement '())
+ (containers-requirement '())
+ (networks-requirement '())
+ (volumes-requirement '()))
+ "Returns a list of Shepherd services based on the input OCI state."
+ (let* ((networks-name
+ (if (string? networks-name)
+ networks-name
+ (oci-networks-shepherd-name runtime)))
+ (networks?
+ (> (length networks) 0))
+ (networks-service
+ (if networks?
+ (list
+ (string->symbol networks-name))
+ '()))
+ (volumes-name
+ (if (string? volumes-name)
+ volumes-name
+ (oci-volumes-shepherd-name runtime)))
+ (volumes?
+ (> (length volumes) 0))
+ (volumes-service
+ (if volumes?
+ (list (string->symbol volumes-name))
+ '())))
+ (append
+ (map
+ (lambda (c)
+ (oci-container-shepherd-service
+ runtime runtime-cli c
+ #:user user
+ #:group group
+ #:runtime-environment runtime-environment
+ #:runtime-extra-arguments runtime-extra-arguments
+ #:oci-requirement
+ (append containers-requirement
+ runtime-requirement
+ networks-service
+ volumes-service)
+ #:verbose? verbose?))
+ containers)
+ (if networks?
+ (list
+ (oci-networks-shepherd-service
+ runtime runtime-cli
+ networks-name networks
+ #:user user #:group group
+ #:runtime-extra-arguments runtime-extra-arguments
+ #:runtime-environment runtime-environment
+ #:runtime-requirement (append networks-requirement
+ runtime-requirement)
+ #:verbose? verbose?))
+ '())
+ (if volumes?
+ (list
+ (oci-volumes-shepherd-service
+ runtime runtime-cli
+ volumes-name volumes
+ #:user user #:group group
+ #:runtime-extra-arguments runtime-extra-arguments
+ #:runtime-environment runtime-environment
+ #:runtime-requirement (append runtime-requirement
+ volumes-requirement)
+ #:verbose? verbose?))
+ '()))))
+
+(define (oci-configuration->shepherd-services config)
+ (let* ((runtime (oci-configuration-runtime config))
+ (system-runtime-cli
+ (oci-runtime-system-cli config))
+ (home-runtime-cli
+ (oci-runtime-home-cli config))
+ (runtime-extra-arguments
+ (oci-configuration-runtime-extra-arguments config))
+ (containers (oci-configuration-containers config))
+ (networks (oci-configuration-networks config))
+ (volumes (oci-configuration-volumes config))
+ (user (oci-configuration-user config))
+ (group (oci-runtime-group
+ runtime (oci-configuration-group config)))
+ (verbose? (oci-configuration-verbose? config))
+ (home-service?
+ (oci-configuration-home-service? config)))
+ (if home-service?
+ (oci-state->shepherd-services runtime home-runtime-cli containers networks volumes
+ #:verbose? verbose?
+ #:networks-name
+ (oci-networks-home-shepherd-name runtime)
+ #:volumes-name
+ (oci-volumes-home-shepherd-name runtime))
+ (oci-state->shepherd-services runtime system-runtime-cli containers networks volumes
+ #:user user
+ #:group
+ (oci-runtime-system-group runtime user group)
+ #:verbose? verbose?
+ #:runtime-extra-arguments
+ runtime-extra-arguments
+ #:runtime-environment
+ (oci-runtime-system-environment runtime user)
+ #:runtime-requirement
+ (oci-runtime-system-requirement runtime)
+ #:networks-requirement '(networking)))))
+
+(define (oci-service-subids config)
+ "Return a subids-extension record representing subuids and subgids required by
+the rootless Podman backend."
+ (define (delete-duplicate-ranges ranges)
+ (delete-duplicates ranges
+ (lambda args
+ (apply string=? (map subid-range-name ranges)))))
+ (define runtime
+ (oci-configuration-runtime config))
+ (define user
+ (oci-configuration-user config))
+ (define subgids (oci-configuration-subgids-range config))
+ (define subuids (oci-configuration-subuids-range config))
+ (define container-users
+ (filter (lambda (range)
+ (and (maybe-value-set?
+ (subid-range-name range))
+ (not (string=? (subid-range-name range) user))))
+ (map (lambda (container)
+ (subid-range
+ (name
+ (oci-container-configuration-user container))))
+ (oci-configuration-containers config))))
+ (define subgid-ranges
+ (delete-duplicate-ranges
+ (cons
+ (if (eq? subgids #f)
+ (subid-range (name user))
+ subgids)
+ container-users)))
+ (define subuid-ranges
+ (delete-duplicate-ranges
+ (cons
+ (if (eq? subuids #f)
+ (subid-range (name user))
+ subuids)
+ container-users)))
+
+ (if (eq? 'podman runtime)
+ (subids-extension
+ (subgids
+ subgid-ranges)
+ (subuids
+ subuid-ranges))
+ (subids-extension)))
+
+(define (oci-objects-merge-lst a b object get-name)
+ (define (contains? value lst)
+ (member value (map get-name lst)))
+ (let loop ((merged '())
+ (lst (append a b)))
+ (if (null? lst)
+ merged
+ (loop
+ (let ((element (car lst)))
+ (when (contains? element merged)
+ (raise
+ (formatted-message
+ (G_ "Duplicated ~a: ~a. ~as names should be unique, please
+remove the duplicate.") object (get-name element) object)))
+ (cons element merged))
+ (cdr lst)))))
+
+(define (oci-extension-merge a b)
+ (oci-extension
+ (containers (oci-objects-merge-lst
+ (oci-extension-containers a)
+ (oci-extension-containers b)
+ "container"
+ (lambda (config)
+ (define maybe-name (oci-container-configuration-provision config))
+ (if (maybe-value-set? maybe-name)
+ maybe-name
+ (oci-image->container-name
+ (oci-container-configuration-image config))))))
+ (networks (oci-objects-merge-lst
+ (oci-extension-networks a)
+ (oci-extension-networks b)
+ "network"
+ oci-network-configuration-name))
+ (volumes (oci-objects-merge-lst
+ (oci-extension-volumes a)
+ (oci-extension-volumes b)
+ "volume"
+ oci-volume-configuration-name))))
+
+(define (oci-service-profile runtime runtime-cli)
+ `(,bash-minimal
+ ,@(if (string? runtime-cli)
+ '()
+ (list
+ (cond
+ ((not (eq? runtime-cli #f))
+ runtime-cli)
+ ((eq? 'podman runtime)
+ podman)
+ (else
+ docker-cli))))))
+
+(define (oci-service-extension-wrap-validate extension)
+ (lambda (config)
+ (if (oci-configuration-valid? config)
+ (extension config)
+ (raise
+ (formatted-message
+ (G_ "Invalide oci-configuration ~a.") config)))))
+
+(define (oci-configuration-extend config extension)
+ (oci-configuration
+ (inherit config)
+ (containers
+ (oci-objects-merge-lst
+ (oci-configuration-containers config)
+ (oci-extension-containers extension)
+ "container"
+ (lambda (oci-config)
+ (define runtime
+ (oci-configuration-runtime config))
+ (oci-container-shepherd-name runtime oci-config))))
+ (networks (oci-objects-merge-lst
+ (oci-configuration-networks config)
+ (oci-extension-networks extension)
+ "network"
+ oci-network-configuration-name))
+ (volumes (oci-objects-merge-lst
+ (oci-configuration-volumes config)
+ (oci-extension-volumes extension)
+ "volume"
+ oci-volume-configuration-name))))
+
+(define oci-service-type
+ (service-type (name 'oci)
+ (extensions
+ (list
+ (service-extension profile-service-type
+ (oci-service-extension-wrap-validate
+ (lambda (config)
+ (let ((runtime-cli
+ (oci-configuration-runtime-cli config))
+ (runtime
+ (oci-configuration-runtime config)))
+ (oci-service-profile runtime runtime-cli)))))
+ (service-extension subids-service-type
+ (oci-service-extension-wrap-validate
+ oci-service-subids))
+ (service-extension account-service-type
+ (oci-service-extension-wrap-validate
+ oci-service-accounts))
+ (service-extension shepherd-root-service-type
+ (oci-service-extension-wrap-validate
+ oci-configuration->shepherd-services))))
+ ;; Concatenate OCI object lists.
+ (compose (lambda (args)
+ (fold oci-extension-merge
+ (oci-extension)
+ args)))
+ (extend oci-configuration-extend)
+ (default-value (oci-configuration))
+ (description
+ "This service implements the provisioning of OCI object such
+as containers, networks and volumes.")))
diff --git a/gnu/services/docker.scm b/gnu/services/docker.scm
index 828ceea313a..125e748bb0e 100644
--- a/gnu/services/docker.scm
+++ b/gnu/services/docker.scm
@@ -31,7 +31,10 @@ (define-module (gnu services docker)
#:use-module (gnu system shadow)
#:use-module (gnu packages docker)
#:use-module (gnu packages linux) ;singularity
+ #:use-module (guix deprecation)
+ #:use-module (guix diagnostics)
#:use-module (guix gexp)
+ #:use-module (guix i18n)
#:use-module (guix records)
#:use-module (srfi srfi-1)
#:use-module (ice-9 format)
@@ -67,16 +70,18 @@ (define-module (gnu services docker)
oci-container-configuration-volumes
oci-container-configuration-container-user
oci-container-configuration-workdir
- oci-container-configuration-extra-arguments
- oci-container-shepherd-service
- %oci-container-accounts)
+ oci-container-configuration-extra-arguments)
#:export (containerd-configuration
containerd-service-type
docker-configuration
docker-service-type
singularity-service-type
- oci-container-service-type))
+ ;; for backwards compatibility, until the
+ ;; oci-container-service-type is fully deprecated
+ oci-container-shepherd-service
+ oci-container-service-type
+ %oci-container-accounts))
(define-maybe file-like)
@@ -297,17 +302,25 @@ (define singularity-service-type
;;; OCI container.
;;;
-(define (configs->shepherd-services configs)
- (map oci-container-shepherd-service configs))
+;; for backwards compatibility, until the
+;; oci-container-service-type is fully deprecated
+(define-deprecated (oci-container-shepherd-service config)
+ oci-service-type
+ ((@ (gnu services containers) oci-container-shepherd-service)
+ 'docker config))
+(define %oci-container-accounts
+ (filter user-account? (oci-service-accounts (oci-configuration))))
(define oci-container-service-type
(service-type (name 'oci-container)
- (extensions (list (service-extension profile-service-type
- (lambda _ (list docker-cli)))
- (service-extension account-service-type
- (const %oci-container-accounts))
- (service-extension shepherd-root-service-type
- configs->shepherd-services)))
+ (extensions
+ (list (service-extension oci-service-type
+ (lambda (containers)
+ (warning
+ (G_
+ "'oci-container-service-type' is deprecated, use 'oci-service-type' instead~%"))
+ (oci-extension
+ (containers containers))))))
(default-value '())
(extend append)
(compose concatenate)
diff --git a/gnu/tests/containers.scm b/gnu/tests/containers.scm
index 0ecc8ddb126..5e6f39387e7 100644
--- a/gnu/tests/containers.scm
+++ b/gnu/tests/containers.scm
@@ -27,6 +27,9 @@ (define-module (gnu tests containers)
#:use-module (gnu services)
#:use-module (gnu services containers)
#:use-module (gnu services desktop)
+ #:use-module ((gnu services docker)
+ #:select (containerd-service-type
+ docker-service-type))
#:use-module (gnu services dbus)
#:use-module (gnu services networking)
#:use-module (gnu system)
@@ -39,7 +42,9 @@ (define-module (gnu tests containers)
#:use-module (guix profiles)
#:use-module ((guix scripts pack) #:prefix pack:)
#:use-module (guix store)
- #:export (%test-rootless-podman))
+ #:export (%test-rootless-podman
+ %test-oci-service-rootless-podman
+ %test-oci-service-docker))
(define %rootless-podman-os
@@ -345,3 +350,995 @@ (define %test-rootless-podman
(name "rootless-podman")
(description "Test rootless Podman service.")
(value (build-tarball&run-rootless-podman-test))))
+
+
+(define %oci-rootless-podman-os
+ (simple-operating-system
+ (service dhcp-client-service-type)
+ (service dbus-root-service-type)
+ (service polkit-service-type)
+ (service elogind-service-type)
+ (service iptables-service-type)
+ (service rootless-podman-service-type)
+ (extra-special-file "/shared.txt"
+ (plain-file "shared.txt" "hello"))
+ (service oci-service-type
+ (oci-configuration
+ (runtime 'podman)
+ (verbose? #t)))
+ (simple-service 'oci-provisioning
+ oci-service-type
+ (oci-extension
+ (networks
+ (list (oci-network-configuration (name "my-network"))))
+ (volumes
+ (list (oci-volume-configuration (name "my-volume"))))
+ (containers
+ (list
+ (oci-container-configuration
+ (provision "first")
+ (image
+ (oci-image
+ (repository "guile")
+ (value
+ (specifications->manifest '("guile")))
+ (pack-options
+ '(#:symlinks (("/bin" -> "bin"))))))
+ (entrypoint "/bin/guile")
+ (network "my-network")
+ (command
+ '("-c" "(use-modules (web server))
+(define (handler request request-body)
+ (values '((content-type . (text/plain))) \"out of office\"))
+(run-server handler 'http `(#:addr ,(inet-pton AF_INET \"0.0.0.0\")))"))
+ (host-environment
+ '(("VARIABLE" . "value")))
+ (volumes
+ '(("my-volume" . "/my-volume")))
+ (extra-arguments
+ '("--env" "VARIABLE")))
+ (oci-container-configuration
+ (provision "second")
+ (image
+ (oci-image
+ (repository "guile")
+ (value
+ (specifications->manifest '("guile")))
+ (pack-options
+ '(#:symlinks (("/bin" -> "bin"))))))
+ (entrypoint "/bin/guile")
+ (network "my-network")
+ (command
+ '("-c" "(let l ((c 300))(display c)(sleep 1)(when(positive? c)(l (- c 1))))"))
+ (volumes
+ '(("my-volume" . "/my-volume")
+ ("/shared.txt" . "/shared.txt:ro"))))))))))
+
+(define (run-rootless-podman-oci-service-test)
+ (define os
+ (marionette-operating-system
+ (operating-system-with-gc-roots
+ %oci-rootless-podman-os
+ (list))
+ #: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))
+ #~(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-oci-service")
+
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (wait-for-service 'user-processes))
+ marionette)
+
+ (test-assert "rootless-podman services started successfully"
+ (begin
+ (define (run-test)
+ (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))
+ ;; Allow services to come up on slower machines
+ (let loop ((attempts 0))
+ (if (= attempts 60)
+ (error "Services didn't come up after more than 60 seconds")
+ (if (equal? '("cgroup" "cgroup")
+ (run-test))
+ #t
+ (begin
+ (sleep 1)
+ (format #t "Services didn't come up yet, retrying with attempt ~a~%"
+ (+ 1 attempts))
+ (loop (+ 1 attempts))))))))
+
+ (test-assert "podman-volumes running"
+ (begin
+ (define (run-test)
+ (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 6))
+ (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 "oci-container")))
+ (setuid (passwd:uid (getpw "oci-container")))
+
+ (let ((response (slurp
+ "/run/current-system/profile/bin/podman"
+ "volume" "ls" "-n" "--format" "\"{{.Name}}\""
+ "|" "tr" "' '" "'\n'")))
+
+ (call-with-output-file (string-append ,out-dir "/response")
+ (lambda (port)
+ (display (string-join response "\n") port)))))
+ (lambda ()
+ (primitive-exit 127))))
+ (pid
+ (cdr (waitpid pid))))
+
+ (wait-for-file (string-append ,out-dir "/response"))
+
+ (stable-sort
+ (slurp "cat" (string-append ,out-dir "/response"))
+ string<=?))
+ marionette))
+ ;; Allow services to come up on slower machines
+ (let loop ((attempts 0))
+ (if (= attempts 80)
+ (error "Service didn't come up after more than 80 seconds")
+ (if (equal? '("my-volume")
+ (run-test))
+ #t
+ (begin
+ (sleep 1)
+ (loop (+ 1 attempts))))))))
+
+ (test-assert "podman-networks running"
+ (begin
+ (define (run-test)
+ (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 6))
+ (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 "oci-container")))
+ (setuid (passwd:uid (getpw "oci-container")))
+
+ (let ((response (slurp
+ "/run/current-system/profile/bin/podman"
+ "network" "ls" "-n" "--format" "\"{{.Name}}\""
+ "|" "tr" "' '" "'\n'")))
+
+ (call-with-output-file (string-append ,out-dir "/response")
+ (lambda (port)
+ (display (string-join response "\n") port)))))
+ (lambda ()
+ (primitive-exit 127))))
+ (pid
+ (cdr (waitpid pid))))
+
+ (wait-for-file (string-append ,out-dir "/response"))
+
+ (stable-sort
+ (slurp "cat" (string-append ,out-dir "/response"))
+ string<=?))
+ marionette))
+ ;; Allow services to come up on slower machines
+ (let loop ((attempts 0))
+ (if (= attempts 80)
+ (error "Service didn't come up after more than 80 seconds")
+ (if (equal? '("my-network" "podman")
+ (run-test))
+ #t
+ (begin
+ (sleep 1)
+ (loop (+ 1 attempts))))))))
+
+ (test-assert "first container running"
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (wait-for-service 'first #:timeout 120)
+ #t)
+ marionette))
+
+ (test-assert "second container running"
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (wait-for-service 'second #:timeout 120)
+ #t)
+ marionette))
+
+ (test-assert "passing host environment variables"
+ (begin
+ (define (run-test)
+ (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 "oci-container")))
+ (setuid (passwd:uid (getpw "oci-container")))
+
+ (let ((response (slurp
+ "/run/current-system/profile/bin/podman"
+ "exec" "first"
+ "/bin/guile" "-c" "'(display (getenv \"VARIABLE\"))'")))
+ (call-with-output-file (string-append ,out-dir "/response")
+ (lambda (port)
+ (display (string-join response "\n") port)))))
+ (lambda ()
+ (primitive-exit 127))))
+ (pid
+ (cdr (waitpid pid))))
+
+ (wait-for-file (string-append ,out-dir "/response"))
+ (slurp "cat" (string-append ,out-dir "/response")))
+ marionette))
+ ;; Allow image to be loaded on slower machines
+ (let loop ((attempts 0))
+ (if (= attempts 180)
+ (error "Service didn't come up after more than 180 seconds")
+ (if (equal? (list "value")
+ (run-test))
+ #t
+ (begin
+ (sleep 1)
+ (loop (+ 1 attempts))))))))
+
+ (test-equal "mounting host files"
+ '("hello")
+ (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 "oci-container")))
+ (setuid (passwd:uid (getpw "oci-container")))
+
+ (let ((response (slurp
+ "/run/current-system/profile/bin/podman"
+ "exec" "second"
+ "/bin/guile" "-c" "'(begin (use-modules (ice-9 popen) (ice-9 rdelim))
+(display (call-with-input-file \"/shared.txt\" read-line)))'")))
+ (call-with-output-file (string-append ,out-dir "/response")
+ (lambda (port)
+ (display (string-join response " ") port)))))
+ (lambda ()
+ (primitive-exit 127))))
+ (pid
+ (cdr (waitpid pid))))
+
+ (wait-for-file (string-append ,out-dir "/response"))
+ (slurp "cat" (string-append ,out-dir "/response")))
+ marionette))
+
+ (test-equal "write to volumes"
+ '("world")
+ (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 "oci-container")))
+ (setuid (passwd:uid (getpw "oci-container")))
+
+ (slurp
+ "/run/current-system/profile/bin/podman"
+ "exec" "first"
+ "/bin/guile" "-c" "'(begin (use-modules (ice-9 popen) (ice-9 rdelim))
+(call-with-output-file \"/my-volume/out.txt\" (lambda (p) (display \"world\" p))))'")
+
+ (let ((response (slurp
+ "/run/current-system/profile/bin/podman"
+ "exec" "second"
+ "/bin/guile" "-c" "'(begin (use-modules (ice-9 popen) (ice-9 rdelim))
+(display (call-with-input-file \"/my-volume/out.txt\" read-line)))'")))
+ (call-with-output-file (string-append ,out-dir "/response")
+ (lambda (port)
+ (display (string-join response " ") port)))))
+ (lambda ()
+ (primitive-exit 127))))
+ (pid
+ (cdr (waitpid pid))))
+
+ (wait-for-file (string-append ,out-dir "/response"))
+ (slurp "cat" (string-append ,out-dir "/response")))
+ marionette))
+
+ (test-equal "can read ports over network"
+ '("out of office")
+ (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 "oci-container")))
+ (setuid (passwd:uid (getpw "oci-container")))
+
+ (let ((response (slurp
+ "/run/current-system/profile/bin/podman"
+ "exec" "second"
+ "/bin/guile" "-c" "'(begin (use-modules (web client))
+(define-values (response out)
+ (http-get \"http://first:8080\"))
+(display out))'")))
+ (call-with-output-file (string-append ,out-dir "/response")
+ (lambda (port)
+ (display (string-join response " ") port)))))
+ (lambda ()
+ (primitive-exit 127))))
+ (pid
+ (cdr (waitpid pid))))
+
+ (wait-for-file (string-append ,out-dir "/response"))
+ (slurp "cat" (string-append ,out-dir "/response")))
+ marionette))
+
+ (test-end))))
+
+ (gexp->derivation "rootless-podman-oci-service-test" test))
+
+(define %test-oci-service-rootless-podman
+ (system-test
+ (name "oci-service-rootless-podman")
+ (description "Test Rootless-Podman backed OCI provisioning service.")
+ (value (run-rootless-podman-oci-service-test))))
+
+(define %oci-docker-os
+ (simple-operating-system
+ (service dhcp-client-service-type)
+ (service dbus-root-service-type)
+ (service polkit-service-type)
+ (service elogind-service-type)
+ (service containerd-service-type)
+ (service docker-service-type)
+ (extra-special-file "/shared.txt"
+ (plain-file "shared.txt" "hello"))
+ (service oci-service-type
+ (oci-configuration
+ (verbose? #t)))
+ (simple-service 'oci-provisioning
+ oci-service-type
+ (oci-extension
+ (networks
+ (list (oci-network-configuration (name "my-network"))))
+ (volumes
+ (list (oci-volume-configuration (name "my-volume"))))
+ (containers
+ (list
+ (oci-container-configuration
+ (provision "first")
+ (image
+ (oci-image
+ (repository "guile")
+ (value
+ (specifications->manifest '("guile")))
+ (pack-options
+ '(#:symlinks (("/bin" -> "bin"))))))
+ (entrypoint "/bin/guile")
+ (network "my-network")
+ (command
+ '("-c" "(use-modules (web server))
+(define (handler request request-body)
+ (values '((content-type . (text/plain))) \"out of office\"))
+(run-server handler 'http `(#:addr ,(inet-pton AF_INET \"0.0.0.0\")))"))
+ (host-environment
+ '(("VARIABLE" . "value")))
+ (volumes
+ '(("my-volume" . "/my-volume")))
+ (extra-arguments
+ '("--env" "VARIABLE")))
+ (oci-container-configuration
+ (provision "second")
+ (image
+ (oci-image
+ (repository "guile")
+ (value
+ (specifications->manifest '("guile")))
+ (pack-options
+ '(#:symlinks (("/bin" -> "bin"))))))
+ (entrypoint "/bin/guile")
+ (network "my-network")
+ (command
+ '("-c" "(let l ((c 300))(display c)(sleep 1)(when(positive? c)(l (- c 1))))"))
+ (volumes
+ '(("my-volume" . "/my-volume")
+ ("/shared.txt" . "/shared.txt:ro"))))))))))
+
+(define (run-docker-oci-service-test)
+ (define os
+ (marionette-operating-system
+ (operating-system-with-gc-roots
+ %oci-docker-os
+ (list))
+ #: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))
+ #~(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))
+
+ (test-runner-current (system-test-runner #$output))
+ (test-begin "docker-oci-service")
+
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (wait-for-service 'dockerd))
+ marionette)
+
+ (test-assert "docker-volumes running"
+ (begin
+ (define (run-test)
+ (marionette-eval
+ `(begin
+ (use-modules (ice-9 popen)
+ (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
+ (list "sh" "-l" "-c"
+ (string-join
+ args
+ " "))))
+ (output (read-lines port))
+ (status (close-pipe port)))
+ output)))
+
+ (stable-sort
+ (slurp
+ "/run/current-system/profile/bin/docker"
+ "volume" "ls" "--format" "\"{{.Name}}\"")
+ string<=?))
+
+ marionette))
+ ;; Allow services to come up on slower machines
+ (let loop ((attempts 0))
+ (if (= attempts 80)
+ (error "Service didn't come up after more than 80 seconds")
+ (if (equal? '("my-volume")
+ (run-test))
+ #t
+ (begin
+ (sleep 1)
+ (loop (+ 1 attempts))))))))
+
+ (test-assert "docker-networks running"
+ (begin
+ (define (run-test)
+ (marionette-eval
+ `(begin
+ (use-modules (ice-9 popen)
+ (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
+ (list "sh" "-l" "-c"
+ (string-join
+ args
+ " "))))
+ (output (read-lines port))
+ (status (close-pipe port)))
+ output)))
+
+ (stable-sort
+ (slurp
+ "/run/current-system/profile/bin/docker"
+ "network" "ls" "--format" "\"{{.Name}}\"")
+ string<=?))
+
+ marionette))
+ ;; Allow services to come up on slower machines
+ (let loop ((attempts 0))
+ (if (= attempts 80)
+ (error "Service didn't come up after more than 80 seconds")
+ (if (equal? '("bridge" "host" "my-network" "none")
+ (run-test))
+ #t
+ (begin
+ (sleep 1)
+ (loop (+ 1 attempts))))))))
+
+ (test-assert "first container running"
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (wait-for-service 'first #:timeout 120)
+ #t)
+ marionette))
+
+ (test-assert "second container running"
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (wait-for-service 'second #:timeout 120)
+ #t)
+ marionette))
+
+ (test-assert "passing host environment variables"
+ (begin
+ (define (run-test)
+ (marionette-eval
+ `(begin
+ (use-modules (ice-9 popen)
+ (ice-9 rdelim))
+
+ (define slurp
+ (lambda args
+ (let* ((port (apply open-pipe* OPEN_READ args))
+ (output (let ((line (read-line port)))
+ (if (eof-object? line)
+ ""
+ line)))
+ (status (close-pipe port)))
+ output)))
+
+ (slurp
+ "/run/current-system/profile/bin/docker"
+ "exec" "first"
+ "/bin/guile" "-c" "(display (getenv \"VARIABLE\"))"))
+ marionette))
+ ;; Allow image to be loaded on slower machines
+ (let loop ((attempts 0))
+ (if (= attempts 180)
+ (error "Service didn't come up after more than 180 seconds")
+ (if (equal? "value"
+ (run-test))
+ #t
+ (begin
+ (sleep 1)
+ (loop (+ 1 attempts))))))))
+
+ (test-equal "mounting host files"
+ "hello"
+ (marionette-eval
+ `(begin
+ (use-modules (ice-9 popen)
+ (ice-9 rdelim))
+
+ (define slurp
+ (lambda args
+ (let* ((port (apply open-pipe* OPEN_READ args))
+ (output (let ((line (read-line port)))
+ (if (eof-object? line)
+ ""
+ line)))
+ (status (close-pipe port)))
+ output)))
+
+ (slurp
+ "/run/current-system/profile/bin/docker"
+ "exec" "second"
+ "/bin/guile" "-c" "(begin (use-modules (ice-9 popen) (ice-9 rdelim))
+(display (call-with-input-file \"/shared.txt\" read-line)))"))
+ marionette))
+
+ (test-equal "write to volumes"
+ "world"
+ (marionette-eval
+ `(begin
+ (use-modules (ice-9 popen)
+ (ice-9 rdelim))
+
+ (define slurp
+ (lambda args
+ (let* ((port (apply open-pipe* OPEN_READ args))
+ (output (let ((line (read-line port)))
+ (if (eof-object? line)
+ ""
+ line)))
+ (status (close-pipe port)))
+ output)))
+
+ (slurp
+ "/run/current-system/profile/bin/docker"
+ "exec" "first"
+ "/bin/guile" "-c" "(begin (use-modules (ice-9 popen) (ice-9 rdelim))
+(call-with-output-file \"/my-volume/out.txt\" (lambda (p) (display \"world\" p))))")
+ (slurp
+ "/run/current-system/profile/bin/docker"
+ "exec" "second"
+ "/bin/guile" "-c" "(begin (use-modules (ice-9 popen) (ice-9 rdelim))
+(display (call-with-input-file \"/my-volume/out.txt\" read-line)))"))
+ marionette))
+
+ (test-equal "can read ports over network"
+ "out of office"
+ (marionette-eval
+ `(begin
+ (use-modules (ice-9 popen)
+ (ice-9 rdelim))
+
+ (define slurp
+ (lambda args
+ (let* ((port (apply open-pipe* OPEN_READ args))
+ (output (let ((line (read-line port)))
+ (if (eof-object? line)
+ ""
+ line)))
+ (status (close-pipe port)))
+ output)))
+
+ (slurp
+ "/run/current-system/profile/bin/docker"
+ "exec" "second"
+ "/bin/guile" "-c" "(begin (use-modules (web client))
+(define-values (response out)
+ (http-get \"http://first:8080\"))
+(display out))"))
+ marionette))
+
+ (test-end))))
+
+ (gexp->derivation "docker-oci-service-test" test))
+
+(define %test-oci-service-docker
+ (system-test
+ (name "oci-service-docker")
+ (description "Test Docker backed OCI provisioning service.")
+ (value (run-docker-oci-service-test))))
--
2.48.1
guix-patches <at> gnu.org:bug#76081; Package guix-patches.
(Sun, 09 Mar 2025 01:07:03 GMT) Full text and rfc822 format available.Message #125 received at 76081 <at> debbugs.gnu.org (full text, mbox):
From: Giacomo Leidi <goodoldpaul <at> autistici.org> To: 76081 <at> debbugs.gnu.org Cc: Giacomo Leidi <goodoldpaul <at> autistici.org> Subject: [PATCH v8 1/5] services: rootless-podman: Use login shell. Date: Sun, 9 Mar 2025 02:06:11 +0100
This commit allows for having PATH set when changing the owner of
/sys/fs/group.
* gnu/services/containers.scm (crgroups-fs-owner): Use login shell.
Change-Id: I9510c637a5332325e05ca5ebc9dfd4de32685c50
---
gnu/services/containers.scm | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm
index b3cd109ce6c..d5a211765a6 100644
--- a/gnu/services/containers.scm
+++ b/gnu/services/containers.scm
@@ -140,7 +140,7 @@ (define (cgroups-fs-owner-entrypoint config)
(rootless-podman-configuration-group-name config))
(program-file "cgroups2-fs-owner-entrypoint"
#~(system*
- (string-append #+bash-minimal "/bin/bash") "-c"
+ (string-append #+bash-minimal "/bin/bash") "-l" "-c"
(string-append "echo Setting /sys/fs/cgroup "
"group ownership to " #$group " && chown -v "
"root:" #$group " /sys/fs/cgroup && "
base-commit: 5adfe1b8e92ff332656bcc7a9d71a35306b3411e
--
2.48.1
guix-patches <at> gnu.org:bug#76081; Package guix-patches.
(Sun, 09 Mar 2025 01:07:03 GMT) Full text and rfc822 format available.Message #128 received at 76081 <at> debbugs.gnu.org (full text, mbox):
From: Giacomo Leidi <goodoldpaul <at> autistici.org> To: 76081 <at> debbugs.gnu.org Cc: Giacomo Leidi <goodoldpaul <at> autistici.org> Subject: [PATCH v8 4/5] tests: Use lower-oci-image-state in container tests. Date: Sun, 9 Mar 2025 02:06:14 +0100
This patch replaces boilerplate in container related tests with
oci-image plumbing from (gnu services containers).
* gnu/services/containers.scm: Export lower-oci-image-state.
* gnu/tests/containers.scm (%oci-tarball): New variable;
(run-rootless-podman-test): use %oci-tarball;
(build-tarball&run-rootless-podman-test): drop procedure.
* gnu/tests/docker.scm (%docker-tarball): New variable;
(build-tarball&run-docker-test): use %docker-tarball;
(%docker-system-tarball): New variable;
(build-tarball&run-docker-system-test): new procedure.
Change-Id: Iad6f0704aee188d89464c83722dea0bb7adb084a
---
gnu/services/containers.scm | 2 +
gnu/tests/containers.scm | 80 ++++++++++++++---------------
gnu/tests/docker.scm | 100 ++++++++++++++++++++----------------
3 files changed, 95 insertions(+), 87 deletions(-)
diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm
index a78be00f038..700c7b63603 100644
--- a/gnu/services/containers.scm
+++ b/gnu/services/containers.scm
@@ -75,6 +75,8 @@ (define-module (gnu services containers)
oci-image-system
oci-image-grafts?
+ lower-oci-image-state
+
oci-container-configuration
oci-container-configuration?
oci-container-configuration-fields
diff --git a/gnu/tests/containers.scm b/gnu/tests/containers.scm
index 5e6f39387e7..8cdd86e7ae3 100644
--- a/gnu/tests/containers.scm
+++ b/gnu/tests/containers.scm
@@ -69,13 +69,47 @@ (define %rootless-podman-os
(supplementary-groups '("wheel" "netdev" "cgroup"
"audio" "video")))))))
-(define (run-rootless-podman-test oci-tarball)
+(define %oci-tarball
+ (lower-oci-image-state
+ "guile-guest"
+ (packages->manifest
+ (list
+ guile-3.0 guile-json-3
+ (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))))
+ '(#:entry-point "bin/guile"
+ #:localstatedir? #t
+ #:extra-options (#:image-tag "guile-guest")
+ #:symlinks (("/bin/Guile" -> "bin/guile")
+ ("aa.scm" -> "a.scm")))
+ "guile-guest"
+ (%current-target-system)
+ (%current-system)
+ #f))
+
+(define (run-rootless-podman-test)
(define os
(marionette-operating-system
(operating-system-with-gc-roots
%rootless-podman-os
- (list oci-tarball))
+ (list %oci-tarball))
#:imported-modules '((gnu services herd)
(guix combinators))))
@@ -254,7 +288,7 @@ (define (run-rootless-podman-test oci-tarball)
(let* ((loaded (slurp ,(string-append #$podman
"/bin/podman")
"load" "-i"
- ,#$oci-tarball))
+ ,#$%oci-tarball))
(repository&tag "localhost/guile-guest:latest")
(response1 (slurp
,(string-append #$podman "/bin/podman")
@@ -307,49 +341,11 @@ (define (run-rootless-podman-test oci-tarball)
(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))))
+ (value (run-rootless-podman-test))))
(define %oci-rootless-podman-os
diff --git a/gnu/tests/docker.scm b/gnu/tests/docker.scm
index 5dcf05a17e3..07edd9d5341 100644
--- a/gnu/tests/docker.scm
+++ b/gnu/tests/docker.scm
@@ -26,6 +26,7 @@ (define-module (gnu tests docker)
#:use-module (gnu system image)
#:use-module (gnu system vm)
#:use-module (gnu services)
+ #:use-module (gnu services containers)
#:use-module (gnu services dbus)
#:use-module (gnu services networking)
#:use-module (gnu services docker)
@@ -57,6 +58,40 @@ (define %docker-os
(service containerd-service-type)
(service docker-service-type)))
+(define %docker-tarball
+ (lower-oci-image-state
+ "guile-guest"
+ (packages->manifest
+ (list
+ guile-3.0 guile-json-3
+ (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))))
+ '(#:entry-point "bin/guile"
+ #:localstatedir? #t
+ #:extra-options (#:image-tag "guile-guest")
+ #:symlinks (("/bin/Guile" -> "bin/guile")
+ ("aa.scm" -> "a.scm")))
+ "guile-guest"
+ (%current-target-system)
+ (%current-system)
+ #f))
+
(define (run-docker-test docker-tarball)
"Load DOCKER-TARBALL as Docker image and run it in a Docker container,
inside %DOCKER-OS."
@@ -173,40 +208,7 @@ (define (run-docker-test docker-tarball)
(gexp->derivation "docker-test" test))
(define (build-tarball&run-docker-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"))
- #:entry-point "bin/guile"
- #:localstatedir? #t)))
- (run-docker-test tarball)))
+ (run-docker-test %docker-tarball))
(define %test-docker
(system-test
@@ -215,8 +217,22 @@ (define %test-docker
(value (build-tarball&run-docker-test))))
+(define %docker-system-tarball
+ (lower-oci-image-state
+ "guix-system-guest"
+ (operating-system
+ (inherit (simple-operating-system))
+ ;; Use locales for a single libc to
+ ;; reduce space requirements.
+ (locale-libcs (list glibc)))
+ '()
+ "guix-system-guest"
+ (%current-target-system)
+ (%current-system)
+ #f))
+
(define (run-docker-system-test tarball)
- "Load DOCKER-TARBALL as Docker image and run it in a Docker container,
+ "Load TARBALL as Docker image and run it in a Docker container,
inside %DOCKER-OS."
(define os
(marionette-operating-system
@@ -333,21 +349,15 @@ (define (run-docker-system-test tarball)
(gexp->derivation "docker-system-test" test))
+(define (build-tarball&run-docker-system-test)
+ (run-docker-system-test %docker-system-tarball))
+
(define %test-docker-system
(system-test
(name "docker-system")
(description "Run a system image as produced by @command{guix system
docker-image} inside Docker.")
- (value (with-monad %store-monad
- (>>= (lower-object
- (system-image (os->image
- (operating-system
- (inherit (simple-operating-system))
- ;; Use locales for a single libc to
- ;; reduce space requirements.
- (locale-libcs (list glibc)))
- #:type docker-image-type)))
- run-docker-system-test)))))
+ (value (build-tarball&run-docker-system-test))))
(define %oci-os
--
2.48.1
andrew <at> trop.in, janneke <at> gnu.org, ludo <at> gnu.org, maxim.cournoyer <at> gmail.com, tanguy <at> bioneland.org, guix-patches <at> gnu.org:bug#76081; Package guix-patches.
(Sun, 09 Mar 2025 01:07:04 GMT) Full text and rfc822 format available.Message #131 received at 76081 <at> debbugs.gnu.org (full text, mbox):
From: Giacomo Leidi <goodoldpaul <at> autistici.org> To: 76081 <at> debbugs.gnu.org Cc: Giacomo Leidi <goodoldpaul <at> autistici.org> Subject: [PATCH v8 5/5] home: Add home-oci-service-type. Date: Sun, 9 Mar 2025 02:06:15 +0100
* gnu/home/service/containers.scm: New file;
* gnu/local.mk (GNU_SYSTEM_MODULES): Add it.
* doc/guix.texi (OCI backed services): Document it.
Change-Id: I8ce5b301e8032d0a7b2a9ca46752738cdee1f030
---
doc/guix.texi | 114 +++++++++++++++++++++++++++++++
gnu/home/services/containers.scm | 50 ++++++++++++++
gnu/local.mk | 1 +
gnu/services/containers.scm | 5 ++
4 files changed, 170 insertions(+)
create mode 100644 gnu/home/services/containers.scm
diff --git a/doc/guix.texi b/doc/guix.texi
index 8686380669b..7ed469f7920 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -50403,6 +50403,120 @@ Miscellaneous Home Services
(dicod-configuration @dots{})))
@end lisp
+@subsubheading OCI backed services
+
+@cindex OCI-backed, for Home
+The @code{(gnu home services containers)} module provides the following service:
+
+@defvar home-oci-service-type
+This is the type of the service that allows to manage your OCI containers with
+the same consistent interface you use for your other Home Shepherd services.
+@end defvar
+
+This service is a direct mapping of the @code{oci-service-type} system
+service (@pxref{Miscellaneous Services, OCI backed services}). You can
+use it like this:
+
+@lisp
+(use-modules (gnu services containers)
+ (gnu home services containers))
+
+(simple-service 'home-oci-provisioning
+ home-oci-service-type
+ (oci-extension
+ (volumes
+ (list
+ (oci-volume-configuration (name "prometheus"))
+ (oci-volume-configuration (name "grafana"))))
+ (networks
+ (list
+ (oci-network-configuration (name "monitoring"))))
+ (containers
+ (list
+ (oci-container-configuration
+ (network "monitoring")
+ (image
+ (oci-image
+ (repository "guile")
+ (tag "3")
+ (value (specifications->manifest '("guile")))
+ (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile"))
+ #:max-layers 2))))
+ (entrypoint "/bin/guile")
+ (command
+ '("-c" "(display \"hello!\n\")")))
+ (oci-container-configuration
+ (image "prom/prometheus")
+ (network "monitoring")
+ (ports
+ '(("9000" . "9000")
+ ("9090" . "9090")))
+ (volumes
+ (list
+ '(("prometheus" . "/var/lib/prometheus")))))
+ (oci-container-configuration
+ (image "grafana/grafana:10.0.1")
+ (network "monitoring")
+ (volumes
+ '(("grafana:/var/lib/grafana"))))))))
+
+@end lisp
+
+You may specify a custom configuration by providing a
+@code{oci-configuration} record, exactly like for
+@code{oci-service-type}, but wrapping it in @code{for-home}:
+
+@lisp
+(use-modules (gnu services)
+ (gnu services containers)
+ (gnu home services containers))
+
+(service home-oci-service-type
+ (for-home
+ (oci-configuration
+ (runtime 'podman)
+ (verbose? #t))))
+
+(simple-service 'home-oci-provisioning
+ home-oci-service-type
+ (oci-extension
+ (volumes
+ (list
+ (oci-volume-configuration (name "prometheus"))
+ (oci-volume-configuration (name "grafana"))))
+ (networks
+ (list
+ (oci-network-configuration (name "monitoring"))))
+ (containers
+ (list
+ (oci-container-configuration
+ (network "monitoring")
+ (image
+ (oci-image
+ (repository "guile")
+ (tag "3")
+ (value (specifications->manifest '("guile")))
+ (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile"))
+ #:max-layers 2))))
+ (entrypoint "/bin/guile")
+ (command
+ '("-c" "(display \"hello!\n\")")))
+ (oci-container-configuration
+ (image "prom/prometheus")
+ (network "monitoring")
+ (ports
+ '(("9000" . "9000")
+ ("9090" . "9090")))
+ (volumes
+ (list
+ '(("prometheus" . "/var/lib/prometheus")))))
+ (oci-container-configuration
+ (image "grafana/grafana:10.0.1")
+ (network "monitoring")
+ (volumes
+ '(("grafana:/var/lib/grafana"))))))))
+@end lisp
+
@node Invoking guix home
@section Invoking @command{guix home}
diff --git a/gnu/home/services/containers.scm b/gnu/home/services/containers.scm
new file mode 100644
index 00000000000..938dde2f37a
--- /dev/null
+++ b/gnu/home/services/containers.scm
@@ -0,0 +1,50 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2025 Giacomo Leidi <goodoldpaul <at> 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 home services containers)
+ #:use-module (gnu home services)
+ #:use-module (gnu home services shepherd)
+ #:use-module (gnu services)
+ #:use-module (gnu services configuration)
+ #:use-module (gnu services containers)
+ #:use-module (guix gexp)
+ #:use-module (guix packages)
+ #:use-module (srfi srfi-1)
+ #:export (home-oci-service-type))
+
+(define home-oci-service-type
+ (service-type (inherit (system->home-service-type oci-service-type))
+ (extensions
+ (list
+ (service-extension home-profile-service-type
+ (oci-service-extension-wrap-validate
+ (lambda (config)
+ (let ((runtime-cli
+ (oci-configuration-runtime-cli config))
+ (runtime
+ (oci-configuration-runtime config)))
+ (oci-service-profile runtime runtime-cli)))))
+ (service-extension home-shepherd-service-type
+ (oci-service-extension-wrap-validate
+ oci-configuration->shepherd-services))))
+ (extend
+ (lambda (config extension)
+ (for-home
+ (oci-configuration
+ (inherit (oci-configuration-extend config extension))))))
+ (default-value (for-home (oci-configuration)))))
diff --git a/gnu/local.mk b/gnu/local.mk
index 9082ed04bfe..e0d1a25a607 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -103,6 +103,7 @@ GNU_SYSTEM_MODULES = \
%D%/home.scm \
%D%/home/services.scm \
%D%/home/services/admin.scm \
+ %D%/home/services/containers.scm \
%D%/home/services/desktop.scm \
%D%/home/services/dict.scm \
%D%/home/services/dotfiles.scm \
diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm
index 700c7b63603..002bbc1057b 100644
--- a/gnu/services/containers.scm
+++ b/gnu/services/containers.scm
@@ -762,6 +762,9 @@ (define-configuration/no-serialization oci-network-configuration
(define (list-of-oci-networks? value)
(list-of-oci-records? "networks" oci-network-configuration? value))
+;; (for-home (oci-configuration ...)) is not able to replace for-home? with #t,
+;; pk prints #f. Once for-home will be able to work with (gnu services configuration) the
+;; record can be migrated back to define-configuration.
(define-record-type* <oci-configuration>
oci-configuration
make-oci-configuration
@@ -796,6 +799,8 @@ (define-record-type* <oci-configuration>
(define (package-or-string? value)
(or (package? value) (string? value)))
+;; TODO: This procedure can be dropped once we switch to define-configuration for
+;; oci-configuration.
(define (oci-configuration-valid? config)
(define runtime-cli
(oci-configuration-runtime-cli config))
--
2.48.1
guix-patches <at> gnu.org:bug#76081; Package guix-patches.
(Sun, 09 Mar 2025 01:07:04 GMT) Full text and rfc822 format available.Message #134 received at 76081 <at> debbugs.gnu.org (full text, mbox):
From: Giacomo Leidi <goodoldpaul <at> autistici.org> To: 76081 <at> debbugs.gnu.org Cc: Giacomo Leidi <goodoldpaul <at> autistici.org> Subject: [PATCH v8 2/5] services: oci-container-configuration: Move to (gnu services containers). Date: Sun, 9 Mar 2025 02:06:12 +0100
This patch moves the oci-container-configuration and related
configuration records to (gnu services containers).
Public symbols are still exported for backwards
compatibility but since the oci-container-service-type will be
deprecated in favor of the more general oci-service-type, everything is
moved outside of the docker related module.
* gnu/services/docker.scm: Move everything related to oci-container-configuration
to...
* gnu/services/containers.scm: ...here.scm.
* gnu/tests/docker.scm: Simplify %test-oci-container test case.
Change-Id: Iae599dd5cc7442eb632f0c1b3b12f6b928397ae7
---
gnu/services/containers.scm | 549 +++++++++++++++++++++++++++++++++-
gnu/services/docker.scm | 577 +++---------------------------------
gnu/tests/docker.scm | 99 +++----
3 files changed, 625 insertions(+), 600 deletions(-)
diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm
index d5a211765a6..24f31c756b8 100644
--- a/gnu/services/containers.scm
+++ b/gnu/services/containers.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2024 Giacomo Leidi <goodoldpaul <at> autistici.org>
+;;; Copyright © 2024, 2025 Giacomo Leidi <goodoldpaul <at> autistici.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -17,19 +17,31 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu services containers)
+ #:use-module (gnu image)
+ #:use-module (gnu packages admin)
#:use-module (gnu packages bash)
#:use-module (gnu packages containers)
+ #:use-module (gnu packages docker)
#: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)
#:use-module (gnu system accounts)
+ #:use-module (gnu system image)
#:use-module (gnu system shadow)
#:use-module (gnu system pam)
+ #:use-module (guix diagnostics)
#:use-module (guix gexp)
+ #:use-module (guix i18n)
+ #:use-module (guix monads)
#:use-module (guix packages)
+ #:use-module (guix profiles)
+ #:use-module ((guix scripts pack) #:prefix pack:)
+ #:use-module (guix store)
#:use-module (srfi srfi-1)
+ #:use-module (ice-9 match)
#:export (rootless-podman-configuration
rootless-podman-configuration?
rootless-podman-configuration-fields
@@ -48,7 +60,44 @@ (define-module (gnu services containers)
rootless-podman-shepherd-services
rootless-podman-service-etc
- rootless-podman-service-type))
+ rootless-podman-service-type
+
+ oci-image
+ oci-image?
+ oci-image-fields
+ oci-image-repository
+ oci-image-tag
+ oci-image-value
+ oci-image-pack-options
+ oci-image-target
+ oci-image-system
+ oci-image-grafts?
+
+ oci-container-configuration
+ oci-container-configuration?
+ oci-container-configuration-fields
+ oci-container-configuration-user
+ oci-container-configuration-group
+ oci-container-configuration-command
+ oci-container-configuration-entrypoint
+ oci-container-configuration-host-environment
+ oci-container-configuration-environment
+ oci-container-configuration-image
+ oci-container-configuration-provision
+ oci-container-configuration-requirement
+ oci-container-configuration-log-file
+ oci-container-configuration-auto-start?
+ oci-container-configuration-respawn?
+ oci-container-configuration-shepherd-actions
+ oci-container-configuration-network
+ oci-container-configuration-ports
+ oci-container-configuration-volumes
+ oci-container-configuration-container-user
+ oci-container-configuration-workdir
+ oci-container-configuration-extra-arguments
+
+ oci-container-shepherd-service
+ %oci-container-accounts))
(define (gexp-or-string? value)
(or (gexp? value)
@@ -190,7 +239,7 @@ (define (rootless-podman-cgroups-limits-service config)
rootless-podman-shared-root-fs))
(one-shot? #t)
(documentation
- "Allow setting cgroups limits: cpu, cpuset, memory and
+ "Allow setting cgroups limits: cpu, cpuset, io, memory and
pids.")
(start
#~(make-forkexec-constructor
@@ -244,3 +293,497 @@ (define rootless-podman-service-type
(default-value (rootless-podman-configuration))
(description
"This service configures rootless @code{podman} on the Guix System.")))
+
+
+;;;
+;;; OCI container.
+;;;
+
+(define (oci-sanitize-pair pair delimiter)
+ (define (valid? member)
+ (or (string? member)
+ (gexp? member)
+ (file-like? member)))
+ (match pair
+ (((? valid? key) . (? valid? value))
+ #~(string-append #$key #$delimiter #$value))
+ (_
+ (raise
+ (formatted-message
+ (G_ "pair members must contain only strings, gexps or file-like objects
+but ~a was found")
+ pair)))))
+
+(define (oci-sanitize-mixed-list name value delimiter)
+ (map
+ (lambda (el)
+ (cond ((string? el) el)
+ ((pair? el) (oci-sanitize-pair el delimiter))
+ (else
+ (raise
+ (formatted-message
+ (G_ "~a members must be either a string or a pair but ~a was
+found!")
+ name el)))))
+ value))
+
+(define (oci-sanitize-host-environment value)
+ ;; Expected spec format:
+ ;; '(("HOME" . "/home/nobody") "JAVA_HOME=/java")
+ (oci-sanitize-mixed-list "host-environment" value "="))
+
+(define (oci-sanitize-environment value)
+ ;; Expected spec format:
+ ;; '(("HOME" . "/home/nobody") "JAVA_HOME=/java")
+ (oci-sanitize-mixed-list "environment" value "="))
+
+(define (oci-sanitize-ports value)
+ ;; Expected spec format:
+ ;; '(("8088" . "80") "2022:22")
+ (oci-sanitize-mixed-list "ports" value ":"))
+
+(define (oci-sanitize-volumes value)
+ ;; Expected spec format:
+ ;; '(("/mnt/dir" . "/dir") "/run/current-system/profile:/java")
+ (oci-sanitize-mixed-list "volumes" value ":"))
+
+(define (oci-sanitize-shepherd-actions value)
+ (map
+ (lambda (el)
+ (if (shepherd-action? el)
+ el
+ (raise
+ (formatted-message
+ (G_ "shepherd-actions may only be shepherd-action records
+but ~a was found") el))))
+ value))
+
+(define (oci-sanitize-extra-arguments value)
+ (define (valid? member)
+ (or (string? member)
+ (gexp? member)
+ (file-like? member)))
+ (map
+ (lambda (el)
+ (if (valid? el)
+ el
+ (raise
+ (formatted-message
+ (G_ "extra arguments may only be strings, gexps or file-like objects
+but ~a was found") el))))
+ value))
+
+(define (oci-image-reference image)
+ (if (string? image)
+ image
+ (string-append (oci-image-repository image)
+ ":" (oci-image-tag image))))
+
+(define (oci-lowerable-image? image)
+ (or (manifest? image)
+ (operating-system? image)
+ (gexp? image)
+ (file-like? image)))
+
+(define (string-or-oci-image? image)
+ (or (string? image)
+ (oci-image? image)))
+
+(define list-of-symbols?
+ (list-of symbol?))
+
+(define-maybe/no-serialization string)
+
+(define-configuration/no-serialization oci-image
+ (repository
+ (string)
+ "A string like @code{myregistry.local:5000/testing/test-image} that names
+the OCI image.")
+ (tag
+ (string "latest")
+ "A string representing the OCI image tag. Defaults to @code{latest}.")
+ (value
+ (oci-lowerable-image)
+ "A @code{manifest} or @code{operating-system} record that will be lowered
+into an OCI compatible tarball. Otherwise this field's value can be a gexp
+or a file-like object that evaluates to an OCI compatible tarball.")
+ (pack-options
+ (list '())
+ "An optional set of keyword arguments that will be passed to the
+@code{docker-image} procedure from @code{guix scripts pack}. They can be used
+to replicate @command{guix pack} behavior:
+
+@lisp
+(oci-image
+ (repository \"guile\")
+ (tag \"3\")
+ (manifest (specifications->manifest '(\"guile\")))
+ (pack-options
+ '(#:symlinks ((\"/bin/guile\" -> \"bin/guile\"))
+ #:max-layers 2)))
+@end lisp
+
+If the @code{value} field is an @code{operating-system} record, this field's
+value will be ignored.")
+ (system
+ (maybe-string)
+ "Attempt to build for a given system, e.g. \"i686-linux\"")
+ (target
+ (maybe-string)
+ "Attempt to cross-build for a given triple, e.g. \"aarch64-linux-gnu\"")
+ (grafts?
+ (boolean #f)
+ "Whether to allow grafting or not in the pack build."))
+
+(define-configuration/no-serialization oci-container-configuration
+ (user
+ (string "oci-container")
+ "The user under whose authority docker commands will be run.")
+ (group
+ (string "docker")
+ "The group under whose authority docker commands will be run.")
+ (command
+ (list-of-strings '())
+ "Overwrite the default command (@code{CMD}) of the image.")
+ (entrypoint
+ (maybe-string)
+ "Overwrite the default entrypoint (@code{ENTRYPOINT}) of the image.")
+ (host-environment
+ (list '())
+ "Set environment variables in the host environment where @command{docker run}
+is invoked. This is especially useful to pass secrets from the host to the
+container without having them on the @command{docker run}'s command line: by
+setting the @code{MYSQL_PASSWORD} on the host and by passing
+@code{--env MYSQL_PASSWORD} through the @code{extra-arguments} field, it is
+possible to securely set values in the container environment. This field's
+value can be a list of pairs or strings, even mixed:
+
+@lisp
+(list '(\"LANGUAGE\" . \"eo:ca:eu\")
+ \"JAVA_HOME=/opt/java\")
+@end lisp
+
+Pair members can be strings, gexps or file-like objects. Strings are passed
+directly to @code{make-forkexec-constructor}."
+ (sanitizer oci-sanitize-host-environment))
+ (environment
+ (list '())
+ "Set environment variables inside the container. This can be a list of pairs
+or strings, even mixed:
+
+@lisp
+(list '(\"LANGUAGE\" . \"eo:ca:eu\")
+ \"JAVA_HOME=/opt/java\")
+@end lisp
+
+Pair members can be strings, gexps or file-like objects. Strings are passed
+directly to the Docker CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#env,upstream}
+documentation for semantics."
+ (sanitizer oci-sanitize-environment))
+ (image
+ (string-or-oci-image)
+ "The image used to build the container. It can be a string or an
+@code{oci-image} record. Strings are resolved by the Docker
+Engine, and follow the usual format
+@code{myregistry.local:5000/testing/test-image:tag}.")
+ (provision
+ (maybe-string)
+ "Set the name of the provisioned Shepherd service.")
+ (requirement
+ (list-of-symbols '())
+ "Set additional Shepherd services dependencies to the provisioned Shepherd
+service.")
+ (log-file
+ (maybe-string)
+ "When @code{log-file} is set, it names the file to which the service’s
+standard output and standard error are redirected. @code{log-file} is created
+if it does not exist, otherwise it is appended to.")
+ (auto-start?
+ (boolean #t)
+ "Whether this service should be started automatically by the Shepherd. If it
+is @code{#f} the service has to be started manually with @command{herd start}.")
+ (respawn?
+ (boolean #f)
+ "Whether to restart the service when it stops, for instance when the
+underlying process dies.")
+ (shepherd-actions
+ (list '())
+ "This is a list of @code{shepherd-action} records defining actions supported
+by the service."
+ (sanitizer oci-sanitize-shepherd-actions))
+ (network
+ (maybe-string)
+ "Set a Docker network for the spawned container.")
+ (ports
+ (list '())
+ "Set the port or port ranges to expose from the spawned container. This can
+be a list of pairs or strings, even mixed:
+
+@lisp
+(list '(\"8080\" . \"80\")
+ \"10443:443\")
+@end lisp
+
+Pair members can be strings, gexps or file-like objects. Strings are passed
+directly to the Docker CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#publish,upstream}
+documentation for semantics."
+ (sanitizer oci-sanitize-ports))
+ (volumes
+ (list '())
+ "Set volume mappings for the spawned container. This can be a
+list of pairs or strings, even mixed:
+
+@lisp
+(list '(\"/root/data/grafana\" . \"/var/lib/grafana\")
+ \"/gnu/store:/gnu/store\")
+@end lisp
+
+Pair members can be strings, gexps or file-like objects. Strings are passed
+directly to the Docker CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#volume,upstream}
+documentation for semantics."
+ (sanitizer oci-sanitize-volumes))
+ (container-user
+ (maybe-string)
+ "Set the current user inside the spawned container. You can refer to the
+@url{https://docs.docker.com/engine/reference/run/#user,upstream}
+documentation for semantics.")
+ (workdir
+ (maybe-string)
+ "Set the current working for the spawned Shepherd service.
+You can refer to the
+@url{https://docs.docker.com/engine/reference/run/#workdir,upstream}
+documentation for semantics.")
+ (extra-arguments
+ (list '())
+ "A list of strings, gexps or file-like objects that will be directly passed
+to the @command{docker run} invokation."
+ (sanitizer oci-sanitize-extra-arguments)))
+
+(define oci-container-configuration->options
+ (lambda (config)
+ (let ((entrypoint
+ (oci-container-configuration-entrypoint config))
+ (network
+ (oci-container-configuration-network config))
+ (user
+ (oci-container-configuration-container-user config))
+ (workdir
+ (oci-container-configuration-workdir config)))
+ (apply append
+ (filter (compose not unspecified?)
+ `(,(if (maybe-value-set? entrypoint)
+ `("--entrypoint" ,entrypoint)
+ '())
+ ,(append-map
+ (lambda (spec)
+ (list "--env" spec))
+ (oci-container-configuration-environment config))
+ ,(if (maybe-value-set? network)
+ `("--network" ,network)
+ '())
+ ,(if (maybe-value-set? user)
+ `("--user" ,user)
+ '())
+ ,(if (maybe-value-set? workdir)
+ `("--workdir" ,workdir)
+ '())
+ ,(append-map
+ (lambda (spec)
+ (list "-p" spec))
+ (oci-container-configuration-ports config))
+ ,(append-map
+ (lambda (spec)
+ (list "-v" spec))
+ (oci-container-configuration-volumes config))))))))
+
+(define* (get-keyword-value args keyword #:key (default #f))
+ (let ((kv (memq keyword args)))
+ (if (and kv (>= (length kv) 2))
+ (cadr kv)
+ default)))
+
+(define (lower-operating-system os target system)
+ (mlet* %store-monad
+ ((tarball
+ (lower-object
+ (system-image (os->image os #:type docker-image-type))
+ system
+ #:target target)))
+ (return tarball)))
+
+(define (lower-manifest name image target system)
+ (define value (oci-image-value image))
+ (define options (oci-image-pack-options image))
+ (define image-reference
+ (oci-image-reference image))
+ (define image-tag
+ (let* ((extra-options
+ (get-keyword-value options #:extra-options))
+ (image-tag-option
+ (and extra-options
+ (get-keyword-value extra-options #:image-tag))))
+ (if image-tag-option
+ '()
+ `(#:extra-options (#:image-tag ,image-reference)))))
+
+ (mlet* %store-monad
+ ((_ (set-grafting
+ (oci-image-grafts? image)))
+ (guile (set-guile-for-build (default-guile)))
+ (profile
+ (profile-derivation value
+ #:target target
+ #:system system
+ #:hooks '()
+ #:locales? #f))
+ (tarball (apply pack:docker-image
+ `(,name ,profile
+ ,@options
+ ,@image-tag
+ #:localstatedir? #t))))
+ (return tarball)))
+
+(define (lower-oci-image name image)
+ (define value (oci-image-value image))
+ (define image-target (oci-image-target image))
+ (define image-system (oci-image-system image))
+ (define target
+ (if (maybe-value-set? image-target)
+ image-target
+ (%current-target-system)))
+ (define system
+ (if (maybe-value-set? image-system)
+ image-system
+ (%current-system)))
+ (with-store store
+ (run-with-store store
+ (match value
+ ((? manifest? value)
+ (lower-manifest name image target system))
+ ((? operating-system? value)
+ (lower-operating-system value target system))
+ ((or (? gexp? value)
+ (? file-like? value))
+ value)
+ (_
+ (raise
+ (formatted-message
+ (G_ "oci-image value must contain only manifest,
+operating-system, gexp or file-like records but ~a was found")
+ value))))
+ #:target target
+ #:system system)))
+
+(define (%oci-image-loader name image tag)
+ (let ((docker (file-append docker-cli "/bin/docker"))
+ (tarball (lower-oci-image name image)))
+ (with-imported-modules '((guix build utils))
+ (program-file (format #f "~a-image-loader" name)
+ #~(begin
+ (use-modules (guix build utils)
+ (ice-9 popen)
+ (ice-9 rdelim))
+
+ (format #t "Loading image for ~a from ~a...~%" #$name #$tarball)
+ (define line
+ (read-line
+ (open-input-pipe
+ (string-append #$docker " load -i " #$tarball))))
+
+ (unless (or (eof-object? line)
+ (string-null? line))
+ (format #t "~a~%" line)
+ (let ((repository&tag
+ (string-drop line
+ (string-length
+ "Loaded image: "))))
+
+ (invoke #$docker "tag" repository&tag #$tag)
+ (format #t "Tagged ~a with ~a...~%" #$tarball #$tag))))))))
+
+(define (oci-container-shepherd-service config)
+ (define (guess-name name image)
+ (if (maybe-value-set? name)
+ name
+ (string-append "docker-"
+ (basename
+ (if (string? image)
+ (first (string-split image #\:))
+ (oci-image-repository image))))))
+
+ (let* ((docker (file-append docker-cli "/bin/docker"))
+ (actions (oci-container-configuration-shepherd-actions config))
+ (auto-start?
+ (oci-container-configuration-auto-start? config))
+ (user (oci-container-configuration-user config))
+ (group (oci-container-configuration-group config))
+ (host-environment
+ (oci-container-configuration-host-environment config))
+ (command (oci-container-configuration-command config))
+ (log-file (oci-container-configuration-log-file config))
+ (provision (oci-container-configuration-provision config))
+ (requirement (oci-container-configuration-requirement config))
+ (respawn?
+ (oci-container-configuration-respawn? config))
+ (image (oci-container-configuration-image config))
+ (image-reference (oci-image-reference image))
+ (options (oci-container-configuration->options config))
+ (name (guess-name provision image))
+ (extra-arguments
+ (oci-container-configuration-extra-arguments config)))
+
+ (shepherd-service (provision `(,(string->symbol name)))
+ (requirement `(dockerd user-processes ,@requirement))
+ (respawn? respawn?)
+ (auto-start? auto-start?)
+ (documentation
+ (string-append
+ "Docker backed Shepherd service for "
+ (if (oci-image? image) name image) "."))
+ (start
+ #~(lambda ()
+ #$@(if (oci-image? image)
+ #~((invoke #$(%oci-image-loader
+ name image image-reference)))
+ #~())
+ (fork+exec-command
+ ;; docker run [OPTIONS] IMAGE [COMMAND] [ARG...]
+ (list #$docker "run" "--rm" "--name" #$name
+ #$@options #$@extra-arguments
+ #$image-reference #$@command)
+ #:user #$user
+ #:group #$group
+ #$@(if (maybe-value-set? log-file)
+ (list #:log-file log-file)
+ '())
+ #:environment-variables
+ (list #$@host-environment))))
+ (stop
+ #~(lambda _
+ (invoke #$docker "rm" "-f" #$name)))
+ (actions
+ (if (oci-image? image)
+ '()
+ (append
+ (list
+ (shepherd-action
+ (name 'pull)
+ (documentation
+ (format #f "Pull ~a's image (~a)."
+ name image))
+ (procedure
+ #~(lambda _
+ (invoke #$docker "pull" #$image)))))
+ actions))))))
+
+(define %oci-container-accounts
+ (list (user-account
+ (name "oci-container")
+ (comment "OCI services account")
+ (group "docker")
+ (system? #t)
+ (home-directory "/var/empty")
+ (shell (file-append shadow "/sbin/nologin")))))
diff --git a/gnu/services/docker.scm b/gnu/services/docker.scm
index 9ab3e583345..828ceea313a 100644
--- a/gnu/services/docker.scm
+++ b/gnu/services/docker.scm
@@ -5,7 +5,7 @@
;;; Copyright © 2020 Efraim Flashner <efraim <at> flashner.co.il>
;;; Copyright © 2020 Jesse Dowell <jessedowell <at> gmail.com>
;;; Copyright © 2021 Brice Waegeneire <brice <at> waegenei.re>
-;;; Copyright © 2023, 2024 Giacomo Leidi <goodoldpaul <at> autistici.org>
+;;; Copyright © 2023, 2024, 2025 Giacomo Leidi <goodoldpaul <at> autistici.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -23,72 +23,60 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu services docker)
- #:use-module (gnu image)
#:use-module (gnu services)
#:use-module (gnu services configuration)
- #:use-module (gnu services base)
- #:use-module (gnu services dbus)
+ #:use-module (gnu services containers)
#:use-module (gnu services shepherd)
- #:use-module (gnu system)
- #:use-module (gnu system image)
#:use-module (gnu system privilege)
#:use-module (gnu system shadow)
- #:use-module (gnu packages admin) ;shadow
#:use-module (gnu packages docker)
#:use-module (gnu packages linux) ;singularity
- #:use-module (guix records)
- #:use-module (guix diagnostics)
#:use-module (guix gexp)
- #:use-module (guix i18n)
- #:use-module (guix monads)
- #:use-module (guix packages)
- #:use-module (guix profiles)
- #:use-module ((guix scripts pack) #:prefix pack:)
- #:use-module (guix store)
+ #:use-module (guix records)
#:use-module (srfi srfi-1)
#:use-module (ice-9 format)
#:use-module (ice-9 match)
+ #:re-export (oci-image ;for backwards compatibility, until the
+ oci-image? ;oci-container-service-type is fully deprecated
+ oci-image-fields
+ oci-image-repository
+ oci-image-tag
+ oci-image-value
+ oci-image-pack-options
+ oci-image-target
+ oci-image-system
+ oci-image-grafts?
+ oci-container-configuration
+ oci-container-configuration?
+ oci-container-configuration-fields
+ oci-container-configuration-user
+ oci-container-configuration-group
+ oci-container-configuration-command
+ oci-container-configuration-entrypoint
+ oci-container-configuration-host-environment
+ oci-container-configuration-environment
+ oci-container-configuration-image
+ oci-container-configuration-provision
+ oci-container-configuration-requirement
+ oci-container-configuration-log-file
+ oci-container-configuration-auto-start?
+ oci-container-configuration-respawn?
+ oci-container-configuration-shepherd-actions
+ oci-container-configuration-network
+ oci-container-configuration-ports
+ oci-container-configuration-volumes
+ oci-container-configuration-container-user
+ oci-container-configuration-workdir
+ oci-container-configuration-extra-arguments
+ oci-container-shepherd-service
+ %oci-container-accounts)
#:export (containerd-configuration
containerd-service-type
docker-configuration
docker-service-type
singularity-service-type
- oci-image
- oci-image?
- oci-image-fields
- oci-image-repository
- oci-image-tag
- oci-image-value
- oci-image-pack-options
- oci-image-target
- oci-image-system
- oci-image-grafts?
- oci-container-configuration
- oci-container-configuration?
- oci-container-configuration-fields
- oci-container-configuration-user
- oci-container-configuration-group
- oci-container-configuration-command
- oci-container-configuration-entrypoint
- oci-container-configuration-host-environment
- oci-container-configuration-environment
- oci-container-configuration-image
- oci-container-configuration-provision
- oci-container-configuration-requirement
- oci-container-configuration-log-file
- oci-container-configuration-auto-start?
- oci-container-configuration-respawn?
- oci-container-configuration-shepherd-actions
- oci-container-configuration-network
- oci-container-configuration-ports
- oci-container-configuration-volumes
- oci-container-configuration-container-user
- oci-container-configuration-workdir
- oci-container-configuration-extra-arguments
- oci-container-service-type
- oci-container-shepherd-service
- %oci-container-accounts))
+ oci-container-service-type))
(define-maybe file-like)
@@ -309,495 +297,6 @@ (define singularity-service-type
;;; OCI container.
;;;
-(define (oci-sanitize-pair pair delimiter)
- (define (valid? member)
- (or (string? member)
- (gexp? member)
- (file-like? member)))
- (match pair
- (((? valid? key) . (? valid? value))
- #~(string-append #$key #$delimiter #$value))
- (_
- (raise
- (formatted-message
- (G_ "pair members must contain only strings, gexps or file-like objects
-but ~a was found")
- pair)))))
-
-(define (oci-sanitize-mixed-list name value delimiter)
- (map
- (lambda (el)
- (cond ((string? el) el)
- ((pair? el) (oci-sanitize-pair el delimiter))
- (else
- (raise
- (formatted-message
- (G_ "~a members must be either a string or a pair but ~a was
-found!")
- name el)))))
- value))
-
-(define (oci-sanitize-host-environment value)
- ;; Expected spec format:
- ;; '(("HOME" . "/home/nobody") "JAVA_HOME=/java")
- (oci-sanitize-mixed-list "host-environment" value "="))
-
-(define (oci-sanitize-environment value)
- ;; Expected spec format:
- ;; '(("HOME" . "/home/nobody") "JAVA_HOME=/java")
- (oci-sanitize-mixed-list "environment" value "="))
-
-(define (oci-sanitize-ports value)
- ;; Expected spec format:
- ;; '(("8088" . "80") "2022:22")
- (oci-sanitize-mixed-list "ports" value ":"))
-
-(define (oci-sanitize-volumes value)
- ;; Expected spec format:
- ;; '(("/mnt/dir" . "/dir") "/run/current-system/profile:/java")
- (oci-sanitize-mixed-list "volumes" value ":"))
-
-(define (oci-sanitize-shepherd-actions value)
- (map
- (lambda (el)
- (if (shepherd-action? el)
- el
- (raise
- (formatted-message
- (G_ "shepherd-actions may only be shepherd-action records
-but ~a was found") el))))
- value))
-
-(define (oci-sanitize-extra-arguments value)
- (define (valid? member)
- (or (string? member)
- (gexp? member)
- (file-like? member)))
- (map
- (lambda (el)
- (if (valid? el)
- el
- (raise
- (formatted-message
- (G_ "extra arguments may only be strings, gexps or file-like objects
-but ~a was found") el))))
- value))
-
-(define (oci-image-reference image)
- (if (string? image)
- image
- (string-append (oci-image-repository image)
- ":" (oci-image-tag image))))
-
-(define (oci-lowerable-image? image)
- (or (manifest? image)
- (operating-system? image)
- (gexp? image)
- (file-like? image)))
-
-(define (string-or-oci-image? image)
- (or (string? image)
- (oci-image? image)))
-
-(define list-of-symbols?
- (list-of symbol?))
-
-(define-maybe/no-serialization string)
-
-(define-configuration/no-serialization oci-image
- (repository
- (string)
- "A string like @code{myregistry.local:5000/testing/test-image} that names
-the OCI image.")
- (tag
- (string "latest")
- "A string representing the OCI image tag. Defaults to @code{latest}.")
- (value
- (oci-lowerable-image)
- "A @code{manifest} or @code{operating-system} record that will be lowered
-into an OCI compatible tarball. Otherwise this field's value can be a gexp
-or a file-like object that evaluates to an OCI compatible tarball.")
- (pack-options
- (list '())
- "An optional set of keyword arguments that will be passed to the
-@code{docker-image} procedure from @code{guix scripts pack}. They can be used
-to replicate @command{guix pack} behavior:
-
-@lisp
-(oci-image
- (repository \"guile\")
- (tag \"3\")
- (manifest (specifications->manifest '(\"guile\")))
- (pack-options
- '(#:symlinks ((\"/bin/guile\" -> \"bin/guile\"))
- #:max-layers 2)))
-@end lisp
-
-If the @code{value} field is an @code{operating-system} record, this field's
-value will be ignored.")
- (system
- (maybe-string)
- "Attempt to build for a given system, e.g. \"i686-linux\"")
- (target
- (maybe-string)
- "Attempt to cross-build for a given triple, e.g. \"aarch64-linux-gnu\"")
- (grafts?
- (boolean #f)
- "Whether to allow grafting or not in the pack build."))
-
-(define-configuration/no-serialization oci-container-configuration
- (user
- (string "oci-container")
- "The user under whose authority docker commands will be run.")
- (group
- (string "docker")
- "The group under whose authority docker commands will be run.")
- (command
- (list-of-strings '())
- "Overwrite the default command (@code{CMD}) of the image.")
- (entrypoint
- (maybe-string)
- "Overwrite the default entrypoint (@code{ENTRYPOINT}) of the image.")
- (host-environment
- (list '())
- "Set environment variables in the host environment where @command{docker run}
-is invoked. This is especially useful to pass secrets from the host to the
-container without having them on the @command{docker run}'s command line: by
-setting the @code{MYSQL_PASSWORD} on the host and by passing
-@code{--env MYSQL_PASSWORD} through the @code{extra-arguments} field, it is
-possible to securely set values in the container environment. This field's
-value can be a list of pairs or strings, even mixed:
-
-@lisp
-(list '(\"LANGUAGE\" . \"eo:ca:eu\")
- \"JAVA_HOME=/opt/java\")
-@end lisp
-
-Pair members can be strings, gexps or file-like objects. Strings are passed
-directly to @code{make-forkexec-constructor}."
- (sanitizer oci-sanitize-host-environment))
- (environment
- (list '())
- "Set environment variables inside the container. This can be a list of pairs
-or strings, even mixed:
-
-@lisp
-(list '(\"LANGUAGE\" . \"eo:ca:eu\")
- \"JAVA_HOME=/opt/java\")
-@end lisp
-
-Pair members can be strings, gexps or file-like objects. Strings are passed
-directly to the Docker CLI. You can refer to the
-@url{https://docs.docker.com/engine/reference/commandline/run/#env,upstream}
-documentation for semantics."
- (sanitizer oci-sanitize-environment))
- (image
- (string-or-oci-image)
- "The image used to build the container. It can be a string or an
-@code{oci-image} record. Strings are resolved by the Docker
-Engine, and follow the usual format
-@code{myregistry.local:5000/testing/test-image:tag}.")
- (provision
- (maybe-string)
- "Set the name of the provisioned Shepherd service.")
- (requirement
- (list-of-symbols '())
- "Set additional Shepherd services dependencies to the provisioned Shepherd
-service.")
- (log-file
- (maybe-string)
- "When @code{log-file} is set, it names the file to which the service’s
-standard output and standard error are redirected. @code{log-file} is created
-if it does not exist, otherwise it is appended to.")
- (auto-start?
- (boolean #t)
- "Whether this service should be started automatically by the Shepherd. If it
-is @code{#f} the service has to be started manually with @command{herd start}.")
- (respawn?
- (boolean #f)
- "Whether to restart the service when it stops, for instance when the
-underlying process dies.")
- (shepherd-actions
- (list '())
- "This is a list of @code{shepherd-action} records defining actions supported
-by the service."
- (sanitizer oci-sanitize-shepherd-actions))
- (network
- (maybe-string)
- "Set a Docker network for the spawned container.")
- (ports
- (list '())
- "Set the port or port ranges to expose from the spawned container. This can
-be a list of pairs or strings, even mixed:
-
-@lisp
-(list '(\"8080\" . \"80\")
- \"10443:443\")
-@end lisp
-
-Pair members can be strings, gexps or file-like objects. Strings are passed
-directly to the Docker CLI. You can refer to the
-@url{https://docs.docker.com/engine/reference/commandline/run/#publish,upstream}
-documentation for semantics."
- (sanitizer oci-sanitize-ports))
- (volumes
- (list '())
- "Set volume mappings for the spawned container. This can be a
-list of pairs or strings, even mixed:
-
-@lisp
-(list '(\"/root/data/grafana\" . \"/var/lib/grafana\")
- \"/gnu/store:/gnu/store\")
-@end lisp
-
-Pair members can be strings, gexps or file-like objects. Strings are passed
-directly to the Docker CLI. You can refer to the
-@url{https://docs.docker.com/engine/reference/commandline/run/#volume,upstream}
-documentation for semantics."
- (sanitizer oci-sanitize-volumes))
- (container-user
- (maybe-string)
- "Set the current user inside the spawned container. You can refer to the
-@url{https://docs.docker.com/engine/reference/run/#user,upstream}
-documentation for semantics.")
- (workdir
- (maybe-string)
- "Set the current working for the spawned Shepherd service.
-You can refer to the
-@url{https://docs.docker.com/engine/reference/run/#workdir,upstream}
-documentation for semantics.")
- (extra-arguments
- (list '())
- "A list of strings, gexps or file-like objects that will be directly passed
-to the @command{docker run} invocation."
- (sanitizer oci-sanitize-extra-arguments)))
-
-(define oci-container-configuration->options
- (lambda (config)
- (let ((entrypoint
- (oci-container-configuration-entrypoint config))
- (network
- (oci-container-configuration-network config))
- (user
- (oci-container-configuration-container-user config))
- (workdir
- (oci-container-configuration-workdir config)))
- (apply append
- (filter (compose not unspecified?)
- `(,(if (maybe-value-set? entrypoint)
- `("--entrypoint" ,entrypoint)
- '())
- ,(append-map
- (lambda (spec)
- (list "--env" spec))
- (oci-container-configuration-environment config))
- ,(if (maybe-value-set? network)
- `("--network" ,network)
- '())
- ,(if (maybe-value-set? user)
- `("--user" ,user)
- '())
- ,(if (maybe-value-set? workdir)
- `("--workdir" ,workdir)
- '())
- ,(append-map
- (lambda (spec)
- (list "-p" spec))
- (oci-container-configuration-ports config))
- ,(append-map
- (lambda (spec)
- (list "-v" spec))
- (oci-container-configuration-volumes config))))))))
-
-(define* (get-keyword-value args keyword #:key (default #f))
- (let ((kv (memq keyword args)))
- (if (and kv (>= (length kv) 2))
- (cadr kv)
- default)))
-
-(define (lower-operating-system os target system)
- (mlet* %store-monad
- ((tarball
- (lower-object
- (system-image (os->image os #:type docker-image-type))
- system
- #:target target)))
- (return tarball)))
-
-(define (lower-manifest name image target system)
- (define value (oci-image-value image))
- (define options (oci-image-pack-options image))
- (define image-reference
- (oci-image-reference image))
- (define image-tag
- (let* ((extra-options
- (get-keyword-value options #:extra-options))
- (image-tag-option
- (and extra-options
- (get-keyword-value extra-options #:image-tag))))
- (if image-tag-option
- '()
- `(#:extra-options (#:image-tag ,image-reference)))))
-
- (mlet* %store-monad
- ((_ (set-grafting
- (oci-image-grafts? image)))
- (guile (set-guile-for-build (default-guile)))
- (profile
- (profile-derivation value
- #:target target
- #:system system
- #:hooks '()
- #:locales? #f))
- (tarball (apply pack:docker-image
- `(,name ,profile
- ,@options
- ,@image-tag
- #:localstatedir? #t))))
- (return tarball)))
-
-(define (lower-oci-image name image)
- (define value (oci-image-value image))
- (define image-target (oci-image-target image))
- (define image-system (oci-image-system image))
- (define target
- (if (maybe-value-set? image-target)
- image-target
- (%current-target-system)))
- (define system
- (if (maybe-value-set? image-system)
- image-system
- (%current-system)))
- (with-store store
- (run-with-store store
- (match value
- ((? manifest? value)
- (lower-manifest name image target system))
- ((? operating-system? value)
- (lower-operating-system value target system))
- ((or (? gexp? value)
- (? file-like? value))
- value)
- (_
- (raise
- (formatted-message
- (G_ "oci-image value must contain only manifest,
-operating-system, gexp or file-like records but ~a was found")
- value))))
- #:target target
- #:system system)))
-
-(define (%oci-image-loader name image tag)
- (let ((docker (file-append docker-cli "/bin/docker"))
- (tarball (lower-oci-image name image)))
- (with-imported-modules '((guix build utils))
- (program-file (format #f "~a-image-loader" name)
- #~(begin
- (use-modules (guix build utils)
- (ice-9 popen)
- (ice-9 rdelim))
-
- (format #t "Loading image for ~a from ~a...~%" #$name #$tarball)
- (define line
- (read-line
- (open-input-pipe
- (string-append #$docker " load -i " #$tarball))))
-
- (unless (or (eof-object? line)
- (string-null? line))
- (format #t "~a~%" line)
- (let ((repository&tag
- (string-drop line
- (string-length
- "Loaded image: "))))
-
- (invoke #$docker "tag" repository&tag #$tag)
- (format #t "Tagged ~a with ~a...~%" #$tarball #$tag))))))))
-
-(define (oci-container-shepherd-service config)
- (define (guess-name name image)
- (if (maybe-value-set? name)
- name
- (string-append "docker-"
- (basename
- (if (string? image)
- (first (string-split image #\:))
- (oci-image-repository image))))))
-
- (let* ((docker (file-append docker-cli "/bin/docker"))
- (actions (oci-container-configuration-shepherd-actions config))
- (auto-start?
- (oci-container-configuration-auto-start? config))
- (user (oci-container-configuration-user config))
- (group (oci-container-configuration-group config))
- (host-environment
- (oci-container-configuration-host-environment config))
- (command (oci-container-configuration-command config))
- (log-file (oci-container-configuration-log-file config))
- (provision (oci-container-configuration-provision config))
- (requirement (oci-container-configuration-requirement config))
- (respawn?
- (oci-container-configuration-respawn? config))
- (image (oci-container-configuration-image config))
- (image-reference (oci-image-reference image))
- (options (oci-container-configuration->options config))
- (name (guess-name provision image))
- (extra-arguments
- (oci-container-configuration-extra-arguments config)))
-
- (shepherd-service (provision `(,(string->symbol name)))
- (requirement `(dockerd user-processes ,@requirement))
- (respawn? respawn?)
- (auto-start? auto-start?)
- (documentation
- (string-append
- "Docker backed Shepherd service for "
- (if (oci-image? image) name image) "."))
- (start
- #~(lambda ()
- #$@(if (oci-image? image)
- #~((invoke #$(%oci-image-loader
- name image image-reference)))
- #~())
- (fork+exec-command
- ;; docker run [OPTIONS] IMAGE [COMMAND] [ARG...]
- (list #$docker "run" "--rm" "--name" #$name
- #$@options #$@extra-arguments
- #$image-reference #$@command)
- #:user #$user
- #:group #$group
- #$@(if (maybe-value-set? log-file)
- (list #:log-file log-file)
- '())
- #:environment-variables
- (list #$@host-environment))))
- (stop
- #~(lambda _
- (invoke #$docker "rm" "-f" #$name)))
- (actions
- (if (oci-image? image)
- '()
- (append
- (list
- (shepherd-action
- (name 'pull)
- (documentation
- (format #f "Pull ~a's image (~a)."
- name image))
- (procedure
- #~(lambda _
- (invoke #$docker "pull" #$image)))))
- actions))))))
-
-(define %oci-container-accounts
- (list (user-account
- (name "oci-container")
- (comment "OCI services account")
- (group "docker")
- (system? #t)
- (home-directory "/var/empty")
- (shell (file-append shadow "/sbin/nologin")))))
-
(define (configs->shepherd-services configs)
(map oci-container-shepherd-service configs))
diff --git a/gnu/tests/docker.scm b/gnu/tests/docker.scm
index 90c8d0f8508..5dcf05a17e3 100644
--- a/gnu/tests/docker.scm
+++ b/gnu/tests/docker.scm
@@ -1,7 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019 Danny Milosavljevic <dannym <at> scratchpost.org>
;;; Copyright © 2019-2023 Ludovic Courtès <ludo <at> gnu.org>
-;;; Copyright © 2024 Giacomo Leidi <goodoldpaul <at> autistici.org>
+;;; Copyright © 2024, 2025 Giacomo Leidi <goodoldpaul <at> autistici.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -414,71 +414,54 @@ (define (run-oci-container-test)
(test-runner-current (system-test-runner #$output))
(test-begin "oci-container")
- (test-assert "containerd service running"
- (marionette-eval
- '(begin
- (use-modules (gnu services herd))
- (match (start-service 'containerd)
- (#f #f)
- (('service response-parts ...)
- (match (assq-ref response-parts 'running)
- ((pid) pid)))))
- marionette))
-
- (test-assert "containerd PID file present"
- (wait-for-file "/run/containerd/containerd.pid" marionette))
-
- (test-assert "dockerd running"
- (marionette-eval
- '(begin
- (use-modules (gnu services herd))
- (match (start-service 'dockerd)
- (#f #f)
- (('service response-parts ...)
- (match (assq-ref response-parts 'running)
- ((pid) pid)))))
- marionette))
-
- (sleep 10) ; let service start
+ (wait-for-file "/run/containerd/containerd.pid" marionette)
(test-assert "docker-guile running"
(marionette-eval
'(begin
(use-modules (gnu services herd))
- (match (start-service 'docker-guile)
- (#f #f)
- (('service response-parts ...)
- (match (assq-ref response-parts 'running)
- ((pid) pid)))))
+ (wait-for-service 'docker-guile #:timeout 120)
+ #t)
marionette))
- (test-equal "passing host environment variables and volumes"
- '("value" "hello")
- (marionette-eval
- `(begin
- (use-modules (ice-9 popen)
- (ice-9 rdelim))
-
- (define slurp
- (lambda args
- (let* ((port (apply open-pipe* OPEN_READ args))
- (output (let ((line (read-line port)))
- (if (eof-object? line)
- ""
- line)))
- (status (close-pipe port)))
- output)))
- (let* ((response1 (slurp
- ,(string-append #$docker-cli "/bin/docker")
- "exec" "docker-guile"
- "/bin/guile" "-c" "(display (getenv \"VARIABLE\"))"))
- (response2 (slurp
- ,(string-append #$docker-cli "/bin/docker")
- "exec" "docker-guile"
- "/bin/guile" "-c" "(begin (use-modules (ice-9 popen) (ice-9 rdelim))
+ (test-assert "passing host environment variables and volumes"
+ (begin
+ (define (run-test)
+ (marionette-eval
+ `(begin
+ (use-modules (ice-9 popen)
+ (ice-9 rdelim))
+
+ (define slurp
+ (lambda args
+ (let* ((port (apply open-pipe* OPEN_READ args))
+ (output (let ((line (read-line port)))
+ (if (eof-object? line)
+ ""
+ line)))
+ (status (close-pipe port)))
+ output)))
+ (let* ((response1 (slurp
+ ,(string-append #$docker-cli "/bin/docker")
+ "exec" "docker-guile"
+ "/bin/guile" "-c" "(display (getenv \"VARIABLE\"))"))
+ (response2 (slurp
+ ,(string-append #$docker-cli "/bin/docker")
+ "exec" "docker-guile"
+ "/bin/guile" "-c" "(begin (use-modules (ice-9 popen) (ice-9 rdelim))
(display (call-with-input-file \"/shared.txt\" read-line)))")))
- (list response1 response2)))
- marionette))
+ (list response1 response2)))
+ marionette))
+ ;; Allow services to come up on slower machines
+ (let loop ((attempts 0))
+ (if (= attempts 60)
+ (error "Service didn't come up after more than 60 seconds")
+ (if (equal? '("value" "hello")
+ (run-test))
+ #t
+ (begin
+ (sleep 1)
+ (loop (+ 1 attempts))))))))
(test-end))))
--
2.48.1
guix-patches <at> gnu.org:bug#76081; Package guix-patches.
(Tue, 18 Mar 2025 17:51:02 GMT) Full text and rfc822 format available.Message #137 received at 76081 <at> debbugs.gnu.org (full text, mbox):
From: paul <goodoldpaul <at> autistici.org> To: 76081 <at> debbugs.gnu.org Subject: Re: OCI provisioning service Date: Tue, 18 Mar 2025 18:50:14 +0100
Hi, On 3/9/25 01:27, paul wrote: > Hi, > > On 3/4/25 13:39, paul wrote: >> Hi, >> >> On 2/27/25 00:01, paul wrote: >>> Hi guix, >>> >>> On 2/18/25 02:20, paul wrote: >>>> Hi, >>>> >>>> On 2/12/25 02:09, paul wrote: >>>>> Hi guix, >>>>> >>>>> On 2/9/25 21:38, paul wrote: >>>>>> I'm sending a v3 fixing a bug in the merge algorithm for volumes >>>>>> and networks. >>>>>> >>>>>> On 2/9/25 20:14, paul wrote: >>>>>>> Hi, >>>>>>> >>>>>>> I'm about to send a v2. v2 compared to the first revision features: >>>>>>> >>>>>>> >>>>>>> - it actually compiles all the times :) (rev 1 referenced >>>>>>> oci-image too early for it to be working and generated a compile >>>>>>> time error, if you recompiled it sometimes went away so I >>>>>>> thought it was a problem of my setup. CI caught this) >>>>>>> - it allows more values to be overridden by eventual users of >>>>>>> the Scheme API >>>>>>> - it allows passing extra arguments directly after each podman >>>>>>> or docker invokation, allowing for example for overriding podman >>>>>>> --root and similar options. >>>>>>> >>>>>>> All of these tests should pass: >>>>>>> >>>>>>> guix shell -D guix -CPW -- make check-system >>>>>>> TESTS="oci-container oci-service-rootless-podman docker >>>>>>> docker-system rootless-podman oci-service-docker" >>>>>>> >>>>> I'm sending a v4 changing slightly the image loader, the same >>>>> tests as before are supposed to pass. Now the Home service [0] is >>>>> working for me with rootless podman. I'll try it on different >>>>> distros if I manage to. >>>> >>>> I'm sending a v5 implementing a Home service. The changes compared >>>> to v4 are pretty trivial as the plumbing was already there, the >>>> only downside is that I'm not able to use for-home? in >>>> define-configuration, so I had to reimplement oci-configuration >>>> with (guix records) and had to reimplement some validation (gnu >>>> services configuration) would figure out magically. >>> >>> I'm sending a v6. Compared to v5 it resolves the conflicts with >>> master and it should fix the stop action for rootless podman backed >>> services. >> >> I'm sending a v7 fixing the restart action for podman backed services. > > I'm sending a v8 fixing some further bugs wrt to the start and stop of > podman backed services. In the hope of making the review easier, I'm sending a v9 that is completely the same of v8 in terms of changes but with smaller commits. Hopefully this makes it easier to review changes, please let me know if I can do anything to ease the workload for reviewers of this patch set. Thank you for your work, cheers giacomo
guix-patches <at> gnu.org:bug#76081; Package guix-patches.
(Tue, 18 Mar 2025 17:53:03 GMT) Full text and rfc822 format available.Message #140 received at 76081 <at> debbugs.gnu.org (full text, mbox):
From: Giacomo Leidi <goodoldpaul <at> autistici.org> To: 76081 <at> debbugs.gnu.org Cc: Giacomo Leidi <goodoldpaul <at> autistici.org> Subject: [PATCH v9 3/7] tests: oci-container: Set explicit timeouts. Date: Tue, 18 Mar 2025 18:51:08 +0100
* gnu/tests/docker.scm: Simplify %test-oci-container test case and add
explicit timeouts to tests outcomes.
---
gnu/tests/docker.scm | 99 ++++++++++++++++++--------------------------
1 file changed, 41 insertions(+), 58 deletions(-)
diff --git a/gnu/tests/docker.scm b/gnu/tests/docker.scm
index 90c8d0f8508..5dcf05a17e3 100644
--- a/gnu/tests/docker.scm
+++ b/gnu/tests/docker.scm
@@ -1,7 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019 Danny Milosavljevic <dannym <at> scratchpost.org>
;;; Copyright © 2019-2023 Ludovic Courtès <ludo <at> gnu.org>
-;;; Copyright © 2024 Giacomo Leidi <goodoldpaul <at> autistici.org>
+;;; Copyright © 2024, 2025 Giacomo Leidi <goodoldpaul <at> autistici.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -414,71 +414,54 @@ (define (run-oci-container-test)
(test-runner-current (system-test-runner #$output))
(test-begin "oci-container")
- (test-assert "containerd service running"
- (marionette-eval
- '(begin
- (use-modules (gnu services herd))
- (match (start-service 'containerd)
- (#f #f)
- (('service response-parts ...)
- (match (assq-ref response-parts 'running)
- ((pid) pid)))))
- marionette))
-
- (test-assert "containerd PID file present"
- (wait-for-file "/run/containerd/containerd.pid" marionette))
-
- (test-assert "dockerd running"
- (marionette-eval
- '(begin
- (use-modules (gnu services herd))
- (match (start-service 'dockerd)
- (#f #f)
- (('service response-parts ...)
- (match (assq-ref response-parts 'running)
- ((pid) pid)))))
- marionette))
-
- (sleep 10) ; let service start
+ (wait-for-file "/run/containerd/containerd.pid" marionette)
(test-assert "docker-guile running"
(marionette-eval
'(begin
(use-modules (gnu services herd))
- (match (start-service 'docker-guile)
- (#f #f)
- (('service response-parts ...)
- (match (assq-ref response-parts 'running)
- ((pid) pid)))))
+ (wait-for-service 'docker-guile #:timeout 120)
+ #t)
marionette))
- (test-equal "passing host environment variables and volumes"
- '("value" "hello")
- (marionette-eval
- `(begin
- (use-modules (ice-9 popen)
- (ice-9 rdelim))
-
- (define slurp
- (lambda args
- (let* ((port (apply open-pipe* OPEN_READ args))
- (output (let ((line (read-line port)))
- (if (eof-object? line)
- ""
- line)))
- (status (close-pipe port)))
- output)))
- (let* ((response1 (slurp
- ,(string-append #$docker-cli "/bin/docker")
- "exec" "docker-guile"
- "/bin/guile" "-c" "(display (getenv \"VARIABLE\"))"))
- (response2 (slurp
- ,(string-append #$docker-cli "/bin/docker")
- "exec" "docker-guile"
- "/bin/guile" "-c" "(begin (use-modules (ice-9 popen) (ice-9 rdelim))
+ (test-assert "passing host environment variables and volumes"
+ (begin
+ (define (run-test)
+ (marionette-eval
+ `(begin
+ (use-modules (ice-9 popen)
+ (ice-9 rdelim))
+
+ (define slurp
+ (lambda args
+ (let* ((port (apply open-pipe* OPEN_READ args))
+ (output (let ((line (read-line port)))
+ (if (eof-object? line)
+ ""
+ line)))
+ (status (close-pipe port)))
+ output)))
+ (let* ((response1 (slurp
+ ,(string-append #$docker-cli "/bin/docker")
+ "exec" "docker-guile"
+ "/bin/guile" "-c" "(display (getenv \"VARIABLE\"))"))
+ (response2 (slurp
+ ,(string-append #$docker-cli "/bin/docker")
+ "exec" "docker-guile"
+ "/bin/guile" "-c" "(begin (use-modules (ice-9 popen) (ice-9 rdelim))
(display (call-with-input-file \"/shared.txt\" read-line)))")))
- (list response1 response2)))
- marionette))
+ (list response1 response2)))
+ marionette))
+ ;; Allow services to come up on slower machines
+ (let loop ((attempts 0))
+ (if (= attempts 60)
+ (error "Service didn't come up after more than 60 seconds")
+ (if (equal? '("value" "hello")
+ (run-test))
+ #t
+ (begin
+ (sleep 1)
+ (loop (+ 1 attempts))))))))
(test-end))))
--
2.48.1
ludo <at> gnu.org, maxim.cournoyer <at> gmail.com, guix-patches <at> gnu.org:bug#76081; Package guix-patches.
(Tue, 18 Mar 2025 17:53:06 GMT) Full text and rfc822 format available.Message #143 received at 76081 <at> debbugs.gnu.org (full text, mbox):
From: Giacomo Leidi <goodoldpaul <at> autistici.org> To: 76081 <at> debbugs.gnu.org Cc: Giacomo Leidi <goodoldpaul <at> autistici.org> Subject: [PATCH v9 4/7] services: Add oci-service-type. Date: Tue, 18 Mar 2025 18:51:09 +0100
This patch implements a generalization of the
oci-container-service-type, which consequently is made deprecated. The
oci-service-type, in addition to all the features from the
oci-container-service-type, can now provision OCI networks and volumes.
It only handles OCI objects creation, the user is supposed to handle
state once the objects are provsioned.
It currently supports two different OCI runtimes: Docker and rootless
Podman. Both runtimes are tested to make sure provisioned containers
can connect to each other through provisioned networks and can
read/write data with provisioned volumes.
At last the Scheme API is thought to facilitate the implementation of a
Guix Home service in the future.
* gnu/services/containers.scm (%oci-supported-runtimes): New variable;
(oci-runtime-cli): new variable;
(oci-runtime-name): new variable;
(oci-network-configuration): new variable;
(oci-volume-configuration): new variable;
(oci-configuration): new variable;
(oci-extension): new variable;
(oci-networks-shepherd-name): new variable;
(oci-service-type): new variable;
(oci-state->shepherd-services): new variable.
* doc/guix.texi: Document it.
* gnu/tests/containers.scm: Test it.
* gnu/services/docker.scm: Deprecate the oci-container-service-type.
Change-Id: I656b3db85832e42d53072fcbfb91d1226f39ef38
---
doc/guix.texi | 306 +++++++--
gnu/services/containers.scm | 1300 ++++++++++++++++++++++++++++++-----
gnu/services/docker.scm | 37 +-
gnu/tests/containers.scm | 999 ++++++++++++++++++++++++++-
4 files changed, 2390 insertions(+), 252 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index 04885593328..521ea28dd5a 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -42914,59 +42914,162 @@ Miscellaneous Services
@cindex OCI-backed, Shepherd services
@subsubheading OCI backed services
-Should you wish to manage your Docker containers with the same consistent
-interface you use for your other Shepherd services,
-@var{oci-container-service-type} is the tool to use: given an
-@acronym{Open Container Initiative, OCI} container image, it will run it in a
+Should you wish to manage your @acronym{Open Container Initiative, OCI} containers
+with the same consistent interface you use for your other Shepherd services,
+@var{oci-service-type} is the tool to use: given an
+OCI container image, it will run it in a
Shepherd service. One example where this is useful: it lets you run services
-that are available as Docker/OCI images but not yet packaged for Guix.
+that are available as OCI images but not yet packaged for Guix.
-@defvar oci-container-service-type
+@defvar oci-service-type
-This is a thin wrapper around Docker's CLI that executes OCI images backed
+This is a thin wrapper around Docker's or Podman's CLI that executes OCI images backed
processes as Shepherd Services.
@lisp
-(service oci-container-service-type
- (list
- (oci-container-configuration
- (network "host")
- (image
- (oci-image
- (repository "guile")
- (tag "3")
- (value (specifications->manifest '("guile")))
- (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile"))
- #:max-layers 2))))
- (entrypoint "/bin/guile")
- (command
- '("-c" "(display \"hello!\n\")")))
- (oci-container-configuration
- (image "prom/prometheus")
- (ports
- '(("9000" . "9000")
- ("9090" . "9090"))))
- (oci-container-configuration
- (image "grafana/grafana:10.0.1")
- (network "host")
- (volumes
- '("/var/lib/grafana:/var/lib/grafana")))))
+(simple-service 'oci-provisioning
+ oci-service-type
+ (oci-extension
+ (networks
+ (list
+ (oci-network-configuration (name "monitoring"))))
+ (containers
+ (list
+ (oci-container-configuration
+ (network "monitoring")
+ (image
+ (oci-image
+ (repository "guile")
+ (tag "3")
+ (value (specifications->manifest '("guile")))
+ (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile"))
+ #:max-layers 2))))
+ (entrypoint "/bin/guile")
+ (command
+ '("-c" "(display \"hello!\n\")")))
+ (oci-container-configuration
+ (image "prom/prometheus")
+ (network "host")
+ (ports
+ '(("9000" . "9000")
+ ("9090" . "9090"))))
+ (oci-container-configuration
+ (image "grafana/grafana:10.0.1")
+ (network "host")
+ (volumes
+ '("/var/lib/grafana:/var/lib/grafana")))))))
@end lisp
In this example three different Shepherd services are going to be added to the
system. Each @code{oci-container-configuration} record translates to a
-@code{docker run} invocation and its fields directly map to options. You can
-refer to the
-@url{https://docs.docker.com/engine/reference/commandline/run,upstream}
-documentation for the semantics of each value. If the images are not found,
-they will be
-@url{https://docs.docker.com/engine/reference/commandline/pull/,pulled}. The
+@command{docker run} or @command{podman run} invocation and its fields directly
+map to options. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html,Podman}
+upstream documentation for semantics of each value. If the images are not found,
+they will be pulled. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/pull/,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-pull.1.html,Podman}
+upstream documentation for semantics. The
services with @code{(network "host")} are going to be attached to the
host network and are supposed to behave like native processes with regard to
networking.
@end defvar
+@c %start of fragment
+
+@deftp {Data Type} oci-configuration
+Available @code{oci-configuration} fields are:
+
+@table @asis
+@item @code{runtime} (default: @code{'docker}) (type: symbol)
+The OCI runtime to use to run commands. It can be either @code{'docker} or
+@code{'podman}.
+
+@item @code{runtime-cli} (type: maybe-package-or-string)
+The OCI runtime command line to be installed in the system profile and used
+to provision OCI resources, it can be either a package or a string representing
+an absolute path to the runtime binary entrypoint. When unset it will default
+to @code{docker-cli} package for the @code{'docker} runtime or to @code{podman}
+package for the @code{'podman} runtime.
+
+@item @code{runtime-extra-arguments} (default: @code{'()}) (type: list)
+A list of strings, gexps or file-like objects that will be placed
+after each @command{docker} or @command{podman} invokation.
+
+@item @code{user} (type: maybe-string)
+The user name under whose authority OCI commands will be run. This field will
+override the @code{user} field of @code{oci-configuration}.
+
+@item @code{group} (type: maybe-string)
+The group name under whose authority OCI commands will be run. When
+using the @code{'podman} OCI runtime, this field will be ignored and the
+default group of the user configured in the @code{user} field will be used.
+This field will override the @code{group} field of @code{oci-configuration}.
+
+@item @code{subuids-range} (type: maybe-subid-range)
+An optional @code{subid-range} record allocating subuids for the user from
+the @code{user} field. When unset, with the rootless Podman OCI runtime, it
+defaults to @code{(subid-range (name "oci-container"))}.
+
+@item @code{subgids-range} (type: maybe-subid-range)
+An optional @code{subid-range} record allocating subgids for the user from
+the @code{user} field. When unset, with the rootless Podman OCI runtime, it
+defaults to @code{(subid-range (name "oci-container"))}.
+
+@item @code{containers} (default: @code{'()}) (type: list-of-oci-containers)
+The list of @code{oci-container-configuration} records representing the
+containers to provision. Most users are supposed not to use this field and use
+the @code{oci-extension} record instead.
+
+@item @code{networks} (default: @code{'()}) (type: list-of-oci-networks)
+The list of @code{oci-network-configuration} records representing the
+containers to provision. Most users are supposed not to use this field and use
+the @code{oci-extension} record instead.
+
+@item @code{volumes} (default: @code{'()}) (type: list-of-oci-volumes)
+The list of @code{oci-volumes-configuration} records representing the
+containers to provision. Most users are supposed not to use this field and use
+the @code{oci-extension} record instead.
+
+@item @code{verbose?} (default: @code{#f}) (type: boolean)
+When true, additional output will be printed, allowing to better follow the
+flow of execution.
+
+@end table
+
+@end deftp
+
+
+@c %end of fragment
+
+@c %start of fragment
+
+@deftp {Data Type} oci-extension
+Available @code{oci-extension} fields are:
+
+@table @asis
+@item @code{containers} (default: @code{'()}) (type: list-of-oci-containers)
+The list of @code{oci-container-configuration} records representing the
+containers to provision.
+
+@item @code{networks} (default: @code{'()}) (type: list-of-oci-networks)
+The list of @code{oci-network-configuration} records representing the
+containers to provision.
+
+@item @code{volumes} (default: @code{'()}) (type: list-of-oci-volumes)
+The list of @code{oci-volumes-configuration} records representing the
+containers to provision.
+
+@end table
+
+@end deftp
+
+
+@c %end of fragment
+
+
@c %start of fragment
@deftp {Data Type} oci-container-configuration
@@ -42986,16 +43089,16 @@ Miscellaneous Services
Overwrite the default entrypoint (@code{ENTRYPOINT}) of the image.
@item @code{host-environment} (default: @code{'()}) (type: list)
-Set environment variables in the host environment where @command{docker
-run} is invoked. This is especially useful to pass secrets from the
-host to the container without having them on the @command{docker run}'s
-command line: by setting the @code{MYSQL_PASSWORD} on the host and by passing
+Set environment variables in the host environment where @command{docker run}
+or @command{podman run} are invoked. This is especially useful to pass secrets
+from the host to the container without having them on the OCI runtime command line,
+for example: by setting the @code{MYSQL_PASSWORD} on the host and by passing
@code{--env MYSQL_PASSWORD} through the @code{extra-arguments} field, it is
possible to securely set values in the container environment. This field's
value can be a list of pairs or strings, even mixed:
@lisp
-(list '("LANGUAGE\" . "eo:ca:eu")
+(list '("LANGUAGE" . "eo:ca:eu")
"JAVA_HOME=/opt/java")
@end lisp
@@ -43003,22 +43106,24 @@ Miscellaneous Services
directly to @code{make-forkexec-constructor}.
@item @code{environment} (default: @code{'()}) (type: list)
-Set environment variables. This can be a list of pairs or strings, even mixed:
+Set environment variables inside the container. This can be a list of pairs
+or strings, even mixed:
@lisp
(list '("LANGUAGE" . "eo:ca:eu")
"JAVA_HOME=/opt/java")
@end lisp
-Pair members can be strings, gexps or file-like objects.
-Strings are passed directly to the Docker CLI. You can refer to the
-@uref{https://docs.docker.com/engine/reference/commandline/run/#env,upstream}
-documentation for semantics.
+Pair members can be strings, gexps or file-like objects. Strings are passed
+directly to the OCI runtime CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#env,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#env-e-env,Podman}
+upstream documentation for semantics.
@item @code{image} (type: string-or-oci-image)
The image used to build the container. It can be a string or an
-@code{oci-image} record. Strings are resolved by the Docker Engine, and
-follow the usual format
+@code{oci-image} record. Strings are resolved by the OCI runtime,
+and follow the usual format
@code{myregistry.local:5000/testing/test-image:tag}.
@item @code{provision} (default: @code{""}) (type: string)
@@ -43046,7 +43151,7 @@ Miscellaneous Services
by the service.
@item @code{network} (default: @code{""}) (type: string)
-Set a Docker network for the spawned container.
+Set an OCI network for the spawned container.
@item @code{ports} (default: @code{'()}) (type: list)
Set the port or port ranges to expose from the spawned container. This can be a
@@ -43057,10 +43162,11 @@ Miscellaneous Services
"10443:443")
@end lisp
-Pair members can be strings, gexps or file-like objects.
-Strings are passed directly to the Docker CLI. You can refer to the
-@uref{https://docs.docker.com/engine/reference/commandline/run/#publish,upstream}
-documentation for semantics.
+Pair members can be strings, gexps or file-like objects. Strings are passed
+directly to the OCI runtime CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#publish,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#publish-p-ip-hostport-containerport-protocol,Podman}
+upstream documentation for semantics.
@item @code{volumes} (default: @code{'()}) (type: list)
Set volume mappings for the spawned container. This can be a
@@ -43071,25 +43177,97 @@ Miscellaneous Services
"/gnu/store:/gnu/store")
@end lisp
-Pair members can be strings, gexps or file-like objects.
-Strings are passed directly to the Docker CLI. You can refer to the
-@uref{https://docs.docker.com/engine/reference/commandline/run/#volume,upstream}
-documentation for semantics.
+Pair members can be strings, gexps or file-like objects. Strings are passed
+directly to the OCI runtime CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#volume,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#volume-v-source-volume-host-dir-container-dir-options,Podman}
+upstream documentation for semantics.
@item @code{container-user} (default: @code{""}) (type: string)
Set the current user inside the spawned container. You can refer to the
-@url{https://docs.docker.com/engine/reference/run/#user,upstream}
-documentation for semantics.
+@url{https://docs.docker.com/engine/reference/run/#user,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#user-u-user-group,Podman}
+upstream documentation for semantics.
@item @code{workdir} (default: @code{""}) (type: string)
Set the current working directory for the spawned Shepherd service.
You can refer to the
-@url{https://docs.docker.com/engine/reference/run/#workdir,upstream}
-documentation for semantics.
+@url{https://docs.docker.com/engine/reference/run/#workdir,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#workdir-w-dir,Podman}
+upstream documentation for semantics.
+
+@item @code{extra-arguments} (default: @code{'()}) (type: list)
+A list of strings, gexps or file-like objects that will be directly passed
+to the @command{docker run} or @command{podman run} invokation.
+
+@end table
+
+@end deftp
+
+
+@c %end of fragment
+
+@c %start of fragment
+
+@deftp {Data Type} oci-network-configuration
+Available @code{oci-network-configuration} fields are:
+
+@table @asis
+@item @code{name} (type: string)
+The name of the OCI network to provision.
+
+@item @code{driver} (type: maybe-string)
+The driver to manage the network.
+
+@item @code{gateway} (type: maybe-string)
+IPv4 or IPv6 gateway for the subnet.
+
+@item @code{internal?} (default: @code{#f}) (type: boolean)
+Restrict external access to the network
+
+@item @code{ip-range} (type: maybe-string)
+Allocate container ip from a sub-range in CIDR format.
+
+@item @code{ipam-driver} (type: maybe-string)
+IP Address Management Driver.
+
+@item @code{ipv6?} (default: @code{#f}) (type: boolean)
+Enable IPv6 networking.
+
+@item @code{subnet} (type: maybe-string)
+Subnet in CIDR format that represents a network segment.
+
+@item @code{labels} (default: @code{'()}) (type: list)
+The list of labels that will be used to tag the current volume.
+
+@item @code{extra-arguments} (default: @code{'()}) (type: list)
+A list of strings, gexps or file-like objects that will be directly passed
+to the @command{docker network create} or @command{podman network create}
+invokation.
+
+@end table
+
+@end deftp
+
+
+@c %end of fragment
+
+@c %start of fragment
+
+@deftp {Data Type} oci-volume-configuration
+Available @code{oci-volume-configuration} fields are:
+
+@table @asis
+@item @code{name} (type: string)
+The name of the OCI volume to provision.
+
+@item @code{labels} (default: @code{'()}) (type: list)
+The list of labels that will be used to tag the current volume.
@item @code{extra-arguments} (default: @code{'()}) (type: list)
-A list of strings, gexps or file-like objects that will be directly
-passed to the @command{docker run} invocation.
+A list of strings, gexps or file-like objects that will be directly passed
+to the @command{docker volume create} or @command{podman volume create}
+invokation.
@end table
diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm
index 24f31c756b8..d1ebfa1736c 100644
--- a/gnu/services/containers.scm
+++ b/gnu/services/containers.scm
@@ -41,6 +41,7 @@ (define-module (gnu services containers)
#:use-module ((guix scripts pack) #:prefix pack:)
#:use-module (guix store)
#:use-module (srfi srfi-1)
+ #:use-module (ice-9 format)
#:use-module (ice-9 match)
#:export (rootless-podman-configuration
rootless-podman-configuration?
@@ -96,8 +97,78 @@ (define-module (gnu services containers)
oci-container-configuration-workdir
oci-container-configuration-extra-arguments
+ list-of-oci-containers?
+ list-of-oci-networks?
+ list-of-oci-volumes?
+
+ %oci-supported-runtimes
+ oci-sanitize-runtime
+ oci-runtime-system-environment
+ oci-runtime-system-extra-arguments
+ oci-runtime-system-requirement
+ oci-runtime-cli
+ oci-runtime-system-cli
+ oci-runtime-home-cli
+ oci-runtime-name
+ oci-runtime-group
+
+ oci-network-configuration
+ oci-network-configuration?
+ oci-network-configuration-fields
+ oci-network-configuration-name
+ oci-network-configuration-driver
+ oci-network-configuration-gateway
+ oci-network-configuration-internal?
+ oci-network-configuration-ip-range
+ oci-network-configuration-ipam-driver
+ oci-network-configuration-ipv6?
+ oci-network-configuration-subnet
+ oci-network-configuration-labels
+ oci-network-configuration-extra-arguments
+
+ oci-volume-configuration
+ oci-volume-configuration?
+ oci-volume-configuration-fields
+ oci-volume-configuration-name
+ oci-volume-configuration-labels
+ oci-volume-configuration-extra-arguments
+
+ oci-configuration
+ oci-configuration?
+ oci-configuration-runtime
+ oci-configuration-runtime-cli
+ oci-configuration-runtime-extra-arguments
+ oci-configuration-user
+ oci-configuration-group
+ oci-configuration-containers
+ oci-configuration-networks
+ oci-configuration-volumes
+ oci-configuration-verbose?
+ oci-configuration-valid?
+
+ oci-extension
+ oci-extension?
+ oci-extension-fields
+ oci-extension-containers
+ oci-extension-networks
+ oci-extension-volumes
+
+ oci-container-shepherd-name
+ oci-networks-shepherd-name
+ oci-networks-home-shepherd-name
+ oci-volumes-shepherd-name
+ oci-volumes-home-shepherd-name
+
oci-container-shepherd-service
- %oci-container-accounts))
+ oci-objects-merge-lst
+ oci-extension-merge
+ oci-service-type
+ oci-service-accounts
+ oci-service-profile
+ oci-service-subids
+ oci-state->shepherd-services
+ oci-configuration->shepherd-services
+ oci-configuration-extend))
(define (gexp-or-string? value)
(or (gexp? value)
@@ -296,9 +367,42 @@ (define rootless-podman-service-type
;;;
-;;; OCI container.
+;;; OCI provisioning service.
;;;
+(define %oci-supported-runtimes
+ '(docker podman))
+
+(define (oci-runtime-system-requirement runtime)
+ "Return a list of Shepherd service names required by a given OCI runtime,
+before it is able to run containers."
+ (if (eq? 'podman runtime)
+ '(cgroups2-fs-owner cgroups2-limits
+ rootless-podman-shared-root-fs user-processes)
+ '(dockerd user-processes)))
+
+(define (oci-runtime-name runtime)
+ "Return a human readable name for a given OCI runtime."
+ (if (eq? 'podman runtime)
+ "Podman" "Docker"))
+
+(define (oci-runtime-group runtime maybe-group)
+ "Implement the logic behind selection of the group that is to be used by
+Shepherd to execute OCI commands."
+ (if (not (maybe-value-set? maybe-group))
+ (if (eq? 'podman runtime)
+ "cgroup"
+ "docker")
+ maybe-group))
+
+(define (oci-sanitize-runtime value)
+ (unless (member value %oci-supported-runtimes)
+ (raise
+ (formatted-message
+ (G_ "OCI runtime must be a symbol and one of ~a,
+but ~a was found") %oci-supported-runtimes value)))
+ value)
+
(define (oci-sanitize-pair pair delimiter)
(define (valid? member)
(or (string? member)
@@ -347,6 +451,11 @@ (define (oci-sanitize-volumes value)
;; '(("/mnt/dir" . "/dir") "/run/current-system/profile:/java")
(oci-sanitize-mixed-list "volumes" value ":"))
+(define (oci-sanitize-labels value)
+ ;; Expected spec format:
+ ;; '(("foo" . "bar") "foo=bar")
+ (oci-sanitize-mixed-list "labels" value "="))
+
(define (oci-sanitize-shepherd-actions value)
(map
(lambda (el)
@@ -374,10 +483,15 @@ (define (oci-sanitize-extra-arguments value)
value))
(define (oci-image-reference image)
- (if (string? image)
- image
- (string-append (oci-image-repository image)
- ":" (oci-image-tag image))))
+ "Return a string OCI image reference representing IMAGE."
+ (define reference
+ (if (string? image)
+ image
+ (string-append (oci-image-repository image)
+ ":" (oci-image-tag image))))
+ (if (> (length (string-split reference #\/)) 1)
+ reference
+ (string-append "localhost/" reference)))
(define (oci-lowerable-image? image)
(or (manifest? image)
@@ -392,7 +506,19 @@ (define (string-or-oci-image? image)
(define list-of-symbols?
(list-of symbol?))
+(define (list-of-oci-records? name predicate value)
+ (map
+ (lambda (el)
+ (if (predicate el)
+ el
+ (raise
+ (formatted-message
+ (G_ "~a contains an illegal value: ~a") name el))))
+ value))
+
(define-maybe/no-serialization string)
+(define-maybe/no-serialization package)
+(define-maybe/no-serialization subid-range)
(define-configuration/no-serialization oci-image
(repository
@@ -437,11 +563,15 @@ (define-configuration/no-serialization oci-image
(define-configuration/no-serialization oci-container-configuration
(user
- (string "oci-container")
- "The user under whose authority docker commands will be run.")
+ (maybe-string)
+ "The user name under whose authority OCI commands will be run. This field will
+override the @code{user} field of @code{oci-configuration}.")
(group
- (string "docker")
- "The group under whose authority docker commands will be run.")
+ (maybe-string)
+ "The group name under whose authority OCI commands will be run. When
+using the @code{'podman} OCI runtime, this field will be ignored and the
+default group of the user configured in the @code{user} field will be used.
+This field will override the @code{group} field of @code{oci-configuration}.")
(command
(list-of-strings '())
"Overwrite the default command (@code{CMD}) of the image.")
@@ -451,9 +581,9 @@ (define-configuration/no-serialization oci-container-configuration
(host-environment
(list '())
"Set environment variables in the host environment where @command{docker run}
-is invoked. This is especially useful to pass secrets from the host to the
-container without having them on the @command{docker run}'s command line: by
-setting the @code{MYSQL_PASSWORD} on the host and by passing
+or @command{podman run} are invoked. This is especially useful to pass secrets
+from the host to the container without having them on the OCI runtime command line,
+for example: by setting the @code{MYSQL_PASSWORD} on the host and by passing
@code{--env MYSQL_PASSWORD} through the @code{extra-arguments} field, it is
possible to securely set values in the container environment. This field's
value can be a list of pairs or strings, even mixed:
@@ -477,15 +607,16 @@ (define-configuration/no-serialization oci-container-configuration
@end lisp
Pair members can be strings, gexps or file-like objects. Strings are passed
-directly to the Docker CLI. You can refer to the
-@url{https://docs.docker.com/engine/reference/commandline/run/#env,upstream}
-documentation for semantics."
+directly to the OCI runtime CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#env,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#env-e-env,Podman}
+upstream documentation for semantics."
(sanitizer oci-sanitize-environment))
(image
(string-or-oci-image)
"The image used to build the container. It can be a string or an
-@code{oci-image} record. Strings are resolved by the Docker
-Engine, and follow the usual format
+@code{oci-image} record. Strings are resolved by the OCI runtime,
+and follow the usual format
@code{myregistry.local:5000/testing/test-image:tag}.")
(provision
(maybe-string)
@@ -514,7 +645,7 @@ (define-configuration/no-serialization oci-container-configuration
(sanitizer oci-sanitize-shepherd-actions))
(network
(maybe-string)
- "Set a Docker network for the spawned container.")
+ "Set an OCI network for the spawned container.")
(ports
(list '())
"Set the port or port ranges to expose from the spawned container. This can
@@ -526,9 +657,10 @@ (define-configuration/no-serialization oci-container-configuration
@end lisp
Pair members can be strings, gexps or file-like objects. Strings are passed
-directly to the Docker CLI. You can refer to the
-@url{https://docs.docker.com/engine/reference/commandline/run/#publish,upstream}
-documentation for semantics."
+directly to the OCI runtime CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#publish,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#publish-p-ip-hostport-containerport-protocol,Podman}
+upstream documentation for semantics."
(sanitizer oci-sanitize-ports))
(volumes
(list '())
@@ -541,71 +673,348 @@ (define-configuration/no-serialization oci-container-configuration
@end lisp
Pair members can be strings, gexps or file-like objects. Strings are passed
-directly to the Docker CLI. You can refer to the
-@url{https://docs.docker.com/engine/reference/commandline/run/#volume,upstream}
-documentation for semantics."
+directly to the OCI runtime CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#volume,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#volume-v-source-volume-host-dir-container-dir-options,Podman}
+upstream documentation for semantics."
(sanitizer oci-sanitize-volumes))
(container-user
(maybe-string)
"Set the current user inside the spawned container. You can refer to the
-@url{https://docs.docker.com/engine/reference/run/#user,upstream}
-documentation for semantics.")
+@url{https://docs.docker.com/engine/reference/run/#user,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#user-u-user-group,Podman}
+upstream documentation for semantics.")
(workdir
(maybe-string)
- "Set the current working for the spawned Shepherd service.
+ "Set the current working directory for the spawned Shepherd service.
You can refer to the
-@url{https://docs.docker.com/engine/reference/run/#workdir,upstream}
-documentation for semantics.")
+@url{https://docs.docker.com/engine/reference/run/#workdir,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#workdir-w-dir,Podman}
+upstream documentation for semantics.")
(extra-arguments
(list '())
"A list of strings, gexps or file-like objects that will be directly passed
-to the @command{docker run} invokation."
+to the @command{docker run} or @command{podman run} invocation."
(sanitizer oci-sanitize-extra-arguments)))
-(define oci-container-configuration->options
- (lambda (config)
- (let ((entrypoint
- (oci-container-configuration-entrypoint config))
- (network
- (oci-container-configuration-network config))
- (user
- (oci-container-configuration-container-user config))
- (workdir
- (oci-container-configuration-workdir config)))
- (apply append
- (filter (compose not unspecified?)
- `(,(if (maybe-value-set? entrypoint)
- `("--entrypoint" ,entrypoint)
- '())
- ,(append-map
- (lambda (spec)
- (list "--env" spec))
- (oci-container-configuration-environment config))
- ,(if (maybe-value-set? network)
- `("--network" ,network)
- '())
- ,(if (maybe-value-set? user)
- `("--user" ,user)
- '())
- ,(if (maybe-value-set? workdir)
- `("--workdir" ,workdir)
- '())
- ,(append-map
- (lambda (spec)
- (list "-p" spec))
- (oci-container-configuration-ports config))
- ,(append-map
- (lambda (spec)
- (list "-v" spec))
- (oci-container-configuration-volumes config))))))))
-
-(define* (get-keyword-value args keyword #:key (default #f))
- (let ((kv (memq keyword args)))
- (if (and kv (>= (length kv) 2))
- (cadr kv)
- default)))
+(define (list-of-oci-containers? value)
+ (list-of-oci-records? "containers" oci-container-configuration? value))
+
+(define-configuration/no-serialization oci-volume-configuration
+ (name
+ (string)
+ "The name of the OCI volume to provision.")
+ (labels
+ (list '())
+ "The list of labels that will be used to tag the current volume."
+ (sanitizer oci-sanitize-labels))
+ (extra-arguments
+ (list '())
+ "A list of strings, gexps or file-like objects that will be directly passed
+to the @command{docker volume create} or @command{podman volume create}
+invocation."
+ (sanitizer oci-sanitize-extra-arguments)))
+
+(define (list-of-oci-volumes? value)
+ (list-of-oci-records? "volumes" oci-volume-configuration? value))
+
+(define-configuration/no-serialization oci-network-configuration
+ (name
+ (string)
+ "The name of the OCI network to provision.")
+ (driver
+ (maybe-string)
+ "The driver to manage the network.")
+ (gateway
+ (maybe-string)
+ "IPv4 or IPv6 gateway for the subnet.")
+ (internal?
+ (boolean #f)
+ "Restrict external access to the network")
+ (ip-range
+ (maybe-string)
+ "Allocate container ip from a sub-range in CIDR format.")
+ (ipam-driver
+ (maybe-string)
+ "IP Address Management Driver.")
+ (ipv6?
+ (boolean #f)
+ "Enable IPv6 networking.")
+ (subnet
+ (maybe-string)
+ "Subnet in CIDR format that represents a network segment.")
+ (labels
+ (list '())
+ "The list of labels that will be used to tag the current volume."
+ (sanitizer oci-sanitize-labels))
+ (extra-arguments
+ (list '())
+ "A list of strings, gexps or file-like objects that will be directly passed
+to the @command{docker network create} or @command{podman network create}
+invocation."
+ (sanitizer oci-sanitize-extra-arguments)))
+
+(define (list-of-oci-networks? value)
+ (list-of-oci-records? "networks" oci-network-configuration? value))
+
+(define (package-or-string? value)
+ (or (package? value) (string? value)))
+
+(define-maybe/no-serialization package-or-string)
+
+(define-configuration/no-serialization oci-configuration
+ (runtime
+ (symbol 'docker)
+ "The OCI runtime to use to run commands. It can be either @code{'docker} or
+@code{'podman}."
+ (sanitizer oci-sanitize-runtime))
+ (runtime-cli
+ (maybe-package-or-string)
+ "The OCI runtime command line to be installed in the system profile and used
+to provision OCI resources, it can be either a package or a string representing
+an absolute path to the runtime binary entrypoint. When unset it will default
+to @code{docker-cli} package for the @code{'docker} runtime or to @code{podman}
+package for the @code{'podman} runtime.")
+ (runtime-extra-arguments
+ (list '())
+ "A list of strings, gexps or file-like objects that will be placed
+after each @command{docker} or @command{podman} invokation.")
+ (user
+ (string "oci-container")
+ "The user name under whose authority OCI runtime commands will be run.")
+ (group
+ (maybe-string)
+ "The group name under whose authority OCI commands will be run. When
+using the @code{'podman} OCI runtime, this field will be ignored and the
+default group of the user configured in the @code{user} field will be used.")
+ (subuids-range
+ (maybe-subid-range)
+ "An optional @code{subid-range} record allocating subuids for the user from
+the @code{user} field. When unset, with the rootless Podman OCI runtime, it
+defaults to @code{(subid-range (name \"oci-container\"))}.")
+ (subgids-range
+ (maybe-subid-range)
+ "An optional @code{subid-range} record allocating subgids for the user from
+the @code{user} field. When unset, with the rootless Podman OCI runtime, it
+defaults to @code{(subid-range (name \"oci-container\"))}.")
+ (containers
+ (list-of-oci-containers '())
+ "The list of @code{oci-container-configuration} records representing the
+containers to provision. Most users are supposed not to use this field and use
+the @code{oci-extension} record instead.")
+ (networks
+ (list-of-oci-networks '())
+ "The list of @code{oci-network-configuration} records representing the
+networks to provision. Most users are supposed not to use this field and use
+the @code{oci-extension} record instead.")
+ (volumes
+ (list-of-oci-volumes '())
+ "The list of @code{oci-volume-configuration} records representing the
+volumes to provision. Most users are supposed not to use this field and use
+the @code{oci-extension} record instead.")
+ (verbose?
+ (boolean #f)
+ "When true, additional output will be printed, allowing to better follow the
+flow of execution."))
+
+(define (oci-runtime-system-environment runtime user)
+ (if (eq? runtime 'podman)
+ (list
+ #~(string-append
+ "HOME=" (passwd:dir (getpwnam #$user))))
+ #~()))
+
+(define (oci-runtime-cli runtime runtime-cli path)
+ "Return a gexp that, when lowered, evaluates to the file system path of the OCI
+runtime command requested by the user."
+ (if (string? runtime-cli)
+ ;; It is a user defined absolute path
+ runtime-cli
+ #~(string-append
+ #$(if (not (maybe-value-set? runtime-cli))
+ path
+ runtime-cli)
+ #$(if (eq? 'podman runtime)
+ "/bin/podman"
+ "/bin/docker"))))
+
+(define* (oci-runtime-system-cli config #:key (path "/run/current-system/profile"))
+ (let ((runtime-cli
+ (oci-configuration-runtime-cli config))
+ (runtime
+ (oci-configuration-runtime config)))
+ (oci-runtime-cli runtime runtime-cli path)))
+
+(define (oci-runtime-home-cli config)
+ (let ((runtime-cli
+ (oci-configuration-runtime-cli config))
+ (runtime
+ (oci-configuration-runtime config)))
+ (oci-runtime-cli runtime runtime-cli
+ (string-append (getenv "HOME")
+ "/.guix-home/profile"))))
+
+(define-configuration/no-serialization oci-extension
+ (containers
+ (list-of-oci-containers '())
+ "The list of @code{oci-container-configuration} records representing the
+containers to add.")
+ (networks
+ (list-of-oci-networks '())
+ "The list of @code{oci-network-configuration} records representing the
+networks to add.")
+ (volumes
+ (list-of-oci-volumes '())
+ "The list of @code{oci-volume-configuration} records representing the
+volumes to add."))
+
+(define (oci-image->container-name image)
+ "Infer the name of an OCI backed Shepherd service from its OCI image."
+ (basename
+ (if (string? image)
+ (first (string-split image #\:))
+ (oci-image-repository image))))
+
+(define (oci-object-command-shepherd-action object-name invocation)
+ "Return a Shepherd action printing a given INVOCATION of an OCI command for the
+given OBJECT-NAME."
+ (shepherd-action
+ (name 'command-line)
+ (documentation
+ (format #f "Prints ~a's OCI runtime command line invocation."
+ object-name))
+ (procedure
+ #~(lambda _
+ (format #t "~a~%" #$invocation)))))
+
+(define (oci-container-shepherd-name runtime config)
+ "Return the name of an OCI backed Shepherd service based on CONFIG.
+The name configured in the configuration record is returned when
+CONFIG's name field has a value, otherwise a name is inferred from CONFIG's
+image field."
+ (define name (oci-container-configuration-provision config))
+ (define image (oci-container-configuration-image config))
+
+ (if (maybe-value-set? name)
+ name
+ (string-append (symbol->string runtime) "-"
+ (oci-image->container-name image))))
+
+(define (oci-networks-shepherd-name runtime)
+ "Return the name of the OCI networks provisioning Shepherd service based on
+RUNTIME."
+ (string-append (symbol->string runtime) "-networks"))
+
+(define (oci-volumes-shepherd-name runtime)
+ "Return the name of the OCI volumes provisioning Shepherd service based on
+RUNTIME."
+ (string-append (symbol->string runtime) "-volumes"))
+
+(define (oci-networks-home-shepherd-name runtime)
+ "Return the name of the OCI volumes provisioning Home Shepherd service based on
+RUNTIME."
+ (string-append "home-" (oci-networks-shepherd-name runtime)))
+
+(define (oci-volumes-home-shepherd-name runtime)
+ "Return the name of the OCI volumes provisioning Home Shepherd service based on
+RUNTIME."
+ (string-append "home-" (oci-volumes-shepherd-name runtime)))
+
+(define (oci-container-configuration->options config)
+ "Map CONFIG, an oci-container-configuration record, to a gexp that, upon
+lowering, will be evaluated to a list of strings containing command line options
+for the OCI runtime run command."
+ (let ((entrypoint
+ (oci-container-configuration-entrypoint config))
+ (network
+ (oci-container-configuration-network config))
+ (user
+ (oci-container-configuration-container-user config))
+ (workdir
+ (oci-container-configuration-workdir config)))
+ (apply append
+ (filter (compose not unspecified?)
+ `(,(if (maybe-value-set? entrypoint)
+ `("--entrypoint" ,entrypoint)
+ '())
+ ,(append-map
+ (lambda (spec)
+ (list "--env" spec))
+ (oci-container-configuration-environment config))
+ ,(if (maybe-value-set? network)
+ `("--network" ,network)
+ '())
+ ,(if (maybe-value-set? user)
+ `("--user" ,user)
+ '())
+ ,(if (maybe-value-set? workdir)
+ `("--workdir" ,workdir)
+ '())
+ ,(append-map
+ (lambda (spec)
+ (list "-p" spec))
+ (oci-container-configuration-ports config))
+ ,(append-map
+ (lambda (spec)
+ (list "-v" spec))
+ (oci-container-configuration-volumes config)))))))
+
+(define (oci-network-configuration->options config)
+ "Map CONFIG, an oci-network-configuration record, to a gexp that, upon
+lowering, will be evaluated to a list of strings containing command line options
+for the OCI runtime network create command."
+ (let ((driver (oci-network-configuration-driver config))
+ (gateway
+ (oci-network-configuration-gateway config))
+ (internal?
+ (oci-network-configuration-internal? config))
+ (ip-range
+ (oci-network-configuration-ip-range config))
+ (ipam-driver
+ (oci-network-configuration-ipam-driver config))
+ (ipv6?
+ (oci-network-configuration-ipv6? config))
+ (subnet
+ (oci-network-configuration-subnet config)))
+ (apply append
+ (filter (compose not unspecified?)
+ `(,(if (maybe-value-set? driver)
+ `("--driver" ,driver)
+ '())
+ ,(if (maybe-value-set? gateway)
+ `("--gateway" ,gateway)
+ '())
+ ,(if internal?
+ `("--internal")
+ '())
+ ,(if (maybe-value-set? ip-range)
+ `("--ip-range" ,ip-range)
+ '())
+ ,(if (maybe-value-set? ipam-driver)
+ `("--ipam-driver" ,ipam-driver)
+ '())
+ ,(if ipv6?
+ `("--ipv6")
+ '())
+ ,(if (maybe-value-set? subnet)
+ `("--subnet" ,subnet)
+ '())
+ ,(append-map
+ (lambda (spec)
+ (list "--label" spec))
+ (oci-network-configuration-labels config)))))))
+
+(define (oci-volume-configuration->options config)
+ "Map CONFIG, an oci-volume-configuration record, to a gexp that, upon
+lowering, will be evaluated to a list of strings containing command line options
+for the OCI runtime volume create command."
+ (append-map
+ (lambda (spec)
+ (list "--label" spec))
+ (oci-volume-configuration-labels config)))
(define (lower-operating-system os target system)
+ "Lower OS, an operating-system record, into a tarball containing an OCI image."
(mlet* %store-monad
((tarball
(lower-object
@@ -614,24 +1023,11 @@ (define (lower-operating-system os target system)
#:target target)))
(return tarball)))
-(define (lower-manifest name image target system)
- (define value (oci-image-value image))
- (define options (oci-image-pack-options image))
- (define image-reference
- (oci-image-reference image))
- (define image-tag
- (let* ((extra-options
- (get-keyword-value options #:extra-options))
- (image-tag-option
- (and extra-options
- (get-keyword-value extra-options #:image-tag))))
- (if image-tag-option
- '()
- `(#:extra-options (#:image-tag ,image-reference)))))
-
+(define (lower-manifest name value options image-reference
+ target system grafts?)
+ "Lower VALUE, a manifest record, into a tarball containing an OCI image."
(mlet* %store-monad
- ((_ (set-grafting
- (oci-image-grafts? image)))
+ ((_ (set-grafting grafts?))
(guile (set-guile-for-build (default-guile)))
(profile
(profile-derivation value
@@ -642,14 +1038,11 @@ (define (lower-manifest name image target system)
(tarball (apply pack:docker-image
`(,name ,profile
,@options
- ,@image-tag
#:localstatedir? #t))))
(return tarball)))
-(define (lower-oci-image name image)
- (define value (oci-image-value image))
- (define image-target (oci-image-target image))
- (define image-system (oci-image-system image))
+(define (lower-oci-image-state name value options reference
+ image-target image-system grafts?)
(define target
(if (maybe-value-set? image-target)
image-target
@@ -662,7 +1055,8 @@ (define (lower-oci-image name image)
(run-with-store store
(match value
((? manifest? value)
- (lower-manifest name image target system))
+ (lower-manifest name value options reference
+ target system grafts?))
((? operating-system? value)
(lower-operating-system value target system))
((or (? gexp? value)
@@ -677,113 +1071,669 @@ (define (lower-oci-image name image)
#:target target
#:system system)))
-(define (%oci-image-loader name image tag)
- (let ((docker (file-append docker-cli "/bin/docker"))
- (tarball (lower-oci-image name image)))
+(define (lower-oci-image name image)
+ "Lower IMAGE, a oci-image record, into a tarball containing an OCI image."
+ (lower-oci-image-state
+ name
+ (oci-image-value image)
+ (oci-image-pack-options image)
+ (oci-image-reference image)
+ (oci-image-target image)
+ (oci-image-system image)
+ (oci-image-grafts? image)))
+
+(define (oci-object-exists? runtime runtime-cli object verbose?)
+ #~(lambda* (name #:key (format-string "{{.Name}}"))
+ (use-modules (ice-9 format)
+ (ice-9 match)
+ (ice-9 popen)
+ (ice-9 rdelim)
+ (srfi srfi-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)))
+
+ #$(if (eq? runtime 'podman)
+ #~(let ((command
+ (list #$runtime-cli
+ #$object "exists" name)))
+ (when #$verbose?
+ (format #t "Running~{ ~a~}~%" command))
+ (define exit-code (status:exit-val (apply system* command)))
+ (when #$verbose?
+ (format #t "Exit code: ~a~%" exit-code))
+ (equal? EXIT_SUCCESS exit-code))
+ #~(let ((command
+ (string-append #$runtime-cli
+ " " #$object " ls --format "
+ "\"" format-string "\"")))
+ (when #$verbose?
+ (format #t "Running ~a~%" command))
+ (member name (read-lines (open-input-pipe command)))))))
+
+(define* (oci-image-loader runtime runtime-cli name image tag #:key (verbose? #f))
+ "Return a file-like object that, once lowered, will evaluate to a program able
+to load IMAGE through RUNTIME-CLI and to tag it with TAG afterwards."
+ (let ((tarball (lower-oci-image name image)))
(with-imported-modules '((guix build utils))
- (program-file (format #f "~a-image-loader" name)
+ (program-file
+ (format #f "~a-image-loader" name)
#~(begin
(use-modules (guix build utils)
+ (ice-9 match)
(ice-9 popen)
- (ice-9 rdelim))
-
- (format #t "Loading image for ~a from ~a...~%" #$name #$tarball)
- (define line
- (read-line
- (open-input-pipe
- (string-append #$docker " load -i " #$tarball))))
-
- (unless (or (eof-object? line)
- (string-null? line))
- (format #t "~a~%" line)
- (let ((repository&tag
- (string-drop line
- (string-length
- "Loaded image: "))))
-
- (invoke #$docker "tag" repository&tag #$tag)
- (format #t "Tagged ~a with ~a...~%" #$tarball #$tag))))))))
-
-(define (oci-container-shepherd-service config)
- (define (guess-name name image)
- (if (maybe-value-set? name)
- name
- (string-append "docker-"
- (basename
- (if (string? image)
- (first (string-split image #\:))
- (oci-image-repository image))))))
-
- (let* ((docker (file-append docker-cli "/bin/docker"))
- (actions (oci-container-configuration-shepherd-actions config))
+ (ice-9 rdelim)
+ (srfi srfi-1))
+ (define object-exists?
+ #$(oci-object-exists? runtime runtime-cli "image" verbose?))
+ (define load-command
+ (string-append #$runtime-cli
+ " load -i " #$tarball))
+
+ (if (object-exists? #$tag #:format-string "{{.Repository}}:{{.Tag}}")
+ (format #t "~a image already exists, skipping.~%" #$tag)
+ (begin
+ (format #t "Loading image for ~a from ~a...~%" #$name #$tarball)
+ (when #$verbose?
+ (format #t "Running ~a~%" load-command))
+ (let ((line (read-line
+ (open-input-pipe load-command))))
+ (unless (or (eof-object? line)
+ (string-null? line))
+ (format #t "~a~%" line)
+ (let* ((repository&tag
+ (string-drop line
+ (string-length
+ "Loaded image: ")))
+ (tag-command
+ (list #$runtime-cli "tag" repository&tag #$tag))
+ (drop-old-tag-command
+ (list #$runtime-cli "image" "rm" "-f" repository&tag)))
+
+ (unless (string=? repository&tag #$tag)
+ (when #$verbose?
+ (format #t "Running~{ ~a~}~%" tag-command))
+
+ (let ((exit-code
+ (status:exit-val (apply system* tag-command))))
+ (format #t "Tagged ~a with ~a...~%" #$tarball #$tag)
+
+ (when #$verbose?
+ (format #t "Exit code: ~a~%" exit-code))
+
+ (when (equal? EXIT_SUCCESS exit-code)
+ (when #$verbose?
+ (format #t "Running~{ ~a~}~%" drop-old-tag-command))
+ (let ((drop-exit-code
+ (status:exit-val (apply system* drop-old-tag-command))))
+ (when #$verbose?
+ (format #t "Exit code: ~a~%" drop-exit-code))))))))))))))))
+
+(define (oci-container-run-invocation runtime runtime-cli name command image-reference
+ options runtime-extra-arguments run-extra-arguments)
+ "Return a list representing the OCI runtime
+invocation for running containers."
+ ;; run [OPTIONS] IMAGE [COMMAND] [ARG...]
+ `(,runtime-cli ,@runtime-extra-arguments "run" "--rm"
+ ,@(if (eq? runtime 'podman)
+ ;; This is because podman takes some time to
+ ;; release container names. --replace seems
+ ;; to be required to be able to restart services.
+ '("--replace")
+ '())
+ "--name" ,name
+ ,@options ,@run-extra-arguments
+ ,image-reference ,@command))
+
+(define* (oci-container-entrypoint runtime runtime-cli name image image-reference
+ invocation #:key (verbose? #f) (pre-script #~()))
+ "Return a file-like object that, once lowered, will evaluate to the entrypoint
+for the Shepherd service that will run IMAGE through RUNTIME-CLI."
+ (program-file
+ (string-append "oci-entrypoint-" name)
+ #~(begin
+ (use-modules (ice-9 format)
+ (srfi srfi-1))
+ (when #$verbose?
+ (format #t "Running in verbose mode...~%")
+ (format #t "Current user: ~a ~a~%"
+ (getuid) (passwd:name (getpwuid (getuid))))
+ (format #t "Current group: ~a ~a~%"
+ (getgid) (group:name (getgrgid (getgid))))
+ (format #t "Current directory ~a~%" (getcwd)))
+ (define invocation (list #$@invocation))
+ #$@pre-script
+ (when #$verbose?
+ (format #t "Running~{ ~a~}~%" invocation))
+ (apply execlp `(,(first invocation) ,@invocation)))))
+
+(define* (oci-container-shepherd-service runtime runtime-cli config
+ #:key
+ (runtime-environment #~())
+ (runtime-extra-arguments '())
+ (oci-requirement '())
+ (user #f)
+ (group #f)
+ (verbose? #f))
+ "Return a Shepherd service object that will run the OCI container represented
+by CONFIG through RUNTIME-CLI."
+ (let* ((actions (oci-container-configuration-shepherd-actions config))
(auto-start?
(oci-container-configuration-auto-start? config))
- (user (oci-container-configuration-user config))
- (group (oci-container-configuration-group config))
+ (maybe-user (oci-container-configuration-user config))
+ (maybe-group (oci-container-configuration-group config))
+ (user (if (maybe-value-set? maybe-user)
+ maybe-user
+ user))
+ (group (if (maybe-value-set? maybe-group)
+ maybe-group
+ group))
(host-environment
(oci-container-configuration-host-environment config))
(command (oci-container-configuration-command config))
(log-file (oci-container-configuration-log-file config))
- (provision (oci-container-configuration-provision config))
(requirement (oci-container-configuration-requirement config))
(respawn?
(oci-container-configuration-respawn? config))
(image (oci-container-configuration-image config))
(image-reference (oci-image-reference image))
(options (oci-container-configuration->options config))
- (name (guess-name provision image))
+ (name
+ (oci-container-shepherd-name runtime config))
(extra-arguments
- (oci-container-configuration-extra-arguments config)))
+ (oci-container-configuration-extra-arguments config))
+ (invocation
+ (oci-container-run-invocation
+ runtime runtime-cli name command image-reference
+ options runtime-extra-arguments extra-arguments))
+ (container-action
+ (lambda* (command #:key (environment-variables #f))
+ #~(lambda _
+ (fork+exec-command
+ (list #$@command)
+ #$@(if user (list #:user user) '())
+ #$@(if group (list #:group group) '())
+ #$@(if (maybe-value-set? log-file)
+ (list #:log-file log-file)
+ '())
+ #$@(if (and user (eq? runtime 'podman))
+ (list #:directory
+ #~(passwd:dir (getpwnam #$user)))
+ '())
+ #$@(if environment-variables
+ (list #:environment-variables
+ environment-variables)
+ '()))))))
(shepherd-service (provision `(,(string->symbol name)))
- (requirement `(dockerd user-processes ,@requirement))
+ (requirement `(,@oci-requirement
+ ,@requirement))
(respawn? respawn?)
(auto-start? auto-start?)
(documentation
(string-append
- "Docker backed Shepherd service for "
+ (oci-runtime-name runtime) " backed Shepherd service for "
(if (oci-image? image) name image) "."))
(start
- #~(lambda ()
- #$@(if (oci-image? image)
- #~((invoke #$(%oci-image-loader
- name image image-reference)))
- #~())
- (fork+exec-command
- ;; docker run [OPTIONS] IMAGE [COMMAND] [ARG...]
- (list #$docker "run" "--rm" "--name" #$name
- #$@options #$@extra-arguments
- #$image-reference #$@command)
- #:user #$user
- #:group #$group
- #$@(if (maybe-value-set? log-file)
- (list #:log-file log-file)
- '())
- #:environment-variables
- (list #$@host-environment))))
+ (container-action
+ (list (oci-container-entrypoint
+ runtime runtime-cli name image image-reference
+ invocation #:verbose? verbose?
+ #:pre-script
+ (if (oci-image? image)
+ #~((system*
+ #$(oci-image-loader
+ runtime runtime-cli name image
+ image-reference #:verbose? verbose?)))
+ #~())))
+ #:environment-variables
+ #~(append
+ (list #$@host-environment)
+ (list #$@runtime-environment))))
(stop
- #~(lambda _
- (invoke #$docker "rm" "-f" #$name)))
+ (container-action
+ (list
+ (oci-container-entrypoint
+ runtime runtime-cli name image image-reference
+ (list runtime-cli "rm" "-f" name)
+ #:verbose? verbose?))
+ #:environment-variables
+ #~(append
+ (list #$@host-environment)
+ (list #$@runtime-environment))))
(actions
- (if (oci-image? image)
- '()
- (append
+ (append
+ (list
+ (oci-object-command-shepherd-action
+ name #~(string-join (list #$@invocation) " ")))
+ (if (oci-image? image)
+ '()
(list
- (shepherd-action
- (name 'pull)
- (documentation
- (format #f "Pull ~a's image (~a)."
- name image))
- (procedure
- #~(lambda _
- (invoke #$docker "pull" #$image)))))
- actions))))))
-
-(define %oci-container-accounts
+ (let ((service-name name))
+ (shepherd-action
+ (name 'pull)
+ (documentation
+ (format #f "Pull ~a's image (~a)."
+ service-name image))
+ (procedure
+ (container-action
+ (list
+ (oci-container-entrypoint
+ runtime runtime-cli service-name image
+ image-reference
+ (list runtime-cli "pull" image)
+ #:verbose? verbose?))
+ #:environment-variables
+ #~(append
+ (list #$@host-environment)
+ (list #$@runtime-environment))))))))
+ actions)))))
+
+(define (oci-object-create-invocation object runtime-cli name options
+ runtime-extra-arguments
+ create-extra-arguments)
+ "Return a gexp that, upon lowering, will evaluate to the OCI runtime
+invocation for creating networks and volumes."
+ ;; network|volume create [options] [NAME]
+ #~(list #$runtime-cli #$@runtime-extra-arguments #$object "create"
+ #$@options #$@create-extra-arguments #$name))
+
+(define (format-oci-invocations invocations)
+ "Return a gexp that, upon lowering, will evaluate to a formatted message
+containing the INVOCATIONS that the OCI runtime will execute to provision
+networks or volumes."
+ #~(string-join (map (lambda (i) (string-join i " "))
+ (list #$@invocations))
+ "\n"))
+
+(define* (oci-object-create-script object runtime runtime-cli invocations
+ #:key (verbose? #f))
+ "Return a file-like object that, once lowered, will evaluate to a program able
+to create OCI networks and volumes through RUNTIME-CLI."
+ (define runtime-string (symbol->string runtime))
+ (program-file
+ (string-append runtime-string "-" object "s-create.scm")
+ #~(begin
+ (use-modules (ice-9 format)
+ (ice-9 match)
+ (ice-9 popen)
+ (ice-9 rdelim)
+ (srfi srfi-1))
+
+ (define object-exists?
+ #$(oci-object-exists? runtime runtime-cli object verbose?))
+
+ (for-each
+ (lambda (invocation)
+ (define name (last invocation))
+ (if (object-exists? name)
+ (format #t "~a ~a ~a already exists, skipping creation.~%"
+ #$(oci-runtime-name runtime) name #$object)
+ (begin
+ (when #$verbose?
+ (format #t "Running~{ ~a~}~%" invocation))
+ (let ((exit-code (status:exit-val (apply system* invocation))))
+ (when #$verbose?
+ (format #t "Exit code: ~a~%" exit-code))))))
+ (list #$@invocations)))))
+
+(define* (oci-object-shepherd-service object runtime runtime-cli name requirement invocations
+ #:key
+ (runtime-environment #~())
+ (user #f)
+ (group #f)
+ (verbose? #f))
+ "Return a Shepherd service object that will create the OBJECTs represented
+by INVOCATIONS through RUNTIME-CLI."
+ (shepherd-service (provision `(,(string->symbol name)))
+ (requirement requirement)
+ (one-shot? #t)
+ (documentation
+ (string-append
+ (oci-runtime-name runtime) " " object
+ " provisioning service"))
+ (start
+ #~(lambda _
+ (fork+exec-command
+ (list
+ #$(oci-object-create-script
+ object runtime runtime-cli
+ invocations
+ #:verbose? verbose?))
+ #$@(if user (list #:user user) '())
+ #$@(if group (list #:group group) '())
+ #:environment-variables
+ (list #$@runtime-environment))))
+ (actions
+ (list
+ (oci-object-command-shepherd-action
+ name (format-oci-invocations invocations))))))
+
+(define* (oci-networks-shepherd-service runtime runtime-cli name networks
+ #:key (user #f) (group #f) (verbose? #f)
+ (runtime-extra-arguments '())
+ (runtime-environment #~())
+ (runtime-requirement '()))
+ "Return a Shepherd service object that will create the networks represented
+in CONFIG."
+ (let ((invocations
+ (map
+ (lambda (network)
+ (oci-object-create-invocation
+ "network" runtime-cli
+ (oci-network-configuration-name network)
+ (oci-network-configuration->options network)
+ runtime-extra-arguments
+ (oci-network-configuration-extra-arguments network)))
+ networks)))
+
+ (oci-object-shepherd-service
+ "network" runtime runtime-cli name
+ runtime-requirement invocations
+ #:user user #:group group #:runtime-environment runtime-environment
+ #:verbose? verbose?)))
+
+(define* (oci-volumes-shepherd-service runtime runtime-cli name volumes
+ #:key (user #f) (group #f) (verbose? #f)
+ (runtime-extra-arguments '())
+ (runtime-environment #~())
+ (runtime-requirement '()))
+ "Return a Shepherd service object that will create the volumes represented
+in CONFIG."
+ (let ((invocations
+ (map
+ (lambda (volume)
+ (oci-object-create-invocation
+ "volume" runtime-cli
+ (oci-volume-configuration-name volume)
+ (oci-volume-configuration->options volume)
+ runtime-extra-arguments
+ (oci-volume-configuration-extra-arguments volume)))
+ volumes)))
+
+ (oci-object-shepherd-service
+ "volume" runtime runtime-cli name runtime-requirement invocations
+ #:user user #:group group #:runtime-environment runtime-environment
+ #:verbose? verbose?)))
+
+(define (oci-service-accounts config)
+ (define user (oci-configuration-user config))
+ (define maybe-group (oci-configuration-group config))
+ (define runtime (oci-configuration-runtime config))
(list (user-account
- (name "oci-container")
+ (name user)
(comment "OCI services account")
- (group "docker")
- (system? #t)
- (home-directory "/var/empty")
+ (group "users")
+ (supplementary-groups
+ (list (oci-runtime-group runtime maybe-group)))
+ (system? (eq? 'docker runtime))
+ (home-directory (if (eq? 'podman runtime)
+ (string-append "/home/" user)
+ "/var/empty"))
+ (create-home-directory? (eq? 'podman runtime))
(shell (file-append shadow "/sbin/nologin")))))
+
+(define* (oci-state->shepherd-services runtime runtime-cli containers networks volumes
+ #:key (user #f) (group #f) (verbose? #f)
+ (networks-name #f) (volumes-name #f)
+ (runtime-extra-arguments '())
+ (runtime-environment #~())
+ (runtime-requirement '())
+ (containers-requirement '())
+ (networks-requirement '())
+ (volumes-requirement '()))
+ "Returns a list of Shepherd services based on the input OCI state."
+ (let* ((networks-name
+ (if (string? networks-name)
+ networks-name
+ (oci-networks-shepherd-name runtime)))
+ (networks?
+ (> (length networks) 0))
+ (networks-service
+ (if networks?
+ (list
+ (string->symbol networks-name))
+ '()))
+ (volumes-name
+ (if (string? volumes-name)
+ volumes-name
+ (oci-volumes-shepherd-name runtime)))
+ (volumes?
+ (> (length volumes) 0))
+ (volumes-service
+ (if volumes?
+ (list (string->symbol volumes-name))
+ '())))
+ (append
+ (map
+ (lambda (c)
+ (oci-container-shepherd-service
+ runtime runtime-cli c
+ #:user user
+ #:group group
+ #:runtime-environment runtime-environment
+ #:runtime-extra-arguments runtime-extra-arguments
+ #:oci-requirement
+ (append containers-requirement
+ runtime-requirement
+ networks-service
+ volumes-service)
+ #:verbose? verbose?))
+ containers)
+ (if networks?
+ (list
+ (oci-networks-shepherd-service
+ runtime runtime-cli
+ networks-name networks
+ #:user user #:group group
+ #:runtime-extra-arguments runtime-extra-arguments
+ #:runtime-environment runtime-environment
+ #:runtime-requirement (append networks-requirement
+ runtime-requirement)
+ #:verbose? verbose?))
+ '())
+ (if volumes?
+ (list
+ (oci-volumes-shepherd-service
+ runtime runtime-cli
+ volumes-name volumes
+ #:user user #:group group
+ #:runtime-extra-arguments runtime-extra-arguments
+ #:runtime-environment runtime-environment
+ #:runtime-requirement (append runtime-requirement
+ volumes-requirement)
+ #:verbose? verbose?))
+ '()))))
+
+(define (oci-configuration->shepherd-services config)
+ (let* ((runtime (oci-configuration-runtime config))
+ (system-runtime-cli
+ (oci-runtime-system-cli config))
+ (home-runtime-cli
+ (oci-runtime-home-cli config))
+ (runtime-extra-arguments
+ (oci-configuration-runtime-extra-arguments config))
+ (containers (oci-configuration-containers config))
+ (networks (oci-configuration-networks config))
+ (volumes (oci-configuration-volumes config))
+ (user (oci-configuration-user config))
+ (group
+ (if (eq? runtime 'podman)
+ #~(group:name
+ (getgrgid
+ (passwd:gid
+ (getpwnam #$user))))
+ (oci-runtime-group config (oci-configuration-group config))))
+ (verbose? (oci-configuration-verbose? config)))
+ (oci-state->shepherd-services runtime system-runtime-cli containers networks volumes
+ #:user user
+ #:group group
+ #:verbose? verbose?
+ #:runtime-extra-arguments
+ runtime-extra-arguments
+ #:runtime-environment
+ (oci-runtime-system-environment runtime user)
+ #:runtime-requirement
+ (oci-runtime-system-requirement runtime)
+ #:networks-requirement '(networking))))
+
+(define (oci-service-subids config)
+ "Return a subids-extension record representing subuids and subgids required by
+the rootless Podman backend."
+ (define (delete-duplicate-ranges ranges)
+ (delete-duplicates ranges
+ (lambda args
+ (apply string=? (map subid-range-name ranges)))))
+ (define runtime
+ (oci-configuration-runtime config))
+ (define user
+ (oci-configuration-user config))
+ (define subgids (oci-configuration-subgids-range config))
+ (define subuids (oci-configuration-subuids-range config))
+ (define container-users
+ (filter (lambda (range)
+ (and (maybe-value-set?
+ (subid-range-name range))
+ (not (string=? (subid-range-name range) user))))
+ (map (lambda (container)
+ (subid-range
+ (name
+ (oci-container-configuration-user container))))
+ (oci-configuration-containers config))))
+ (define subgid-ranges
+ (delete-duplicate-ranges
+ (cons
+ (if (not (maybe-value-set? subgids))
+ (subid-range (name user))
+ subgids)
+ container-users)))
+ (define subuid-ranges
+ (delete-duplicate-ranges
+ (cons
+ (if (not (maybe-value-set? subuids))
+ (subid-range (name user))
+ subuids)
+ container-users)))
+
+ (if (eq? 'podman runtime)
+ (subids-extension
+ (subgids
+ subgid-ranges)
+ (subuids
+ subuid-ranges))
+ (subids-extension)))
+
+(define (oci-objects-merge-lst a b object get-name)
+ (define (contains? value lst)
+ (member value (map get-name lst)))
+ (let loop ((merged '())
+ (lst (append a b)))
+ (if (null? lst)
+ merged
+ (loop
+ (let ((element (car lst)))
+ (when (contains? element merged)
+ (raise
+ (formatted-message
+ (G_ "Duplicated ~a: ~a. ~as names should be unique, please
+remove the duplicate.") object (get-name element) object)))
+ (cons element merged))
+ (cdr lst)))))
+
+(define (oci-extension-merge a b)
+ (oci-extension
+ (containers (oci-objects-merge-lst
+ (oci-extension-containers a)
+ (oci-extension-containers b)
+ "container"
+ (lambda (config)
+ (define maybe-name (oci-container-configuration-provision config))
+ (if (maybe-value-set? maybe-name)
+ maybe-name
+ (oci-image->container-name
+ (oci-container-configuration-image config))))))
+ (networks (oci-objects-merge-lst
+ (oci-extension-networks a)
+ (oci-extension-networks b)
+ "network"
+ oci-network-configuration-name))
+ (volumes (oci-objects-merge-lst
+ (oci-extension-volumes a)
+ (oci-extension-volumes b)
+ "volume"
+ oci-volume-configuration-name))))
+
+(define (oci-service-profile runtime runtime-cli)
+ `(,bash-minimal
+ ,@(if (string? runtime-cli)
+ '()
+ (list
+ (cond
+ ((maybe-value-set? runtime-cli)
+ runtime-cli)
+ ((eq? 'podman runtime)
+ podman)
+ (else
+ docker-cli))))))
+
+(define (oci-configuration-extend config extension)
+ (oci-configuration
+ (inherit config)
+ (containers
+ (oci-objects-merge-lst
+ (oci-configuration-containers config)
+ (oci-extension-containers extension)
+ "container"
+ (lambda (oci-config)
+ (define runtime
+ (oci-configuration-runtime config))
+ (oci-container-shepherd-name runtime oci-config))))
+ (networks (oci-objects-merge-lst
+ (oci-configuration-networks config)
+ (oci-extension-networks extension)
+ "network"
+ oci-network-configuration-name))
+ (volumes (oci-objects-merge-lst
+ (oci-configuration-volumes config)
+ (oci-extension-volumes extension)
+ "volume"
+ oci-volume-configuration-name))))
+
+(define oci-service-type
+ (service-type (name 'oci)
+ (extensions
+ (list
+ (service-extension profile-service-type
+ (lambda (config)
+ (let ((runtime-cli
+ (oci-configuration-runtime-cli config))
+ (runtime
+ (oci-configuration-runtime config)))
+ (oci-service-profile runtime runtime-cli))))
+ (service-extension subids-service-type
+ oci-service-subids)
+ (service-extension account-service-type
+ oci-service-accounts)
+ (service-extension shepherd-root-service-type
+ oci-configuration->shepherd-services)))
+ ;; Concatenate OCI object lists.
+ (compose (lambda (args)
+ (fold oci-extension-merge
+ (oci-extension)
+ args)))
+ (extend oci-configuration-extend)
+ (default-value (oci-configuration))
+ (description
+ "This service implements the provisioning of OCI object such
+as containers, networks and volumes.")))
diff --git a/gnu/services/docker.scm b/gnu/services/docker.scm
index 828ceea313a..125e748bb0e 100644
--- a/gnu/services/docker.scm
+++ b/gnu/services/docker.scm
@@ -31,7 +31,10 @@ (define-module (gnu services docker)
#:use-module (gnu system shadow)
#:use-module (gnu packages docker)
#:use-module (gnu packages linux) ;singularity
+ #:use-module (guix deprecation)
+ #:use-module (guix diagnostics)
#:use-module (guix gexp)
+ #:use-module (guix i18n)
#:use-module (guix records)
#:use-module (srfi srfi-1)
#:use-module (ice-9 format)
@@ -67,16 +70,18 @@ (define-module (gnu services docker)
oci-container-configuration-volumes
oci-container-configuration-container-user
oci-container-configuration-workdir
- oci-container-configuration-extra-arguments
- oci-container-shepherd-service
- %oci-container-accounts)
+ oci-container-configuration-extra-arguments)
#:export (containerd-configuration
containerd-service-type
docker-configuration
docker-service-type
singularity-service-type
- oci-container-service-type))
+ ;; for backwards compatibility, until the
+ ;; oci-container-service-type is fully deprecated
+ oci-container-shepherd-service
+ oci-container-service-type
+ %oci-container-accounts))
(define-maybe file-like)
@@ -297,17 +302,25 @@ (define singularity-service-type
;;; OCI container.
;;;
-(define (configs->shepherd-services configs)
- (map oci-container-shepherd-service configs))
+;; for backwards compatibility, until the
+;; oci-container-service-type is fully deprecated
+(define-deprecated (oci-container-shepherd-service config)
+ oci-service-type
+ ((@ (gnu services containers) oci-container-shepherd-service)
+ 'docker config))
+(define %oci-container-accounts
+ (filter user-account? (oci-service-accounts (oci-configuration))))
(define oci-container-service-type
(service-type (name 'oci-container)
- (extensions (list (service-extension profile-service-type
- (lambda _ (list docker-cli)))
- (service-extension account-service-type
- (const %oci-container-accounts))
- (service-extension shepherd-root-service-type
- configs->shepherd-services)))
+ (extensions
+ (list (service-extension oci-service-type
+ (lambda (containers)
+ (warning
+ (G_
+ "'oci-container-service-type' is deprecated, use 'oci-service-type' instead~%"))
+ (oci-extension
+ (containers containers))))))
(default-value '())
(extend append)
(compose concatenate)
diff --git a/gnu/tests/containers.scm b/gnu/tests/containers.scm
index 0ecc8ddb126..5e6f39387e7 100644
--- a/gnu/tests/containers.scm
+++ b/gnu/tests/containers.scm
@@ -27,6 +27,9 @@ (define-module (gnu tests containers)
#:use-module (gnu services)
#:use-module (gnu services containers)
#:use-module (gnu services desktop)
+ #:use-module ((gnu services docker)
+ #:select (containerd-service-type
+ docker-service-type))
#:use-module (gnu services dbus)
#:use-module (gnu services networking)
#:use-module (gnu system)
@@ -39,7 +42,9 @@ (define-module (gnu tests containers)
#:use-module (guix profiles)
#:use-module ((guix scripts pack) #:prefix pack:)
#:use-module (guix store)
- #:export (%test-rootless-podman))
+ #:export (%test-rootless-podman
+ %test-oci-service-rootless-podman
+ %test-oci-service-docker))
(define %rootless-podman-os
@@ -345,3 +350,995 @@ (define %test-rootless-podman
(name "rootless-podman")
(description "Test rootless Podman service.")
(value (build-tarball&run-rootless-podman-test))))
+
+
+(define %oci-rootless-podman-os
+ (simple-operating-system
+ (service dhcp-client-service-type)
+ (service dbus-root-service-type)
+ (service polkit-service-type)
+ (service elogind-service-type)
+ (service iptables-service-type)
+ (service rootless-podman-service-type)
+ (extra-special-file "/shared.txt"
+ (plain-file "shared.txt" "hello"))
+ (service oci-service-type
+ (oci-configuration
+ (runtime 'podman)
+ (verbose? #t)))
+ (simple-service 'oci-provisioning
+ oci-service-type
+ (oci-extension
+ (networks
+ (list (oci-network-configuration (name "my-network"))))
+ (volumes
+ (list (oci-volume-configuration (name "my-volume"))))
+ (containers
+ (list
+ (oci-container-configuration
+ (provision "first")
+ (image
+ (oci-image
+ (repository "guile")
+ (value
+ (specifications->manifest '("guile")))
+ (pack-options
+ '(#:symlinks (("/bin" -> "bin"))))))
+ (entrypoint "/bin/guile")
+ (network "my-network")
+ (command
+ '("-c" "(use-modules (web server))
+(define (handler request request-body)
+ (values '((content-type . (text/plain))) \"out of office\"))
+(run-server handler 'http `(#:addr ,(inet-pton AF_INET \"0.0.0.0\")))"))
+ (host-environment
+ '(("VARIABLE" . "value")))
+ (volumes
+ '(("my-volume" . "/my-volume")))
+ (extra-arguments
+ '("--env" "VARIABLE")))
+ (oci-container-configuration
+ (provision "second")
+ (image
+ (oci-image
+ (repository "guile")
+ (value
+ (specifications->manifest '("guile")))
+ (pack-options
+ '(#:symlinks (("/bin" -> "bin"))))))
+ (entrypoint "/bin/guile")
+ (network "my-network")
+ (command
+ '("-c" "(let l ((c 300))(display c)(sleep 1)(when(positive? c)(l (- c 1))))"))
+ (volumes
+ '(("my-volume" . "/my-volume")
+ ("/shared.txt" . "/shared.txt:ro"))))))))))
+
+(define (run-rootless-podman-oci-service-test)
+ (define os
+ (marionette-operating-system
+ (operating-system-with-gc-roots
+ %oci-rootless-podman-os
+ (list))
+ #: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))
+ #~(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-oci-service")
+
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (wait-for-service 'user-processes))
+ marionette)
+
+ (test-assert "rootless-podman services started successfully"
+ (begin
+ (define (run-test)
+ (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))
+ ;; Allow services to come up on slower machines
+ (let loop ((attempts 0))
+ (if (= attempts 60)
+ (error "Services didn't come up after more than 60 seconds")
+ (if (equal? '("cgroup" "cgroup")
+ (run-test))
+ #t
+ (begin
+ (sleep 1)
+ (format #t "Services didn't come up yet, retrying with attempt ~a~%"
+ (+ 1 attempts))
+ (loop (+ 1 attempts))))))))
+
+ (test-assert "podman-volumes running"
+ (begin
+ (define (run-test)
+ (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 6))
+ (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 "oci-container")))
+ (setuid (passwd:uid (getpw "oci-container")))
+
+ (let ((response (slurp
+ "/run/current-system/profile/bin/podman"
+ "volume" "ls" "-n" "--format" "\"{{.Name}}\""
+ "|" "tr" "' '" "'\n'")))
+
+ (call-with-output-file (string-append ,out-dir "/response")
+ (lambda (port)
+ (display (string-join response "\n") port)))))
+ (lambda ()
+ (primitive-exit 127))))
+ (pid
+ (cdr (waitpid pid))))
+
+ (wait-for-file (string-append ,out-dir "/response"))
+
+ (stable-sort
+ (slurp "cat" (string-append ,out-dir "/response"))
+ string<=?))
+ marionette))
+ ;; Allow services to come up on slower machines
+ (let loop ((attempts 0))
+ (if (= attempts 80)
+ (error "Service didn't come up after more than 80 seconds")
+ (if (equal? '("my-volume")
+ (run-test))
+ #t
+ (begin
+ (sleep 1)
+ (loop (+ 1 attempts))))))))
+
+ (test-assert "podman-networks running"
+ (begin
+ (define (run-test)
+ (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 6))
+ (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 "oci-container")))
+ (setuid (passwd:uid (getpw "oci-container")))
+
+ (let ((response (slurp
+ "/run/current-system/profile/bin/podman"
+ "network" "ls" "-n" "--format" "\"{{.Name}}\""
+ "|" "tr" "' '" "'\n'")))
+
+ (call-with-output-file (string-append ,out-dir "/response")
+ (lambda (port)
+ (display (string-join response "\n") port)))))
+ (lambda ()
+ (primitive-exit 127))))
+ (pid
+ (cdr (waitpid pid))))
+
+ (wait-for-file (string-append ,out-dir "/response"))
+
+ (stable-sort
+ (slurp "cat" (string-append ,out-dir "/response"))
+ string<=?))
+ marionette))
+ ;; Allow services to come up on slower machines
+ (let loop ((attempts 0))
+ (if (= attempts 80)
+ (error "Service didn't come up after more than 80 seconds")
+ (if (equal? '("my-network" "podman")
+ (run-test))
+ #t
+ (begin
+ (sleep 1)
+ (loop (+ 1 attempts))))))))
+
+ (test-assert "first container running"
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (wait-for-service 'first #:timeout 120)
+ #t)
+ marionette))
+
+ (test-assert "second container running"
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (wait-for-service 'second #:timeout 120)
+ #t)
+ marionette))
+
+ (test-assert "passing host environment variables"
+ (begin
+ (define (run-test)
+ (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 "oci-container")))
+ (setuid (passwd:uid (getpw "oci-container")))
+
+ (let ((response (slurp
+ "/run/current-system/profile/bin/podman"
+ "exec" "first"
+ "/bin/guile" "-c" "'(display (getenv \"VARIABLE\"))'")))
+ (call-with-output-file (string-append ,out-dir "/response")
+ (lambda (port)
+ (display (string-join response "\n") port)))))
+ (lambda ()
+ (primitive-exit 127))))
+ (pid
+ (cdr (waitpid pid))))
+
+ (wait-for-file (string-append ,out-dir "/response"))
+ (slurp "cat" (string-append ,out-dir "/response")))
+ marionette))
+ ;; Allow image to be loaded on slower machines
+ (let loop ((attempts 0))
+ (if (= attempts 180)
+ (error "Service didn't come up after more than 180 seconds")
+ (if (equal? (list "value")
+ (run-test))
+ #t
+ (begin
+ (sleep 1)
+ (loop (+ 1 attempts))))))))
+
+ (test-equal "mounting host files"
+ '("hello")
+ (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 "oci-container")))
+ (setuid (passwd:uid (getpw "oci-container")))
+
+ (let ((response (slurp
+ "/run/current-system/profile/bin/podman"
+ "exec" "second"
+ "/bin/guile" "-c" "'(begin (use-modules (ice-9 popen) (ice-9 rdelim))
+(display (call-with-input-file \"/shared.txt\" read-line)))'")))
+ (call-with-output-file (string-append ,out-dir "/response")
+ (lambda (port)
+ (display (string-join response " ") port)))))
+ (lambda ()
+ (primitive-exit 127))))
+ (pid
+ (cdr (waitpid pid))))
+
+ (wait-for-file (string-append ,out-dir "/response"))
+ (slurp "cat" (string-append ,out-dir "/response")))
+ marionette))
+
+ (test-equal "write to volumes"
+ '("world")
+ (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 "oci-container")))
+ (setuid (passwd:uid (getpw "oci-container")))
+
+ (slurp
+ "/run/current-system/profile/bin/podman"
+ "exec" "first"
+ "/bin/guile" "-c" "'(begin (use-modules (ice-9 popen) (ice-9 rdelim))
+(call-with-output-file \"/my-volume/out.txt\" (lambda (p) (display \"world\" p))))'")
+
+ (let ((response (slurp
+ "/run/current-system/profile/bin/podman"
+ "exec" "second"
+ "/bin/guile" "-c" "'(begin (use-modules (ice-9 popen) (ice-9 rdelim))
+(display (call-with-input-file \"/my-volume/out.txt\" read-line)))'")))
+ (call-with-output-file (string-append ,out-dir "/response")
+ (lambda (port)
+ (display (string-join response " ") port)))))
+ (lambda ()
+ (primitive-exit 127))))
+ (pid
+ (cdr (waitpid pid))))
+
+ (wait-for-file (string-append ,out-dir "/response"))
+ (slurp "cat" (string-append ,out-dir "/response")))
+ marionette))
+
+ (test-equal "can read ports over network"
+ '("out of office")
+ (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 "oci-container")))
+ (setuid (passwd:uid (getpw "oci-container")))
+
+ (let ((response (slurp
+ "/run/current-system/profile/bin/podman"
+ "exec" "second"
+ "/bin/guile" "-c" "'(begin (use-modules (web client))
+(define-values (response out)
+ (http-get \"http://first:8080\"))
+(display out))'")))
+ (call-with-output-file (string-append ,out-dir "/response")
+ (lambda (port)
+ (display (string-join response " ") port)))))
+ (lambda ()
+ (primitive-exit 127))))
+ (pid
+ (cdr (waitpid pid))))
+
+ (wait-for-file (string-append ,out-dir "/response"))
+ (slurp "cat" (string-append ,out-dir "/response")))
+ marionette))
+
+ (test-end))))
+
+ (gexp->derivation "rootless-podman-oci-service-test" test))
+
+(define %test-oci-service-rootless-podman
+ (system-test
+ (name "oci-service-rootless-podman")
+ (description "Test Rootless-Podman backed OCI provisioning service.")
+ (value (run-rootless-podman-oci-service-test))))
+
+(define %oci-docker-os
+ (simple-operating-system
+ (service dhcp-client-service-type)
+ (service dbus-root-service-type)
+ (service polkit-service-type)
+ (service elogind-service-type)
+ (service containerd-service-type)
+ (service docker-service-type)
+ (extra-special-file "/shared.txt"
+ (plain-file "shared.txt" "hello"))
+ (service oci-service-type
+ (oci-configuration
+ (verbose? #t)))
+ (simple-service 'oci-provisioning
+ oci-service-type
+ (oci-extension
+ (networks
+ (list (oci-network-configuration (name "my-network"))))
+ (volumes
+ (list (oci-volume-configuration (name "my-volume"))))
+ (containers
+ (list
+ (oci-container-configuration
+ (provision "first")
+ (image
+ (oci-image
+ (repository "guile")
+ (value
+ (specifications->manifest '("guile")))
+ (pack-options
+ '(#:symlinks (("/bin" -> "bin"))))))
+ (entrypoint "/bin/guile")
+ (network "my-network")
+ (command
+ '("-c" "(use-modules (web server))
+(define (handler request request-body)
+ (values '((content-type . (text/plain))) \"out of office\"))
+(run-server handler 'http `(#:addr ,(inet-pton AF_INET \"0.0.0.0\")))"))
+ (host-environment
+ '(("VARIABLE" . "value")))
+ (volumes
+ '(("my-volume" . "/my-volume")))
+ (extra-arguments
+ '("--env" "VARIABLE")))
+ (oci-container-configuration
+ (provision "second")
+ (image
+ (oci-image
+ (repository "guile")
+ (value
+ (specifications->manifest '("guile")))
+ (pack-options
+ '(#:symlinks (("/bin" -> "bin"))))))
+ (entrypoint "/bin/guile")
+ (network "my-network")
+ (command
+ '("-c" "(let l ((c 300))(display c)(sleep 1)(when(positive? c)(l (- c 1))))"))
+ (volumes
+ '(("my-volume" . "/my-volume")
+ ("/shared.txt" . "/shared.txt:ro"))))))))))
+
+(define (run-docker-oci-service-test)
+ (define os
+ (marionette-operating-system
+ (operating-system-with-gc-roots
+ %oci-docker-os
+ (list))
+ #: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))
+ #~(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))
+
+ (test-runner-current (system-test-runner #$output))
+ (test-begin "docker-oci-service")
+
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (wait-for-service 'dockerd))
+ marionette)
+
+ (test-assert "docker-volumes running"
+ (begin
+ (define (run-test)
+ (marionette-eval
+ `(begin
+ (use-modules (ice-9 popen)
+ (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
+ (list "sh" "-l" "-c"
+ (string-join
+ args
+ " "))))
+ (output (read-lines port))
+ (status (close-pipe port)))
+ output)))
+
+ (stable-sort
+ (slurp
+ "/run/current-system/profile/bin/docker"
+ "volume" "ls" "--format" "\"{{.Name}}\"")
+ string<=?))
+
+ marionette))
+ ;; Allow services to come up on slower machines
+ (let loop ((attempts 0))
+ (if (= attempts 80)
+ (error "Service didn't come up after more than 80 seconds")
+ (if (equal? '("my-volume")
+ (run-test))
+ #t
+ (begin
+ (sleep 1)
+ (loop (+ 1 attempts))))))))
+
+ (test-assert "docker-networks running"
+ (begin
+ (define (run-test)
+ (marionette-eval
+ `(begin
+ (use-modules (ice-9 popen)
+ (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
+ (list "sh" "-l" "-c"
+ (string-join
+ args
+ " "))))
+ (output (read-lines port))
+ (status (close-pipe port)))
+ output)))
+
+ (stable-sort
+ (slurp
+ "/run/current-system/profile/bin/docker"
+ "network" "ls" "--format" "\"{{.Name}}\"")
+ string<=?))
+
+ marionette))
+ ;; Allow services to come up on slower machines
+ (let loop ((attempts 0))
+ (if (= attempts 80)
+ (error "Service didn't come up after more than 80 seconds")
+ (if (equal? '("bridge" "host" "my-network" "none")
+ (run-test))
+ #t
+ (begin
+ (sleep 1)
+ (loop (+ 1 attempts))))))))
+
+ (test-assert "first container running"
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (wait-for-service 'first #:timeout 120)
+ #t)
+ marionette))
+
+ (test-assert "second container running"
+ (marionette-eval
+ '(begin
+ (use-modules (gnu services herd))
+ (wait-for-service 'second #:timeout 120)
+ #t)
+ marionette))
+
+ (test-assert "passing host environment variables"
+ (begin
+ (define (run-test)
+ (marionette-eval
+ `(begin
+ (use-modules (ice-9 popen)
+ (ice-9 rdelim))
+
+ (define slurp
+ (lambda args
+ (let* ((port (apply open-pipe* OPEN_READ args))
+ (output (let ((line (read-line port)))
+ (if (eof-object? line)
+ ""
+ line)))
+ (status (close-pipe port)))
+ output)))
+
+ (slurp
+ "/run/current-system/profile/bin/docker"
+ "exec" "first"
+ "/bin/guile" "-c" "(display (getenv \"VARIABLE\"))"))
+ marionette))
+ ;; Allow image to be loaded on slower machines
+ (let loop ((attempts 0))
+ (if (= attempts 180)
+ (error "Service didn't come up after more than 180 seconds")
+ (if (equal? "value"
+ (run-test))
+ #t
+ (begin
+ (sleep 1)
+ (loop (+ 1 attempts))))))))
+
+ (test-equal "mounting host files"
+ "hello"
+ (marionette-eval
+ `(begin
+ (use-modules (ice-9 popen)
+ (ice-9 rdelim))
+
+ (define slurp
+ (lambda args
+ (let* ((port (apply open-pipe* OPEN_READ args))
+ (output (let ((line (read-line port)))
+ (if (eof-object? line)
+ ""
+ line)))
+ (status (close-pipe port)))
+ output)))
+
+ (slurp
+ "/run/current-system/profile/bin/docker"
+ "exec" "second"
+ "/bin/guile" "-c" "(begin (use-modules (ice-9 popen) (ice-9 rdelim))
+(display (call-with-input-file \"/shared.txt\" read-line)))"))
+ marionette))
+
+ (test-equal "write to volumes"
+ "world"
+ (marionette-eval
+ `(begin
+ (use-modules (ice-9 popen)
+ (ice-9 rdelim))
+
+ (define slurp
+ (lambda args
+ (let* ((port (apply open-pipe* OPEN_READ args))
+ (output (let ((line (read-line port)))
+ (if (eof-object? line)
+ ""
+ line)))
+ (status (close-pipe port)))
+ output)))
+
+ (slurp
+ "/run/current-system/profile/bin/docker"
+ "exec" "first"
+ "/bin/guile" "-c" "(begin (use-modules (ice-9 popen) (ice-9 rdelim))
+(call-with-output-file \"/my-volume/out.txt\" (lambda (p) (display \"world\" p))))")
+ (slurp
+ "/run/current-system/profile/bin/docker"
+ "exec" "second"
+ "/bin/guile" "-c" "(begin (use-modules (ice-9 popen) (ice-9 rdelim))
+(display (call-with-input-file \"/my-volume/out.txt\" read-line)))"))
+ marionette))
+
+ (test-equal "can read ports over network"
+ "out of office"
+ (marionette-eval
+ `(begin
+ (use-modules (ice-9 popen)
+ (ice-9 rdelim))
+
+ (define slurp
+ (lambda args
+ (let* ((port (apply open-pipe* OPEN_READ args))
+ (output (let ((line (read-line port)))
+ (if (eof-object? line)
+ ""
+ line)))
+ (status (close-pipe port)))
+ output)))
+
+ (slurp
+ "/run/current-system/profile/bin/docker"
+ "exec" "second"
+ "/bin/guile" "-c" "(begin (use-modules (web client))
+(define-values (response out)
+ (http-get \"http://first:8080\"))
+(display out))"))
+ marionette))
+
+ (test-end))))
+
+ (gexp->derivation "docker-oci-service-test" test))
+
+(define %test-oci-service-docker
+ (system-test
+ (name "oci-service-docker")
+ (description "Test Docker backed OCI provisioning service.")
+ (value (run-docker-oci-service-test))))
--
2.48.1
guix-patches <at> gnu.org:bug#76081; Package guix-patches.
(Tue, 18 Mar 2025 17:53:09 GMT) Full text and rfc822 format available.Message #146 received at 76081 <at> debbugs.gnu.org (full text, mbox):
From: Giacomo Leidi <goodoldpaul <at> autistici.org> To: 76081 <at> debbugs.gnu.org Cc: Giacomo Leidi <goodoldpaul <at> autistici.org> Subject: [PATCH v9 5/7] tests: Use lower-oci-image-state in container tests. Date: Tue, 18 Mar 2025 18:51:10 +0100
This patch replaces boilerplate in container related tests with
oci-image plumbing from (gnu services containers).
* gnu/services/containers.scm: Export lower-oci-image-state.
* gnu/tests/containers.scm (%oci-tarball): New variable;
(run-rootless-podman-test): use %oci-tarball;
(build-tarball&run-rootless-podman-test): drop procedure.
* gnu/tests/docker.scm (%docker-tarball): New variable;
(build-tarball&run-docker-test): use %docker-tarball;
(%docker-system-tarball): New variable;
(build-tarball&run-docker-system-test): new procedure.
Change-Id: Iad6f0704aee188d89464c83722dea0bb7adb084a
---
gnu/services/containers.scm | 2 +
gnu/tests/containers.scm | 80 ++++++++++++++---------------
gnu/tests/docker.scm | 100 ++++++++++++++++++++----------------
3 files changed, 95 insertions(+), 87 deletions(-)
diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm
index d1ebfa1736c..5dac8e80f22 100644
--- a/gnu/services/containers.scm
+++ b/gnu/services/containers.scm
@@ -74,6 +74,8 @@ (define-module (gnu services containers)
oci-image-system
oci-image-grafts?
+ lower-oci-image-state
+
oci-container-configuration
oci-container-configuration?
oci-container-configuration-fields
diff --git a/gnu/tests/containers.scm b/gnu/tests/containers.scm
index 5e6f39387e7..8cdd86e7ae3 100644
--- a/gnu/tests/containers.scm
+++ b/gnu/tests/containers.scm
@@ -69,13 +69,47 @@ (define %rootless-podman-os
(supplementary-groups '("wheel" "netdev" "cgroup"
"audio" "video")))))))
-(define (run-rootless-podman-test oci-tarball)
+(define %oci-tarball
+ (lower-oci-image-state
+ "guile-guest"
+ (packages->manifest
+ (list
+ guile-3.0 guile-json-3
+ (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))))
+ '(#:entry-point "bin/guile"
+ #:localstatedir? #t
+ #:extra-options (#:image-tag "guile-guest")
+ #:symlinks (("/bin/Guile" -> "bin/guile")
+ ("aa.scm" -> "a.scm")))
+ "guile-guest"
+ (%current-target-system)
+ (%current-system)
+ #f))
+
+(define (run-rootless-podman-test)
(define os
(marionette-operating-system
(operating-system-with-gc-roots
%rootless-podman-os
- (list oci-tarball))
+ (list %oci-tarball))
#:imported-modules '((gnu services herd)
(guix combinators))))
@@ -254,7 +288,7 @@ (define (run-rootless-podman-test oci-tarball)
(let* ((loaded (slurp ,(string-append #$podman
"/bin/podman")
"load" "-i"
- ,#$oci-tarball))
+ ,#$%oci-tarball))
(repository&tag "localhost/guile-guest:latest")
(response1 (slurp
,(string-append #$podman "/bin/podman")
@@ -307,49 +341,11 @@ (define (run-rootless-podman-test oci-tarball)
(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))))
+ (value (run-rootless-podman-test))))
(define %oci-rootless-podman-os
diff --git a/gnu/tests/docker.scm b/gnu/tests/docker.scm
index 5dcf05a17e3..07edd9d5341 100644
--- a/gnu/tests/docker.scm
+++ b/gnu/tests/docker.scm
@@ -26,6 +26,7 @@ (define-module (gnu tests docker)
#:use-module (gnu system image)
#:use-module (gnu system vm)
#:use-module (gnu services)
+ #:use-module (gnu services containers)
#:use-module (gnu services dbus)
#:use-module (gnu services networking)
#:use-module (gnu services docker)
@@ -57,6 +58,40 @@ (define %docker-os
(service containerd-service-type)
(service docker-service-type)))
+(define %docker-tarball
+ (lower-oci-image-state
+ "guile-guest"
+ (packages->manifest
+ (list
+ guile-3.0 guile-json-3
+ (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))))
+ '(#:entry-point "bin/guile"
+ #:localstatedir? #t
+ #:extra-options (#:image-tag "guile-guest")
+ #:symlinks (("/bin/Guile" -> "bin/guile")
+ ("aa.scm" -> "a.scm")))
+ "guile-guest"
+ (%current-target-system)
+ (%current-system)
+ #f))
+
(define (run-docker-test docker-tarball)
"Load DOCKER-TARBALL as Docker image and run it in a Docker container,
inside %DOCKER-OS."
@@ -173,40 +208,7 @@ (define (run-docker-test docker-tarball)
(gexp->derivation "docker-test" test))
(define (build-tarball&run-docker-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"))
- #:entry-point "bin/guile"
- #:localstatedir? #t)))
- (run-docker-test tarball)))
+ (run-docker-test %docker-tarball))
(define %test-docker
(system-test
@@ -215,8 +217,22 @@ (define %test-docker
(value (build-tarball&run-docker-test))))
+(define %docker-system-tarball
+ (lower-oci-image-state
+ "guix-system-guest"
+ (operating-system
+ (inherit (simple-operating-system))
+ ;; Use locales for a single libc to
+ ;; reduce space requirements.
+ (locale-libcs (list glibc)))
+ '()
+ "guix-system-guest"
+ (%current-target-system)
+ (%current-system)
+ #f))
+
(define (run-docker-system-test tarball)
- "Load DOCKER-TARBALL as Docker image and run it in a Docker container,
+ "Load TARBALL as Docker image and run it in a Docker container,
inside %DOCKER-OS."
(define os
(marionette-operating-system
@@ -333,21 +349,15 @@ (define (run-docker-system-test tarball)
(gexp->derivation "docker-system-test" test))
+(define (build-tarball&run-docker-system-test)
+ (run-docker-system-test %docker-system-tarball))
+
(define %test-docker-system
(system-test
(name "docker-system")
(description "Run a system image as produced by @command{guix system
docker-image} inside Docker.")
- (value (with-monad %store-monad
- (>>= (lower-object
- (system-image (os->image
- (operating-system
- (inherit (simple-operating-system))
- ;; Use locales for a single libc to
- ;; reduce space requirements.
- (locale-libcs (list glibc)))
- #:type docker-image-type)))
- run-docker-system-test)))))
+ (value (build-tarball&run-docker-system-test))))
(define %oci-os
--
2.48.1
guix-patches <at> gnu.org:bug#76081; Package guix-patches.
(Tue, 18 Mar 2025 17:53:11 GMT) Full text and rfc822 format available.Message #149 received at 76081 <at> debbugs.gnu.org (full text, mbox):
From: Giacomo Leidi <goodoldpaul <at> autistici.org> To: 76081 <at> debbugs.gnu.org Cc: Giacomo Leidi <goodoldpaul <at> autistici.org> Subject: [PATCH v9 1/7] services: rootless-podman: Use login shell. Date: Tue, 18 Mar 2025 18:51:06 +0100
This commit allows for having PATH set when changing the owner of
/sys/fs/group.
* gnu/services/containers.scm (crgroups-fs-owner): Use login shell.
Change-Id: I9510c637a5332325e05ca5ebc9dfd4de32685c50
---
gnu/services/containers.scm | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm
index b3cd109ce6c..d5a211765a6 100644
--- a/gnu/services/containers.scm
+++ b/gnu/services/containers.scm
@@ -140,7 +140,7 @@ (define (cgroups-fs-owner-entrypoint config)
(rootless-podman-configuration-group-name config))
(program-file "cgroups2-fs-owner-entrypoint"
#~(system*
- (string-append #+bash-minimal "/bin/bash") "-c"
+ (string-append #+bash-minimal "/bin/bash") "-l" "-c"
(string-append "echo Setting /sys/fs/cgroup "
"group ownership to " #$group " && chown -v "
"root:" #$group " /sys/fs/cgroup && "
base-commit: 9879a7d75279762c7634f1a585794442ea2f0503
--
2.48.1
guix-patches <at> gnu.org:bug#76081; Package guix-patches.
(Tue, 18 Mar 2025 17:53:12 GMT) Full text and rfc822 format available.Message #152 received at 76081 <at> debbugs.gnu.org (full text, mbox):
From: Giacomo Leidi <goodoldpaul <at> autistici.org> To: 76081 <at> debbugs.gnu.org Cc: Giacomo Leidi <goodoldpaul <at> autistici.org> Subject: [PATCH v9 2/7] services: oci-container-configuration: Move to (gnu services containers). Date: Tue, 18 Mar 2025 18:51:07 +0100
This patch moves the oci-container-configuration and related
configuration records to (gnu services containers).
Public symbols are still exported for backwards
compatibility but since the oci-container-service-type will be
deprecated in favor of the more general oci-service-type, everything is
moved outside of the docker related module.
* gnu/services/docker.scm: Move everything related to oci-container-configuration
to...
* gnu/services/containers.scm: ...here.scm.
Change-Id: Iae599dd5cc7442eb632f0c1b3b12f6b928397ae7
---
gnu/services/containers.scm | 549 +++++++++++++++++++++++++++++++++-
gnu/services/docker.scm | 577 +++---------------------------------
2 files changed, 584 insertions(+), 542 deletions(-)
diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm
index d5a211765a6..24f31c756b8 100644
--- a/gnu/services/containers.scm
+++ b/gnu/services/containers.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2024 Giacomo Leidi <goodoldpaul <at> autistici.org>
+;;; Copyright © 2024, 2025 Giacomo Leidi <goodoldpaul <at> autistici.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -17,19 +17,31 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu services containers)
+ #:use-module (gnu image)
+ #:use-module (gnu packages admin)
#:use-module (gnu packages bash)
#:use-module (gnu packages containers)
+ #:use-module (gnu packages docker)
#: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)
#:use-module (gnu system accounts)
+ #:use-module (gnu system image)
#:use-module (gnu system shadow)
#:use-module (gnu system pam)
+ #:use-module (guix diagnostics)
#:use-module (guix gexp)
+ #:use-module (guix i18n)
+ #:use-module (guix monads)
#:use-module (guix packages)
+ #:use-module (guix profiles)
+ #:use-module ((guix scripts pack) #:prefix pack:)
+ #:use-module (guix store)
#:use-module (srfi srfi-1)
+ #:use-module (ice-9 match)
#:export (rootless-podman-configuration
rootless-podman-configuration?
rootless-podman-configuration-fields
@@ -48,7 +60,44 @@ (define-module (gnu services containers)
rootless-podman-shepherd-services
rootless-podman-service-etc
- rootless-podman-service-type))
+ rootless-podman-service-type
+
+ oci-image
+ oci-image?
+ oci-image-fields
+ oci-image-repository
+ oci-image-tag
+ oci-image-value
+ oci-image-pack-options
+ oci-image-target
+ oci-image-system
+ oci-image-grafts?
+
+ oci-container-configuration
+ oci-container-configuration?
+ oci-container-configuration-fields
+ oci-container-configuration-user
+ oci-container-configuration-group
+ oci-container-configuration-command
+ oci-container-configuration-entrypoint
+ oci-container-configuration-host-environment
+ oci-container-configuration-environment
+ oci-container-configuration-image
+ oci-container-configuration-provision
+ oci-container-configuration-requirement
+ oci-container-configuration-log-file
+ oci-container-configuration-auto-start?
+ oci-container-configuration-respawn?
+ oci-container-configuration-shepherd-actions
+ oci-container-configuration-network
+ oci-container-configuration-ports
+ oci-container-configuration-volumes
+ oci-container-configuration-container-user
+ oci-container-configuration-workdir
+ oci-container-configuration-extra-arguments
+
+ oci-container-shepherd-service
+ %oci-container-accounts))
(define (gexp-or-string? value)
(or (gexp? value)
@@ -190,7 +239,7 @@ (define (rootless-podman-cgroups-limits-service config)
rootless-podman-shared-root-fs))
(one-shot? #t)
(documentation
- "Allow setting cgroups limits: cpu, cpuset, memory and
+ "Allow setting cgroups limits: cpu, cpuset, io, memory and
pids.")
(start
#~(make-forkexec-constructor
@@ -244,3 +293,497 @@ (define rootless-podman-service-type
(default-value (rootless-podman-configuration))
(description
"This service configures rootless @code{podman} on the Guix System.")))
+
+
+;;;
+;;; OCI container.
+;;;
+
+(define (oci-sanitize-pair pair delimiter)
+ (define (valid? member)
+ (or (string? member)
+ (gexp? member)
+ (file-like? member)))
+ (match pair
+ (((? valid? key) . (? valid? value))
+ #~(string-append #$key #$delimiter #$value))
+ (_
+ (raise
+ (formatted-message
+ (G_ "pair members must contain only strings, gexps or file-like objects
+but ~a was found")
+ pair)))))
+
+(define (oci-sanitize-mixed-list name value delimiter)
+ (map
+ (lambda (el)
+ (cond ((string? el) el)
+ ((pair? el) (oci-sanitize-pair el delimiter))
+ (else
+ (raise
+ (formatted-message
+ (G_ "~a members must be either a string or a pair but ~a was
+found!")
+ name el)))))
+ value))
+
+(define (oci-sanitize-host-environment value)
+ ;; Expected spec format:
+ ;; '(("HOME" . "/home/nobody") "JAVA_HOME=/java")
+ (oci-sanitize-mixed-list "host-environment" value "="))
+
+(define (oci-sanitize-environment value)
+ ;; Expected spec format:
+ ;; '(("HOME" . "/home/nobody") "JAVA_HOME=/java")
+ (oci-sanitize-mixed-list "environment" value "="))
+
+(define (oci-sanitize-ports value)
+ ;; Expected spec format:
+ ;; '(("8088" . "80") "2022:22")
+ (oci-sanitize-mixed-list "ports" value ":"))
+
+(define (oci-sanitize-volumes value)
+ ;; Expected spec format:
+ ;; '(("/mnt/dir" . "/dir") "/run/current-system/profile:/java")
+ (oci-sanitize-mixed-list "volumes" value ":"))
+
+(define (oci-sanitize-shepherd-actions value)
+ (map
+ (lambda (el)
+ (if (shepherd-action? el)
+ el
+ (raise
+ (formatted-message
+ (G_ "shepherd-actions may only be shepherd-action records
+but ~a was found") el))))
+ value))
+
+(define (oci-sanitize-extra-arguments value)
+ (define (valid? member)
+ (or (string? member)
+ (gexp? member)
+ (file-like? member)))
+ (map
+ (lambda (el)
+ (if (valid? el)
+ el
+ (raise
+ (formatted-message
+ (G_ "extra arguments may only be strings, gexps or file-like objects
+but ~a was found") el))))
+ value))
+
+(define (oci-image-reference image)
+ (if (string? image)
+ image
+ (string-append (oci-image-repository image)
+ ":" (oci-image-tag image))))
+
+(define (oci-lowerable-image? image)
+ (or (manifest? image)
+ (operating-system? image)
+ (gexp? image)
+ (file-like? image)))
+
+(define (string-or-oci-image? image)
+ (or (string? image)
+ (oci-image? image)))
+
+(define list-of-symbols?
+ (list-of symbol?))
+
+(define-maybe/no-serialization string)
+
+(define-configuration/no-serialization oci-image
+ (repository
+ (string)
+ "A string like @code{myregistry.local:5000/testing/test-image} that names
+the OCI image.")
+ (tag
+ (string "latest")
+ "A string representing the OCI image tag. Defaults to @code{latest}.")
+ (value
+ (oci-lowerable-image)
+ "A @code{manifest} or @code{operating-system} record that will be lowered
+into an OCI compatible tarball. Otherwise this field's value can be a gexp
+or a file-like object that evaluates to an OCI compatible tarball.")
+ (pack-options
+ (list '())
+ "An optional set of keyword arguments that will be passed to the
+@code{docker-image} procedure from @code{guix scripts pack}. They can be used
+to replicate @command{guix pack} behavior:
+
+@lisp
+(oci-image
+ (repository \"guile\")
+ (tag \"3\")
+ (manifest (specifications->manifest '(\"guile\")))
+ (pack-options
+ '(#:symlinks ((\"/bin/guile\" -> \"bin/guile\"))
+ #:max-layers 2)))
+@end lisp
+
+If the @code{value} field is an @code{operating-system} record, this field's
+value will be ignored.")
+ (system
+ (maybe-string)
+ "Attempt to build for a given system, e.g. \"i686-linux\"")
+ (target
+ (maybe-string)
+ "Attempt to cross-build for a given triple, e.g. \"aarch64-linux-gnu\"")
+ (grafts?
+ (boolean #f)
+ "Whether to allow grafting or not in the pack build."))
+
+(define-configuration/no-serialization oci-container-configuration
+ (user
+ (string "oci-container")
+ "The user under whose authority docker commands will be run.")
+ (group
+ (string "docker")
+ "The group under whose authority docker commands will be run.")
+ (command
+ (list-of-strings '())
+ "Overwrite the default command (@code{CMD}) of the image.")
+ (entrypoint
+ (maybe-string)
+ "Overwrite the default entrypoint (@code{ENTRYPOINT}) of the image.")
+ (host-environment
+ (list '())
+ "Set environment variables in the host environment where @command{docker run}
+is invoked. This is especially useful to pass secrets from the host to the
+container without having them on the @command{docker run}'s command line: by
+setting the @code{MYSQL_PASSWORD} on the host and by passing
+@code{--env MYSQL_PASSWORD} through the @code{extra-arguments} field, it is
+possible to securely set values in the container environment. This field's
+value can be a list of pairs or strings, even mixed:
+
+@lisp
+(list '(\"LANGUAGE\" . \"eo:ca:eu\")
+ \"JAVA_HOME=/opt/java\")
+@end lisp
+
+Pair members can be strings, gexps or file-like objects. Strings are passed
+directly to @code{make-forkexec-constructor}."
+ (sanitizer oci-sanitize-host-environment))
+ (environment
+ (list '())
+ "Set environment variables inside the container. This can be a list of pairs
+or strings, even mixed:
+
+@lisp
+(list '(\"LANGUAGE\" . \"eo:ca:eu\")
+ \"JAVA_HOME=/opt/java\")
+@end lisp
+
+Pair members can be strings, gexps or file-like objects. Strings are passed
+directly to the Docker CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#env,upstream}
+documentation for semantics."
+ (sanitizer oci-sanitize-environment))
+ (image
+ (string-or-oci-image)
+ "The image used to build the container. It can be a string or an
+@code{oci-image} record. Strings are resolved by the Docker
+Engine, and follow the usual format
+@code{myregistry.local:5000/testing/test-image:tag}.")
+ (provision
+ (maybe-string)
+ "Set the name of the provisioned Shepherd service.")
+ (requirement
+ (list-of-symbols '())
+ "Set additional Shepherd services dependencies to the provisioned Shepherd
+service.")
+ (log-file
+ (maybe-string)
+ "When @code{log-file} is set, it names the file to which the service’s
+standard output and standard error are redirected. @code{log-file} is created
+if it does not exist, otherwise it is appended to.")
+ (auto-start?
+ (boolean #t)
+ "Whether this service should be started automatically by the Shepherd. If it
+is @code{#f} the service has to be started manually with @command{herd start}.")
+ (respawn?
+ (boolean #f)
+ "Whether to restart the service when it stops, for instance when the
+underlying process dies.")
+ (shepherd-actions
+ (list '())
+ "This is a list of @code{shepherd-action} records defining actions supported
+by the service."
+ (sanitizer oci-sanitize-shepherd-actions))
+ (network
+ (maybe-string)
+ "Set a Docker network for the spawned container.")
+ (ports
+ (list '())
+ "Set the port or port ranges to expose from the spawned container. This can
+be a list of pairs or strings, even mixed:
+
+@lisp
+(list '(\"8080\" . \"80\")
+ \"10443:443\")
+@end lisp
+
+Pair members can be strings, gexps or file-like objects. Strings are passed
+directly to the Docker CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#publish,upstream}
+documentation for semantics."
+ (sanitizer oci-sanitize-ports))
+ (volumes
+ (list '())
+ "Set volume mappings for the spawned container. This can be a
+list of pairs or strings, even mixed:
+
+@lisp
+(list '(\"/root/data/grafana\" . \"/var/lib/grafana\")
+ \"/gnu/store:/gnu/store\")
+@end lisp
+
+Pair members can be strings, gexps or file-like objects. Strings are passed
+directly to the Docker CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#volume,upstream}
+documentation for semantics."
+ (sanitizer oci-sanitize-volumes))
+ (container-user
+ (maybe-string)
+ "Set the current user inside the spawned container. You can refer to the
+@url{https://docs.docker.com/engine/reference/run/#user,upstream}
+documentation for semantics.")
+ (workdir
+ (maybe-string)
+ "Set the current working for the spawned Shepherd service.
+You can refer to the
+@url{https://docs.docker.com/engine/reference/run/#workdir,upstream}
+documentation for semantics.")
+ (extra-arguments
+ (list '())
+ "A list of strings, gexps or file-like objects that will be directly passed
+to the @command{docker run} invokation."
+ (sanitizer oci-sanitize-extra-arguments)))
+
+(define oci-container-configuration->options
+ (lambda (config)
+ (let ((entrypoint
+ (oci-container-configuration-entrypoint config))
+ (network
+ (oci-container-configuration-network config))
+ (user
+ (oci-container-configuration-container-user config))
+ (workdir
+ (oci-container-configuration-workdir config)))
+ (apply append
+ (filter (compose not unspecified?)
+ `(,(if (maybe-value-set? entrypoint)
+ `("--entrypoint" ,entrypoint)
+ '())
+ ,(append-map
+ (lambda (spec)
+ (list "--env" spec))
+ (oci-container-configuration-environment config))
+ ,(if (maybe-value-set? network)
+ `("--network" ,network)
+ '())
+ ,(if (maybe-value-set? user)
+ `("--user" ,user)
+ '())
+ ,(if (maybe-value-set? workdir)
+ `("--workdir" ,workdir)
+ '())
+ ,(append-map
+ (lambda (spec)
+ (list "-p" spec))
+ (oci-container-configuration-ports config))
+ ,(append-map
+ (lambda (spec)
+ (list "-v" spec))
+ (oci-container-configuration-volumes config))))))))
+
+(define* (get-keyword-value args keyword #:key (default #f))
+ (let ((kv (memq keyword args)))
+ (if (and kv (>= (length kv) 2))
+ (cadr kv)
+ default)))
+
+(define (lower-operating-system os target system)
+ (mlet* %store-monad
+ ((tarball
+ (lower-object
+ (system-image (os->image os #:type docker-image-type))
+ system
+ #:target target)))
+ (return tarball)))
+
+(define (lower-manifest name image target system)
+ (define value (oci-image-value image))
+ (define options (oci-image-pack-options image))
+ (define image-reference
+ (oci-image-reference image))
+ (define image-tag
+ (let* ((extra-options
+ (get-keyword-value options #:extra-options))
+ (image-tag-option
+ (and extra-options
+ (get-keyword-value extra-options #:image-tag))))
+ (if image-tag-option
+ '()
+ `(#:extra-options (#:image-tag ,image-reference)))))
+
+ (mlet* %store-monad
+ ((_ (set-grafting
+ (oci-image-grafts? image)))
+ (guile (set-guile-for-build (default-guile)))
+ (profile
+ (profile-derivation value
+ #:target target
+ #:system system
+ #:hooks '()
+ #:locales? #f))
+ (tarball (apply pack:docker-image
+ `(,name ,profile
+ ,@options
+ ,@image-tag
+ #:localstatedir? #t))))
+ (return tarball)))
+
+(define (lower-oci-image name image)
+ (define value (oci-image-value image))
+ (define image-target (oci-image-target image))
+ (define image-system (oci-image-system image))
+ (define target
+ (if (maybe-value-set? image-target)
+ image-target
+ (%current-target-system)))
+ (define system
+ (if (maybe-value-set? image-system)
+ image-system
+ (%current-system)))
+ (with-store store
+ (run-with-store store
+ (match value
+ ((? manifest? value)
+ (lower-manifest name image target system))
+ ((? operating-system? value)
+ (lower-operating-system value target system))
+ ((or (? gexp? value)
+ (? file-like? value))
+ value)
+ (_
+ (raise
+ (formatted-message
+ (G_ "oci-image value must contain only manifest,
+operating-system, gexp or file-like records but ~a was found")
+ value))))
+ #:target target
+ #:system system)))
+
+(define (%oci-image-loader name image tag)
+ (let ((docker (file-append docker-cli "/bin/docker"))
+ (tarball (lower-oci-image name image)))
+ (with-imported-modules '((guix build utils))
+ (program-file (format #f "~a-image-loader" name)
+ #~(begin
+ (use-modules (guix build utils)
+ (ice-9 popen)
+ (ice-9 rdelim))
+
+ (format #t "Loading image for ~a from ~a...~%" #$name #$tarball)
+ (define line
+ (read-line
+ (open-input-pipe
+ (string-append #$docker " load -i " #$tarball))))
+
+ (unless (or (eof-object? line)
+ (string-null? line))
+ (format #t "~a~%" line)
+ (let ((repository&tag
+ (string-drop line
+ (string-length
+ "Loaded image: "))))
+
+ (invoke #$docker "tag" repository&tag #$tag)
+ (format #t "Tagged ~a with ~a...~%" #$tarball #$tag))))))))
+
+(define (oci-container-shepherd-service config)
+ (define (guess-name name image)
+ (if (maybe-value-set? name)
+ name
+ (string-append "docker-"
+ (basename
+ (if (string? image)
+ (first (string-split image #\:))
+ (oci-image-repository image))))))
+
+ (let* ((docker (file-append docker-cli "/bin/docker"))
+ (actions (oci-container-configuration-shepherd-actions config))
+ (auto-start?
+ (oci-container-configuration-auto-start? config))
+ (user (oci-container-configuration-user config))
+ (group (oci-container-configuration-group config))
+ (host-environment
+ (oci-container-configuration-host-environment config))
+ (command (oci-container-configuration-command config))
+ (log-file (oci-container-configuration-log-file config))
+ (provision (oci-container-configuration-provision config))
+ (requirement (oci-container-configuration-requirement config))
+ (respawn?
+ (oci-container-configuration-respawn? config))
+ (image (oci-container-configuration-image config))
+ (image-reference (oci-image-reference image))
+ (options (oci-container-configuration->options config))
+ (name (guess-name provision image))
+ (extra-arguments
+ (oci-container-configuration-extra-arguments config)))
+
+ (shepherd-service (provision `(,(string->symbol name)))
+ (requirement `(dockerd user-processes ,@requirement))
+ (respawn? respawn?)
+ (auto-start? auto-start?)
+ (documentation
+ (string-append
+ "Docker backed Shepherd service for "
+ (if (oci-image? image) name image) "."))
+ (start
+ #~(lambda ()
+ #$@(if (oci-image? image)
+ #~((invoke #$(%oci-image-loader
+ name image image-reference)))
+ #~())
+ (fork+exec-command
+ ;; docker run [OPTIONS] IMAGE [COMMAND] [ARG...]
+ (list #$docker "run" "--rm" "--name" #$name
+ #$@options #$@extra-arguments
+ #$image-reference #$@command)
+ #:user #$user
+ #:group #$group
+ #$@(if (maybe-value-set? log-file)
+ (list #:log-file log-file)
+ '())
+ #:environment-variables
+ (list #$@host-environment))))
+ (stop
+ #~(lambda _
+ (invoke #$docker "rm" "-f" #$name)))
+ (actions
+ (if (oci-image? image)
+ '()
+ (append
+ (list
+ (shepherd-action
+ (name 'pull)
+ (documentation
+ (format #f "Pull ~a's image (~a)."
+ name image))
+ (procedure
+ #~(lambda _
+ (invoke #$docker "pull" #$image)))))
+ actions))))))
+
+(define %oci-container-accounts
+ (list (user-account
+ (name "oci-container")
+ (comment "OCI services account")
+ (group "docker")
+ (system? #t)
+ (home-directory "/var/empty")
+ (shell (file-append shadow "/sbin/nologin")))))
diff --git a/gnu/services/docker.scm b/gnu/services/docker.scm
index 9ab3e583345..828ceea313a 100644
--- a/gnu/services/docker.scm
+++ b/gnu/services/docker.scm
@@ -5,7 +5,7 @@
;;; Copyright © 2020 Efraim Flashner <efraim <at> flashner.co.il>
;;; Copyright © 2020 Jesse Dowell <jessedowell <at> gmail.com>
;;; Copyright © 2021 Brice Waegeneire <brice <at> waegenei.re>
-;;; Copyright © 2023, 2024 Giacomo Leidi <goodoldpaul <at> autistici.org>
+;;; Copyright © 2023, 2024, 2025 Giacomo Leidi <goodoldpaul <at> autistici.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -23,72 +23,60 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu services docker)
- #:use-module (gnu image)
#:use-module (gnu services)
#:use-module (gnu services configuration)
- #:use-module (gnu services base)
- #:use-module (gnu services dbus)
+ #:use-module (gnu services containers)
#:use-module (gnu services shepherd)
- #:use-module (gnu system)
- #:use-module (gnu system image)
#:use-module (gnu system privilege)
#:use-module (gnu system shadow)
- #:use-module (gnu packages admin) ;shadow
#:use-module (gnu packages docker)
#:use-module (gnu packages linux) ;singularity
- #:use-module (guix records)
- #:use-module (guix diagnostics)
#:use-module (guix gexp)
- #:use-module (guix i18n)
- #:use-module (guix monads)
- #:use-module (guix packages)
- #:use-module (guix profiles)
- #:use-module ((guix scripts pack) #:prefix pack:)
- #:use-module (guix store)
+ #:use-module (guix records)
#:use-module (srfi srfi-1)
#:use-module (ice-9 format)
#:use-module (ice-9 match)
+ #:re-export (oci-image ;for backwards compatibility, until the
+ oci-image? ;oci-container-service-type is fully deprecated
+ oci-image-fields
+ oci-image-repository
+ oci-image-tag
+ oci-image-value
+ oci-image-pack-options
+ oci-image-target
+ oci-image-system
+ oci-image-grafts?
+ oci-container-configuration
+ oci-container-configuration?
+ oci-container-configuration-fields
+ oci-container-configuration-user
+ oci-container-configuration-group
+ oci-container-configuration-command
+ oci-container-configuration-entrypoint
+ oci-container-configuration-host-environment
+ oci-container-configuration-environment
+ oci-container-configuration-image
+ oci-container-configuration-provision
+ oci-container-configuration-requirement
+ oci-container-configuration-log-file
+ oci-container-configuration-auto-start?
+ oci-container-configuration-respawn?
+ oci-container-configuration-shepherd-actions
+ oci-container-configuration-network
+ oci-container-configuration-ports
+ oci-container-configuration-volumes
+ oci-container-configuration-container-user
+ oci-container-configuration-workdir
+ oci-container-configuration-extra-arguments
+ oci-container-shepherd-service
+ %oci-container-accounts)
#:export (containerd-configuration
containerd-service-type
docker-configuration
docker-service-type
singularity-service-type
- oci-image
- oci-image?
- oci-image-fields
- oci-image-repository
- oci-image-tag
- oci-image-value
- oci-image-pack-options
- oci-image-target
- oci-image-system
- oci-image-grafts?
- oci-container-configuration
- oci-container-configuration?
- oci-container-configuration-fields
- oci-container-configuration-user
- oci-container-configuration-group
- oci-container-configuration-command
- oci-container-configuration-entrypoint
- oci-container-configuration-host-environment
- oci-container-configuration-environment
- oci-container-configuration-image
- oci-container-configuration-provision
- oci-container-configuration-requirement
- oci-container-configuration-log-file
- oci-container-configuration-auto-start?
- oci-container-configuration-respawn?
- oci-container-configuration-shepherd-actions
- oci-container-configuration-network
- oci-container-configuration-ports
- oci-container-configuration-volumes
- oci-container-configuration-container-user
- oci-container-configuration-workdir
- oci-container-configuration-extra-arguments
- oci-container-service-type
- oci-container-shepherd-service
- %oci-container-accounts))
+ oci-container-service-type))
(define-maybe file-like)
@@ -309,495 +297,6 @@ (define singularity-service-type
;;; OCI container.
;;;
-(define (oci-sanitize-pair pair delimiter)
- (define (valid? member)
- (or (string? member)
- (gexp? member)
- (file-like? member)))
- (match pair
- (((? valid? key) . (? valid? value))
- #~(string-append #$key #$delimiter #$value))
- (_
- (raise
- (formatted-message
- (G_ "pair members must contain only strings, gexps or file-like objects
-but ~a was found")
- pair)))))
-
-(define (oci-sanitize-mixed-list name value delimiter)
- (map
- (lambda (el)
- (cond ((string? el) el)
- ((pair? el) (oci-sanitize-pair el delimiter))
- (else
- (raise
- (formatted-message
- (G_ "~a members must be either a string or a pair but ~a was
-found!")
- name el)))))
- value))
-
-(define (oci-sanitize-host-environment value)
- ;; Expected spec format:
- ;; '(("HOME" . "/home/nobody") "JAVA_HOME=/java")
- (oci-sanitize-mixed-list "host-environment" value "="))
-
-(define (oci-sanitize-environment value)
- ;; Expected spec format:
- ;; '(("HOME" . "/home/nobody") "JAVA_HOME=/java")
- (oci-sanitize-mixed-list "environment" value "="))
-
-(define (oci-sanitize-ports value)
- ;; Expected spec format:
- ;; '(("8088" . "80") "2022:22")
- (oci-sanitize-mixed-list "ports" value ":"))
-
-(define (oci-sanitize-volumes value)
- ;; Expected spec format:
- ;; '(("/mnt/dir" . "/dir") "/run/current-system/profile:/java")
- (oci-sanitize-mixed-list "volumes" value ":"))
-
-(define (oci-sanitize-shepherd-actions value)
- (map
- (lambda (el)
- (if (shepherd-action? el)
- el
- (raise
- (formatted-message
- (G_ "shepherd-actions may only be shepherd-action records
-but ~a was found") el))))
- value))
-
-(define (oci-sanitize-extra-arguments value)
- (define (valid? member)
- (or (string? member)
- (gexp? member)
- (file-like? member)))
- (map
- (lambda (el)
- (if (valid? el)
- el
- (raise
- (formatted-message
- (G_ "extra arguments may only be strings, gexps or file-like objects
-but ~a was found") el))))
- value))
-
-(define (oci-image-reference image)
- (if (string? image)
- image
- (string-append (oci-image-repository image)
- ":" (oci-image-tag image))))
-
-(define (oci-lowerable-image? image)
- (or (manifest? image)
- (operating-system? image)
- (gexp? image)
- (file-like? image)))
-
-(define (string-or-oci-image? image)
- (or (string? image)
- (oci-image? image)))
-
-(define list-of-symbols?
- (list-of symbol?))
-
-(define-maybe/no-serialization string)
-
-(define-configuration/no-serialization oci-image
- (repository
- (string)
- "A string like @code{myregistry.local:5000/testing/test-image} that names
-the OCI image.")
- (tag
- (string "latest")
- "A string representing the OCI image tag. Defaults to @code{latest}.")
- (value
- (oci-lowerable-image)
- "A @code{manifest} or @code{operating-system} record that will be lowered
-into an OCI compatible tarball. Otherwise this field's value can be a gexp
-or a file-like object that evaluates to an OCI compatible tarball.")
- (pack-options
- (list '())
- "An optional set of keyword arguments that will be passed to the
-@code{docker-image} procedure from @code{guix scripts pack}. They can be used
-to replicate @command{guix pack} behavior:
-
-@lisp
-(oci-image
- (repository \"guile\")
- (tag \"3\")
- (manifest (specifications->manifest '(\"guile\")))
- (pack-options
- '(#:symlinks ((\"/bin/guile\" -> \"bin/guile\"))
- #:max-layers 2)))
-@end lisp
-
-If the @code{value} field is an @code{operating-system} record, this field's
-value will be ignored.")
- (system
- (maybe-string)
- "Attempt to build for a given system, e.g. \"i686-linux\"")
- (target
- (maybe-string)
- "Attempt to cross-build for a given triple, e.g. \"aarch64-linux-gnu\"")
- (grafts?
- (boolean #f)
- "Whether to allow grafting or not in the pack build."))
-
-(define-configuration/no-serialization oci-container-configuration
- (user
- (string "oci-container")
- "The user under whose authority docker commands will be run.")
- (group
- (string "docker")
- "The group under whose authority docker commands will be run.")
- (command
- (list-of-strings '())
- "Overwrite the default command (@code{CMD}) of the image.")
- (entrypoint
- (maybe-string)
- "Overwrite the default entrypoint (@code{ENTRYPOINT}) of the image.")
- (host-environment
- (list '())
- "Set environment variables in the host environment where @command{docker run}
-is invoked. This is especially useful to pass secrets from the host to the
-container without having them on the @command{docker run}'s command line: by
-setting the @code{MYSQL_PASSWORD} on the host and by passing
-@code{--env MYSQL_PASSWORD} through the @code{extra-arguments} field, it is
-possible to securely set values in the container environment. This field's
-value can be a list of pairs or strings, even mixed:
-
-@lisp
-(list '(\"LANGUAGE\" . \"eo:ca:eu\")
- \"JAVA_HOME=/opt/java\")
-@end lisp
-
-Pair members can be strings, gexps or file-like objects. Strings are passed
-directly to @code{make-forkexec-constructor}."
- (sanitizer oci-sanitize-host-environment))
- (environment
- (list '())
- "Set environment variables inside the container. This can be a list of pairs
-or strings, even mixed:
-
-@lisp
-(list '(\"LANGUAGE\" . \"eo:ca:eu\")
- \"JAVA_HOME=/opt/java\")
-@end lisp
-
-Pair members can be strings, gexps or file-like objects. Strings are passed
-directly to the Docker CLI. You can refer to the
-@url{https://docs.docker.com/engine/reference/commandline/run/#env,upstream}
-documentation for semantics."
- (sanitizer oci-sanitize-environment))
- (image
- (string-or-oci-image)
- "The image used to build the container. It can be a string or an
-@code{oci-image} record. Strings are resolved by the Docker
-Engine, and follow the usual format
-@code{myregistry.local:5000/testing/test-image:tag}.")
- (provision
- (maybe-string)
- "Set the name of the provisioned Shepherd service.")
- (requirement
- (list-of-symbols '())
- "Set additional Shepherd services dependencies to the provisioned Shepherd
-service.")
- (log-file
- (maybe-string)
- "When @code{log-file} is set, it names the file to which the service’s
-standard output and standard error are redirected. @code{log-file} is created
-if it does not exist, otherwise it is appended to.")
- (auto-start?
- (boolean #t)
- "Whether this service should be started automatically by the Shepherd. If it
-is @code{#f} the service has to be started manually with @command{herd start}.")
- (respawn?
- (boolean #f)
- "Whether to restart the service when it stops, for instance when the
-underlying process dies.")
- (shepherd-actions
- (list '())
- "This is a list of @code{shepherd-action} records defining actions supported
-by the service."
- (sanitizer oci-sanitize-shepherd-actions))
- (network
- (maybe-string)
- "Set a Docker network for the spawned container.")
- (ports
- (list '())
- "Set the port or port ranges to expose from the spawned container. This can
-be a list of pairs or strings, even mixed:
-
-@lisp
-(list '(\"8080\" . \"80\")
- \"10443:443\")
-@end lisp
-
-Pair members can be strings, gexps or file-like objects. Strings are passed
-directly to the Docker CLI. You can refer to the
-@url{https://docs.docker.com/engine/reference/commandline/run/#publish,upstream}
-documentation for semantics."
- (sanitizer oci-sanitize-ports))
- (volumes
- (list '())
- "Set volume mappings for the spawned container. This can be a
-list of pairs or strings, even mixed:
-
-@lisp
-(list '(\"/root/data/grafana\" . \"/var/lib/grafana\")
- \"/gnu/store:/gnu/store\")
-@end lisp
-
-Pair members can be strings, gexps or file-like objects. Strings are passed
-directly to the Docker CLI. You can refer to the
-@url{https://docs.docker.com/engine/reference/commandline/run/#volume,upstream}
-documentation for semantics."
- (sanitizer oci-sanitize-volumes))
- (container-user
- (maybe-string)
- "Set the current user inside the spawned container. You can refer to the
-@url{https://docs.docker.com/engine/reference/run/#user,upstream}
-documentation for semantics.")
- (workdir
- (maybe-string)
- "Set the current working for the spawned Shepherd service.
-You can refer to the
-@url{https://docs.docker.com/engine/reference/run/#workdir,upstream}
-documentation for semantics.")
- (extra-arguments
- (list '())
- "A list of strings, gexps or file-like objects that will be directly passed
-to the @command{docker run} invocation."
- (sanitizer oci-sanitize-extra-arguments)))
-
-(define oci-container-configuration->options
- (lambda (config)
- (let ((entrypoint
- (oci-container-configuration-entrypoint config))
- (network
- (oci-container-configuration-network config))
- (user
- (oci-container-configuration-container-user config))
- (workdir
- (oci-container-configuration-workdir config)))
- (apply append
- (filter (compose not unspecified?)
- `(,(if (maybe-value-set? entrypoint)
- `("--entrypoint" ,entrypoint)
- '())
- ,(append-map
- (lambda (spec)
- (list "--env" spec))
- (oci-container-configuration-environment config))
- ,(if (maybe-value-set? network)
- `("--network" ,network)
- '())
- ,(if (maybe-value-set? user)
- `("--user" ,user)
- '())
- ,(if (maybe-value-set? workdir)
- `("--workdir" ,workdir)
- '())
- ,(append-map
- (lambda (spec)
- (list "-p" spec))
- (oci-container-configuration-ports config))
- ,(append-map
- (lambda (spec)
- (list "-v" spec))
- (oci-container-configuration-volumes config))))))))
-
-(define* (get-keyword-value args keyword #:key (default #f))
- (let ((kv (memq keyword args)))
- (if (and kv (>= (length kv) 2))
- (cadr kv)
- default)))
-
-(define (lower-operating-system os target system)
- (mlet* %store-monad
- ((tarball
- (lower-object
- (system-image (os->image os #:type docker-image-type))
- system
- #:target target)))
- (return tarball)))
-
-(define (lower-manifest name image target system)
- (define value (oci-image-value image))
- (define options (oci-image-pack-options image))
- (define image-reference
- (oci-image-reference image))
- (define image-tag
- (let* ((extra-options
- (get-keyword-value options #:extra-options))
- (image-tag-option
- (and extra-options
- (get-keyword-value extra-options #:image-tag))))
- (if image-tag-option
- '()
- `(#:extra-options (#:image-tag ,image-reference)))))
-
- (mlet* %store-monad
- ((_ (set-grafting
- (oci-image-grafts? image)))
- (guile (set-guile-for-build (default-guile)))
- (profile
- (profile-derivation value
- #:target target
- #:system system
- #:hooks '()
- #:locales? #f))
- (tarball (apply pack:docker-image
- `(,name ,profile
- ,@options
- ,@image-tag
- #:localstatedir? #t))))
- (return tarball)))
-
-(define (lower-oci-image name image)
- (define value (oci-image-value image))
- (define image-target (oci-image-target image))
- (define image-system (oci-image-system image))
- (define target
- (if (maybe-value-set? image-target)
- image-target
- (%current-target-system)))
- (define system
- (if (maybe-value-set? image-system)
- image-system
- (%current-system)))
- (with-store store
- (run-with-store store
- (match value
- ((? manifest? value)
- (lower-manifest name image target system))
- ((? operating-system? value)
- (lower-operating-system value target system))
- ((or (? gexp? value)
- (? file-like? value))
- value)
- (_
- (raise
- (formatted-message
- (G_ "oci-image value must contain only manifest,
-operating-system, gexp or file-like records but ~a was found")
- value))))
- #:target target
- #:system system)))
-
-(define (%oci-image-loader name image tag)
- (let ((docker (file-append docker-cli "/bin/docker"))
- (tarball (lower-oci-image name image)))
- (with-imported-modules '((guix build utils))
- (program-file (format #f "~a-image-loader" name)
- #~(begin
- (use-modules (guix build utils)
- (ice-9 popen)
- (ice-9 rdelim))
-
- (format #t "Loading image for ~a from ~a...~%" #$name #$tarball)
- (define line
- (read-line
- (open-input-pipe
- (string-append #$docker " load -i " #$tarball))))
-
- (unless (or (eof-object? line)
- (string-null? line))
- (format #t "~a~%" line)
- (let ((repository&tag
- (string-drop line
- (string-length
- "Loaded image: "))))
-
- (invoke #$docker "tag" repository&tag #$tag)
- (format #t "Tagged ~a with ~a...~%" #$tarball #$tag))))))))
-
-(define (oci-container-shepherd-service config)
- (define (guess-name name image)
- (if (maybe-value-set? name)
- name
- (string-append "docker-"
- (basename
- (if (string? image)
- (first (string-split image #\:))
- (oci-image-repository image))))))
-
- (let* ((docker (file-append docker-cli "/bin/docker"))
- (actions (oci-container-configuration-shepherd-actions config))
- (auto-start?
- (oci-container-configuration-auto-start? config))
- (user (oci-container-configuration-user config))
- (group (oci-container-configuration-group config))
- (host-environment
- (oci-container-configuration-host-environment config))
- (command (oci-container-configuration-command config))
- (log-file (oci-container-configuration-log-file config))
- (provision (oci-container-configuration-provision config))
- (requirement (oci-container-configuration-requirement config))
- (respawn?
- (oci-container-configuration-respawn? config))
- (image (oci-container-configuration-image config))
- (image-reference (oci-image-reference image))
- (options (oci-container-configuration->options config))
- (name (guess-name provision image))
- (extra-arguments
- (oci-container-configuration-extra-arguments config)))
-
- (shepherd-service (provision `(,(string->symbol name)))
- (requirement `(dockerd user-processes ,@requirement))
- (respawn? respawn?)
- (auto-start? auto-start?)
- (documentation
- (string-append
- "Docker backed Shepherd service for "
- (if (oci-image? image) name image) "."))
- (start
- #~(lambda ()
- #$@(if (oci-image? image)
- #~((invoke #$(%oci-image-loader
- name image image-reference)))
- #~())
- (fork+exec-command
- ;; docker run [OPTIONS] IMAGE [COMMAND] [ARG...]
- (list #$docker "run" "--rm" "--name" #$name
- #$@options #$@extra-arguments
- #$image-reference #$@command)
- #:user #$user
- #:group #$group
- #$@(if (maybe-value-set? log-file)
- (list #:log-file log-file)
- '())
- #:environment-variables
- (list #$@host-environment))))
- (stop
- #~(lambda _
- (invoke #$docker "rm" "-f" #$name)))
- (actions
- (if (oci-image? image)
- '()
- (append
- (list
- (shepherd-action
- (name 'pull)
- (documentation
- (format #f "Pull ~a's image (~a)."
- name image))
- (procedure
- #~(lambda _
- (invoke #$docker "pull" #$image)))))
- actions))))))
-
-(define %oci-container-accounts
- (list (user-account
- (name "oci-container")
- (comment "OCI services account")
- (group "docker")
- (system? #t)
- (home-directory "/var/empty")
- (shell (file-append shadow "/sbin/nologin")))))
-
(define (configs->shepherd-services configs)
(map oci-container-shepherd-service configs))
--
2.48.1
andrew <at> trop.in, janneke <at> gnu.org, ludo <at> gnu.org, maxim.cournoyer <at> gmail.com, tanguy <at> bioneland.org, guix-patches <at> gnu.org:bug#76081; Package guix-patches.
(Tue, 18 Mar 2025 17:53:12 GMT) Full text and rfc822 format available.Message #155 received at 76081 <at> debbugs.gnu.org (full text, mbox):
From: Giacomo Leidi <goodoldpaul <at> autistici.org> To: 76081 <at> debbugs.gnu.org Cc: Giacomo Leidi <goodoldpaul <at> autistici.org> Subject: [PATCH v9 7/7] home: Add home-oci-service-type. Date: Tue, 18 Mar 2025 18:51:12 +0100
* gnu/home/service/containers.scm: New file;
* gnu/local.mk (GNU_SYSTEM_MODULES): Add it.
* doc/guix.texi (OCI backed services): Document it.
Change-Id: I8ce5b301e8032d0a7b2a9ca46752738cdee1f030
---
doc/guix.texi | 114 +++++++++++++++++++++++++++++++
gnu/home/services/containers.scm | 50 ++++++++++++++
gnu/local.mk | 1 +
3 files changed, 165 insertions(+)
create mode 100644 gnu/home/services/containers.scm
diff --git a/doc/guix.texi b/doc/guix.texi
index 521ea28dd5a..8f3017c2f69 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -50478,6 +50478,120 @@ Miscellaneous Home Services
(dicod-configuration @dots{})))
@end lisp
+@subsubheading OCI backed services
+
+@cindex OCI-backed, for Home
+The @code{(gnu home services containers)} module provides the following service:
+
+@defvar home-oci-service-type
+This is the type of the service that allows to manage your OCI containers with
+the same consistent interface you use for your other Home Shepherd services.
+@end defvar
+
+This service is a direct mapping of the @code{oci-service-type} system
+service (@pxref{Miscellaneous Services, OCI backed services}). You can
+use it like this:
+
+@lisp
+(use-modules (gnu services containers)
+ (gnu home services containers))
+
+(simple-service 'home-oci-provisioning
+ home-oci-service-type
+ (oci-extension
+ (volumes
+ (list
+ (oci-volume-configuration (name "prometheus"))
+ (oci-volume-configuration (name "grafana"))))
+ (networks
+ (list
+ (oci-network-configuration (name "monitoring"))))
+ (containers
+ (list
+ (oci-container-configuration
+ (network "monitoring")
+ (image
+ (oci-image
+ (repository "guile")
+ (tag "3")
+ (value (specifications->manifest '("guile")))
+ (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile"))
+ #:max-layers 2))))
+ (entrypoint "/bin/guile")
+ (command
+ '("-c" "(display \"hello!\n\")")))
+ (oci-container-configuration
+ (image "prom/prometheus")
+ (network "monitoring")
+ (ports
+ '(("9000" . "9000")
+ ("9090" . "9090")))
+ (volumes
+ (list
+ '(("prometheus" . "/var/lib/prometheus")))))
+ (oci-container-configuration
+ (image "grafana/grafana:10.0.1")
+ (network "monitoring")
+ (volumes
+ '(("grafana:/var/lib/grafana"))))))))
+
+@end lisp
+
+You may specify a custom configuration by providing a
+@code{oci-configuration} record, exactly like for
+@code{oci-service-type}, but wrapping it in @code{for-home}:
+
+@lisp
+(use-modules (gnu services)
+ (gnu services containers)
+ (gnu home services containers))
+
+(service home-oci-service-type
+ (for-home
+ (oci-configuration
+ (runtime 'podman)
+ (verbose? #t))))
+
+(simple-service 'home-oci-provisioning
+ home-oci-service-type
+ (oci-extension
+ (volumes
+ (list
+ (oci-volume-configuration (name "prometheus"))
+ (oci-volume-configuration (name "grafana"))))
+ (networks
+ (list
+ (oci-network-configuration (name "monitoring"))))
+ (containers
+ (list
+ (oci-container-configuration
+ (network "monitoring")
+ (image
+ (oci-image
+ (repository "guile")
+ (tag "3")
+ (value (specifications->manifest '("guile")))
+ (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile"))
+ #:max-layers 2))))
+ (entrypoint "/bin/guile")
+ (command
+ '("-c" "(display \"hello!\n\")")))
+ (oci-container-configuration
+ (image "prom/prometheus")
+ (network "monitoring")
+ (ports
+ '(("9000" . "9000")
+ ("9090" . "9090")))
+ (volumes
+ (list
+ '(("prometheus" . "/var/lib/prometheus")))))
+ (oci-container-configuration
+ (image "grafana/grafana:10.0.1")
+ (network "monitoring")
+ (volumes
+ '(("grafana:/var/lib/grafana"))))))))
+@end lisp
+
@node Invoking guix home
@section Invoking @command{guix home}
diff --git a/gnu/home/services/containers.scm b/gnu/home/services/containers.scm
new file mode 100644
index 00000000000..938dde2f37a
--- /dev/null
+++ b/gnu/home/services/containers.scm
@@ -0,0 +1,50 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2025 Giacomo Leidi <goodoldpaul <at> 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 home services containers)
+ #:use-module (gnu home services)
+ #:use-module (gnu home services shepherd)
+ #:use-module (gnu services)
+ #:use-module (gnu services configuration)
+ #:use-module (gnu services containers)
+ #:use-module (guix gexp)
+ #:use-module (guix packages)
+ #:use-module (srfi srfi-1)
+ #:export (home-oci-service-type))
+
+(define home-oci-service-type
+ (service-type (inherit (system->home-service-type oci-service-type))
+ (extensions
+ (list
+ (service-extension home-profile-service-type
+ (oci-service-extension-wrap-validate
+ (lambda (config)
+ (let ((runtime-cli
+ (oci-configuration-runtime-cli config))
+ (runtime
+ (oci-configuration-runtime config)))
+ (oci-service-profile runtime runtime-cli)))))
+ (service-extension home-shepherd-service-type
+ (oci-service-extension-wrap-validate
+ oci-configuration->shepherd-services))))
+ (extend
+ (lambda (config extension)
+ (for-home
+ (oci-configuration
+ (inherit (oci-configuration-extend config extension))))))
+ (default-value (for-home (oci-configuration)))))
diff --git a/gnu/local.mk b/gnu/local.mk
index 01d13a11ae8..0f6502d979b 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -103,6 +103,7 @@ GNU_SYSTEM_MODULES = \
%D%/home.scm \
%D%/home/services.scm \
%D%/home/services/admin.scm \
+ %D%/home/services/containers.scm \
%D%/home/services/desktop.scm \
%D%/home/services/dict.scm \
%D%/home/services/dotfiles.scm \
--
2.48.1
guix-patches <at> gnu.org:bug#76081; Package guix-patches.
(Tue, 18 Mar 2025 17:53:13 GMT) Full text and rfc822 format available.Message #158 received at 76081 <at> debbugs.gnu.org (full text, mbox):
From: Giacomo Leidi <goodoldpaul <at> autistici.org> To: 76081 <at> debbugs.gnu.org Cc: Giacomo Leidi <goodoldpaul <at> autistici.org> Subject: [PATCH v9 6/7] services: oci: Migrate oci-configuration to (guix records). Date: Tue, 18 Mar 2025 18:51:11 +0100
This commit migrates oci-configuration to (guix records) singe it
appears (for-home (oci-configuration ...)) does not work as expected
with (gnu services configuration). This is supposed to be completely
transparent for users and can be reverted in the
future once this has been implemented.
* gnu/service/containers.scm: Migrate oci-configuration to (guix records).
---
gnu/services/containers.scm | 199 +++++++++++++++++++++---------------
1 file changed, 117 insertions(+), 82 deletions(-)
diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm
index 5dac8e80f22..7a44e1c0f7c 100644
--- a/gnu/services/containers.scm
+++ b/gnu/services/containers.scm
@@ -39,6 +39,7 @@ (define-module (gnu services containers)
#:use-module (guix packages)
#:use-module (guix profiles)
#:use-module ((guix scripts pack) #:prefix pack:)
+ #:use-module (guix records)
#:use-module (guix store)
#:use-module (srfi srfi-1)
#:use-module (ice-9 format)
@@ -164,6 +165,7 @@ (define-module (gnu services containers)
oci-container-shepherd-service
oci-objects-merge-lst
oci-extension-merge
+ oci-service-extension-wrap-validate
oci-service-type
oci-service-accounts
oci-service-profile
@@ -391,7 +393,7 @@ (define (oci-runtime-name runtime)
(define (oci-runtime-group runtime maybe-group)
"Implement the logic behind selection of the group that is to be used by
Shepherd to execute OCI commands."
- (if (not (maybe-value-set? maybe-group))
+ (if (eq? maybe-group #f)
(if (eq? 'podman runtime)
"cgroup"
"docker")
@@ -762,62 +764,74 @@ (define (list-of-oci-networks? value)
(define (package-or-string? value)
(or (package? value) (string? value)))
-(define-maybe/no-serialization package-or-string)
-
-(define-configuration/no-serialization oci-configuration
- (runtime
- (symbol 'docker)
- "The OCI runtime to use to run commands. It can be either @code{'docker} or
-@code{'podman}."
- (sanitizer oci-sanitize-runtime))
- (runtime-cli
- (maybe-package-or-string)
- "The OCI runtime command line to be installed in the system profile and used
-to provision OCI resources, it can be either a package or a string representing
-an absolute path to the runtime binary entrypoint. When unset it will default
-to @code{docker-cli} package for the @code{'docker} runtime or to @code{podman}
-package for the @code{'podman} runtime.")
- (runtime-extra-arguments
- (list '())
- "A list of strings, gexps or file-like objects that will be placed
-after each @command{docker} or @command{podman} invokation.")
- (user
- (string "oci-container")
- "The user name under whose authority OCI runtime commands will be run.")
- (group
- (maybe-string)
- "The group name under whose authority OCI commands will be run. When
-using the @code{'podman} OCI runtime, this field will be ignored and the
-default group of the user configured in the @code{user} field will be used.")
- (subuids-range
- (maybe-subid-range)
- "An optional @code{subid-range} record allocating subuids for the user from
-the @code{user} field. When unset, with the rootless Podman OCI runtime, it
-defaults to @code{(subid-range (name \"oci-container\"))}.")
- (subgids-range
- (maybe-subid-range)
- "An optional @code{subid-range} record allocating subgids for the user from
-the @code{user} field. When unset, with the rootless Podman OCI runtime, it
-defaults to @code{(subid-range (name \"oci-container\"))}.")
- (containers
- (list-of-oci-containers '())
- "The list of @code{oci-container-configuration} records representing the
-containers to provision. Most users are supposed not to use this field and use
-the @code{oci-extension} record instead.")
- (networks
- (list-of-oci-networks '())
- "The list of @code{oci-network-configuration} records representing the
-networks to provision. Most users are supposed not to use this field and use
-the @code{oci-extension} record instead.")
- (volumes
- (list-of-oci-volumes '())
- "The list of @code{oci-volume-configuration} records representing the
-volumes to provision. Most users are supposed not to use this field and use
-the @code{oci-extension} record instead.")
- (verbose?
- (boolean #f)
- "When true, additional output will be printed, allowing to better follow the
-flow of execution."))
+;; (for-home (oci-configuration ...)) is not able to replace for-home? with #t,
+;; pk prints #f. Once for-home will be able to work with (gnu services configuration) the
+;; record can be migrated back to define-configuration.
+(define-record-type* <oci-configuration>
+ oci-configuration
+ make-oci-configuration
+ oci-configuration?
+ this-oci-configuration
+
+ (runtime oci-configuration-runtime
+ (default 'docker))
+ (runtime-cli oci-configuration-runtime-cli
+ (default #f)) ; package or string
+ (runtime-extra-arguments oci-configuration-runtime-extra-arguments ; strings or gexps
+ (default '())) ; or file-like objects
+ (user oci-configuration-user
+ (default "oci-container"))
+ (group oci-configuration-group ; string
+ (default #f))
+ (subuids-range oci-configuration-subuids-range ; subid-range
+ (default #f))
+ (subgids-range oci-configuration-subgids-range ; subid-range
+ (default #f))
+ (containers oci-configuration-containers ; oci-container-configurations
+ (default '()))
+ (networks oci-configuration-networks ; oci-network-configurations
+ (default '()))
+ (volumes oci-configuration-volumes ; oci-volume-configurations
+ (default '()))
+ (verbose? oci-configuration-verbose?
+ (default #f))
+ (home-service? oci-configuration-home-service?
+ (default for-home?) (innate)))
+
+;; TODO: This procedure can be dropped once we switch to define-configuration for
+;; oci-configuration.
+(define (oci-configuration-valid? config)
+ (define runtime-cli
+ (oci-configuration-runtime-cli config))
+ (define group
+ (oci-configuration-group config))
+ (define subuids-range
+ (oci-configuration-subuids-range config))
+ (define subgids-range
+ (oci-configuration-subgids-range config))
+ (and
+ (symbol?
+ (oci-sanitize-runtime (oci-configuration-runtime config)))
+ (or (eq? runtime-cli #f)
+ (package-or-string? runtime-cli))
+ (list? (oci-configuration-runtime-extra-arguments config))
+ (string? (oci-configuration-user config))
+ (or (eq? group #f)
+ (string? group))
+ (or (eq? subuids-range #f)
+ (subid-range? subuids-range))
+ (or (eq? subgids-range #f)
+ (subid-range? subgids-range))
+ (list-of-oci-containers?
+ (oci-configuration-containers config))
+ (list-of-oci-networks?
+ (oci-configuration-networks config))
+ (list-of-oci-volumes?
+ (oci-configuration-volumes config))
+ (boolean?
+ (oci-configuration-verbose? config))
+ (boolean?
+ (oci-configuration-home-service? config))))
(define (oci-runtime-system-environment runtime user)
(if (eq? runtime 'podman)
@@ -833,7 +847,7 @@ (define (oci-runtime-cli runtime runtime-cli path)
;; It is a user defined absolute path
runtime-cli
#~(string-append
- #$(if (not (maybe-value-set? runtime-cli))
+ #$(if (eq? runtime-cli #f)
path
runtime-cli)
#$(if (eq? 'podman runtime)
@@ -1577,18 +1591,27 @@ (define (oci-configuration->shepherd-services config)
(passwd:gid
(getpwnam #$user))))
(oci-runtime-group config (oci-configuration-group config))))
- (verbose? (oci-configuration-verbose? config)))
- (oci-state->shepherd-services runtime system-runtime-cli containers networks volumes
- #:user user
- #:group group
- #:verbose? verbose?
- #:runtime-extra-arguments
- runtime-extra-arguments
- #:runtime-environment
- (oci-runtime-system-environment runtime user)
- #:runtime-requirement
- (oci-runtime-system-requirement runtime)
- #:networks-requirement '(networking))))
+ (verbose? (oci-configuration-verbose? config))
+ (home-service?
+ (oci-configuration-home-service? config)))
+ (if home-service?
+ (oci-state->shepherd-services runtime home-runtime-cli containers networks volumes
+ #:verbose? verbose?
+ #:networks-name
+ (oci-networks-home-shepherd-name runtime)
+ #:volumes-name
+ (oci-volumes-home-shepherd-name runtime))
+ (oci-state->shepherd-services runtime system-runtime-cli containers networks volumes
+ #:user user
+ #:group group
+ #:verbose? verbose?
+ #:runtime-extra-arguments
+ runtime-extra-arguments
+ #:runtime-environment
+ (oci-runtime-system-environment runtime user)
+ #:runtime-requirement
+ (oci-runtime-system-requirement runtime)
+ #:networks-requirement '(networking)))))
(define (oci-service-subids config)
"Return a subids-extension record representing subuids and subgids required by
@@ -1616,14 +1639,14 @@ (define (oci-service-subids config)
(define subgid-ranges
(delete-duplicate-ranges
(cons
- (if (not (maybe-value-set? subgids))
+ (if (eq? subgids #f)
(subid-range (name user))
subgids)
container-users)))
(define subuid-ranges
(delete-duplicate-ranges
(cons
- (if (not (maybe-value-set? subuids))
+ (if (eq? subuids #f)
(subid-range (name user))
subuids)
container-users)))
@@ -1682,13 +1705,21 @@ (define (oci-service-profile runtime runtime-cli)
'()
(list
(cond
- ((maybe-value-set? runtime-cli)
+ ((not (eq? runtime-cli #f))
runtime-cli)
((eq? 'podman runtime)
podman)
(else
docker-cli))))))
+(define (oci-service-extension-wrap-validate extension)
+ (lambda (config)
+ (if (oci-configuration-valid? config)
+ (extension config)
+ (raise
+ (formatted-message
+ (G_ "Invalide oci-configuration ~a.") config)))))
+
(define (oci-configuration-extend config extension)
(oci-configuration
(inherit config)
@@ -1717,18 +1748,22 @@ (define oci-service-type
(extensions
(list
(service-extension profile-service-type
- (lambda (config)
- (let ((runtime-cli
- (oci-configuration-runtime-cli config))
- (runtime
- (oci-configuration-runtime config)))
- (oci-service-profile runtime runtime-cli))))
+ (oci-service-extension-wrap-validate
+ (lambda (config)
+ (let ((runtime-cli
+ (oci-configuration-runtime-cli config))
+ (runtime
+ (oci-configuration-runtime config)))
+ (oci-service-profile runtime runtime-cli)))))
(service-extension subids-service-type
- oci-service-subids)
+ (oci-service-extension-wrap-validate
+ oci-service-subids))
(service-extension account-service-type
- oci-service-accounts)
+ (oci-service-extension-wrap-validate
+ oci-service-accounts))
(service-extension shepherd-root-service-type
- oci-configuration->shepherd-services)))
+ (oci-service-extension-wrap-validate
+ oci-configuration->shepherd-services))))
;; Concatenate OCI object lists.
(compose (lambda (args)
(fold oci-extension-merge
--
2.48.1
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.