mirror of
https://codeberg.org/guix/guix.git
synced 2025-10-02 02:15:12 +00:00
services: Add oci-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. 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/build/oci-containers.scm: New file containg OCI runtime business logic used in OCI backed Shepherd services. oci-read-lines (oci-system*,oci-object-exists?,oci-object-service-available? oci-image-load,oci-log-verbose,oci-container-execlp,oci-object-create): New procedures. * gnu/local.mk: Add it. * gnu/services/containers.scm (list-of-oci-containers?, list-of-oci-networks?,list-of-oci-volumes?,%oci-supported-runtimes, oci-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-container-shepherd-name,oci-networks-shepherd-name, oci-networks-home-shepherd-name,oci-volumes-shepherd-name, oci-volumes-home-shepherd-name,oci-container-configuration->options, oci-network-configuration->options,oci-volume-configuration->options, oci-container-shepherd-service,oci-objects-merge-lst,oci-extension-merge, oci-service-accounts,oci-service-profile,oci-service-subids, oci-configuration->shepherd-services,oci-configuration-extend): New procedures. (image-reference): Implement unambiguous naming convention, that paired with the new implementation for listing caches images with docker ls or podman ls, allows for more efficient image caching. (oci-container-configuration)[user,group]: Change default-type to maybe-string, since by default containers will run under the user and group declared in oci-configuration records. When unset the oci-service-type will derive their value from the OCI runtime state. [runtime,host-environment,environment,shepherd-actions,ports,extra-arguments]: define a predicate and use it as a type in the configuration. This way errors are reported with source location information. (lower-manifest): Defer to caller the logic of setting up an image tag. (lower-oci-image): Rename to load-oci-image-state. (oci-runtime-state): Intermediate representation of the OCI runtime details. It is supposed to be an internal API. (oci-state): Intermediate representation of the OCI provisioning state, such as containers and networks. It is supposed to be an internal API. (oci-container-invocation): Intermediate representation of the OCI runtime run command to start a container. It is supposed to be an internal API. (%oci-image-loader): Rename to oci-image-loader and use oci-runtime-state and (gnu build oci-containers). (oci-container-shepherd-service): Use oci-state and oci-runtime-state, add command-line action. (oci-network-configuration,oci-volume-configuration,oci-configuration, oci-extension): New record types. (oci-service-type): New service-type. * doc/guix.texi: Document it. * gnu/tests/containers.scm: Test it. * gnu/services/docker.scm: Deprecate the oci-container-service-type. Change-Id: I656b3db85832e42d53072fcbfb91d1226f39ef38 Modified-by: Maxim Cournoyer <maxim@guixotic.coop> Signed-off-by: Maxim Cournoyer <maxim@guixotic.coop>
This commit is contained in:
parent
d6200cefcc
commit
60f4d72590
6 changed files with 2190 additions and 267 deletions
306
doc/guix.texi
306
doc/guix.texi
|
@ -44746,59 +44746,162 @@ available for each configured user.
|
|||
@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
|
||||
@samp{docker run} or @samp{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 file name 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. The use of the @code{oci-extension} record should
|
||||
be preferred for most cases.
|
||||
|
||||
@item @code{networks} (default: @code{'()}) (type: list-of-oci-networks)
|
||||
The list of @code{oci-network-configuration} records representing the
|
||||
containers to provision. The use of the @code{oci-extension} record should
|
||||
be preferred for most cases.
|
||||
|
||||
@item @code{volumes} (default: @code{'()}) (type: list-of-oci-volumes)
|
||||
The list of @code{oci-volumes-configuration} records representing the
|
||||
containers to provision. The use of the @code{oci-extension} record should
|
||||
be preferred for most cases.
|
||||
|
||||
@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
|
||||
|
@ -44818,16 +44921,16 @@ Overwrite the default command (@code{CMD}) of the image.
|
|||
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 @samp{docker run}
|
||||
or @samp{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
|
||||
|
||||
|
@ -44835,22 +44938,24 @@ Pair members can be strings, gexps or file-like objects. Strings are passed
|
|||
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)
|
||||
|
@ -44878,7 +44983,7 @@ This is a list of @code{shepherd-action} records defining actions supported
|
|||
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
|
||||
|
@ -44889,10 +44994,11 @@ list of pairs or strings, even mixed:
|
|||
"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
|
||||
|
@ -44903,25 +45009,97 @@ list of pairs or strings, even mixed:
|
|||
"/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 @samp{docker run} or @samp{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 @samp{docker network create} or @samp{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 @samp{docker volume create} or @samp{podman volume create}
|
||||
invokation.
|
||||
|
||||
@end table
|
||||
|
||||
|
|
210
gnu/build/oci-containers.scm
Normal file
210
gnu/build/oci-containers.scm
Normal file
|
@ -0,0 +1,210 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2025 Giacomo Leidi <goodoldpaul@autistici.org>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
;;; GNU Guix is free software; you can redistribute it and/or modify it
|
||||
;;; under the terms of the GNU General Public License as published by
|
||||
;;; the Free Software Foundation; either version 3 of the License, or (at
|
||||
;;; your option) any later version.
|
||||
;;;
|
||||
;;; GNU Guix is distributed in the hope that it will be useful, but
|
||||
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
;;; GNU General Public License for more details.
|
||||
;;;
|
||||
;;; You should have received a copy of the GNU General Public License
|
||||
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;;; Commentary:
|
||||
;;;
|
||||
;;; This module contains helpers used as part of the oci-service-type
|
||||
;;; definition.
|
||||
;;;
|
||||
;;; Code:
|
||||
|
||||
(define-module (gnu build oci-containers)
|
||||
#:use-module (ice-9 format)
|
||||
#:use-module (ice-9 match)
|
||||
#:use-module (ice-9 popen)
|
||||
#:use-module (ice-9 rdelim)
|
||||
#:use-module (ice-9 textual-ports)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:export (oci-read-lines
|
||||
oci-system*
|
||||
oci-object-exists?
|
||||
oci-object-service-available?
|
||||
oci-image-load
|
||||
oci-log-verbose
|
||||
oci-container-execlp
|
||||
oci-object-create))
|
||||
|
||||
(define* (oci-read-lines invocation #:key verbose?)
|
||||
(define (get-lines port)
|
||||
(let ((lines-string (get-string-all port)))
|
||||
(string-split lines-string #\newline)))
|
||||
|
||||
(define command
|
||||
(string-join invocation " "))
|
||||
|
||||
(when verbose? (format #t "Running ~a~%" command))
|
||||
|
||||
(with-input-from-port (open-input-pipe command)
|
||||
(lambda _
|
||||
(get-lines (current-input-port)))))
|
||||
|
||||
(define* (oci-log-verbose invocation)
|
||||
(format #t "Running in verbose mode...
|
||||
Current user: ~a ~a
|
||||
Current group: ~a ~a
|
||||
Current directory: ~a~%"
|
||||
(getuid) (passwd:name (getpwuid (getuid)))
|
||||
(getgid) (group:name (getgrgid (getgid)))
|
||||
(getcwd))
|
||||
|
||||
(format #t "Running~{ ~a~}~%" invocation))
|
||||
|
||||
(define* (oci-system* invocation #:key verbose?)
|
||||
(when verbose?
|
||||
(format #t "Running~{ ~a~}~%" invocation))
|
||||
|
||||
(let* ((status (apply system* invocation))
|
||||
(exit-code (status:exit-val status)))
|
||||
(when verbose?
|
||||
(format #t "Exit code: ~a~%" exit-code))
|
||||
status))
|
||||
|
||||
(define* (oci-object-member name objects
|
||||
#:key verbose?)
|
||||
|
||||
(define member? (member name objects))
|
||||
|
||||
(when (and verbose? (> (length objects) 0))
|
||||
(format #t "~a is ~apart of:~{ ~a~}~%"
|
||||
name
|
||||
(if member? "" "not ")
|
||||
objects))
|
||||
member?)
|
||||
|
||||
(define* (oci-object-list runtime-cli object
|
||||
#:key verbose?
|
||||
(format-string "{{.Name}}"))
|
||||
|
||||
(define invocation
|
||||
(list runtime-cli object "ls" "--format"
|
||||
(string-append "\"" format-string "\"")))
|
||||
|
||||
(filter
|
||||
(lambda (name)
|
||||
(not (string=? (string-trim name) "")))
|
||||
(oci-read-lines invocation #:verbose? verbose?)))
|
||||
|
||||
(define* (docker-object-exist? runtime-cli object name
|
||||
#:key verbose?
|
||||
(format-string "{{.Name}}"))
|
||||
|
||||
(define objects
|
||||
(oci-object-list runtime-cli object
|
||||
#:verbose? verbose?
|
||||
#:format-string format-string))
|
||||
|
||||
(oci-object-member name objects #:verbose? verbose?))
|
||||
|
||||
(define* (podman-object-exist? runtime-cli object name #:key verbose?)
|
||||
(let ((invocation (list runtime-cli object "exists" name)))
|
||||
(define exit-code
|
||||
(status:exit-val (oci-system* invocation #:verbose? verbose?)))
|
||||
(equal? EXIT_SUCCESS exit-code)))
|
||||
|
||||
(define* (oci-object-exists? runtime runtime-cli object name
|
||||
#:key verbose?
|
||||
(format-string "{{.Name}}"))
|
||||
(if (eq? runtime 'podman)
|
||||
(podman-object-exist? runtime-cli object name
|
||||
#:verbose? verbose?)
|
||||
(docker-object-exist? runtime-cli object name
|
||||
#:verbose? verbose?
|
||||
#:format-string format-string)))
|
||||
|
||||
(define* (oci-object-service-available? runtime-cli object names
|
||||
#:key verbose?
|
||||
(format-string "{{.Name}}"))
|
||||
"Whether NAMES are provisioned in the current OBJECT environment."
|
||||
(define environment
|
||||
(oci-object-list runtime-cli object
|
||||
#:verbose? verbose?
|
||||
#:format-string format-string))
|
||||
(when verbose?
|
||||
(format #t "~a environment:~{ ~a~}~%" object environment))
|
||||
|
||||
(define available?
|
||||
(every
|
||||
(lambda (name)
|
||||
(oci-object-member name environment #:verbose? verbose?))
|
||||
names))
|
||||
|
||||
(when verbose?
|
||||
(format #t "~a service is~a available~%" object (if available? "" " not")))
|
||||
|
||||
available?)
|
||||
|
||||
(define* (oci-image-load runtime runtime-cli tarball name tag
|
||||
#:key verbose?
|
||||
(format-string "{{.Repository}}:{{.Tag}}"))
|
||||
(define load-invocation
|
||||
(list runtime-cli "load" "-i" tarball))
|
||||
|
||||
(if (oci-object-exists? runtime runtime-cli "image" tag
|
||||
#:verbose? verbose?
|
||||
#:format-string format-string)
|
||||
(format #t "~a image already exists, skipping.~%" tag)
|
||||
(begin
|
||||
(format #t "Loading image for ~a from ~a...~%" name tarball)
|
||||
|
||||
(let ((line (first
|
||||
(oci-read-lines load-invocation #:verbose? verbose?))))
|
||||
(unless (or (eof-object? line)
|
||||
(string-null? line))
|
||||
|
||||
(format #t "~a~%" line)
|
||||
|
||||
(let* ((repository&tag
|
||||
(string-drop line
|
||||
(string-length
|
||||
"Loaded image: ")))
|
||||
(tag-invocation
|
||||
(list runtime-cli "tag" repository&tag tag))
|
||||
(drop-old-tag-invocation
|
||||
(list runtime-cli "image" "rm" "-f" repository&tag)))
|
||||
|
||||
(unless (string=? repository&tag tag)
|
||||
(let ((exit-code
|
||||
(status:exit-val
|
||||
(oci-system* tag-invocation #:verbose? verbose?))))
|
||||
(format #t "Tagged ~a with ~a...~%" tarball tag)
|
||||
|
||||
(when (equal? EXIT_SUCCESS exit-code)
|
||||
(oci-system* drop-old-tag-invocation #:verbose? verbose?))))))))))
|
||||
|
||||
(define* (oci-container-execlp invocation #:key verbose? pre-script)
|
||||
(when pre-script
|
||||
(pre-script))
|
||||
(when verbose?
|
||||
(oci-log-verbose invocation))
|
||||
(apply execlp (first invocation) invocation))
|
||||
|
||||
(define* (oci-object-create runtime runtime-cli runtime-name
|
||||
object
|
||||
invocations
|
||||
#:key verbose?
|
||||
(format-string "{{.Name}}"))
|
||||
(for-each
|
||||
(lambda (invocation)
|
||||
(define name (last invocation))
|
||||
(if (oci-object-exists? runtime runtime-cli object name
|
||||
#:format-string format-string
|
||||
#:verbose? verbose?)
|
||||
(format #t "~a ~a ~a already exists, skipping creation.~%"
|
||||
runtime-name name object)
|
||||
(oci-system* invocation #:verbose? verbose?)))
|
||||
invocations))
|
|
@ -837,6 +837,7 @@ GNU_SYSTEM_MODULES = \
|
|||
%D%/build/linux-initrd.scm \
|
||||
%D%/build/linux-modules.scm \
|
||||
%D%/build/marionette.scm \
|
||||
%D%/build/oci-containers.scm \
|
||||
%D%/build/secret-service.scm \
|
||||
\
|
||||
%D%/tests.scm \
|
||||
|
|
File diff suppressed because it is too large
Load diff
|
@ -31,7 +31,10 @@
|
|||
#: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 @@
|
|||
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,26 @@ bundles in Docker containers.")
|
|||
;;; 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)
|
||||
|
|
|
@ -27,6 +27,9 @@
|
|||
#: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 @@
|
|||
#: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
|
||||
|
@ -133,7 +138,7 @@
|
|||
(status (close-pipe port)))
|
||||
output)))
|
||||
(let* ((bash
|
||||
,(string-append #$bash "/bin/bash"))
|
||||
(string-append #$bash "/bin/bash"))
|
||||
(response1
|
||||
(slurp bash "-c"
|
||||
(string-append "ls -la /sys/fs/cgroup | "
|
||||
|
@ -345,3 +350,555 @@ standard output device and then enters a new line.")
|
|||
(name "rootless-podman")
|
||||
(description "Test rootless Podman service.")
|
||||
(value (build-tarball&run-rootless-podman-test))))
|
||||
|
||||
|
||||
(define %oci-network
|
||||
(oci-network-configuration (name "my-network")))
|
||||
|
||||
(define %oci-volume
|
||||
(oci-volume-configuration (name "my-volume")))
|
||||
|
||||
(define %oci-wait-for-file
|
||||
#~(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 %oci-read-lines
|
||||
#~(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 %oci-slurp
|
||||
#~(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))))
|
||||
|
||||
(define (%oci-rootless-podman-run commands)
|
||||
#~((use-modules (srfi srfi-1)
|
||||
(ice-9 format)
|
||||
(ice-9 popen)
|
||||
(ice-9 match)
|
||||
(ice-9 rdelim)
|
||||
(gnu build oci-containers))
|
||||
|
||||
#$%oci-wait-for-file
|
||||
#$%oci-read-lines
|
||||
#$%oci-slurp
|
||||
|
||||
(define responses
|
||||
(map
|
||||
(lambda (index)
|
||||
(format #f "/tmp/response_~a" index))
|
||||
(iota (length '#$commands))))
|
||||
|
||||
(match (primitive-fork)
|
||||
(0
|
||||
(begin
|
||||
(setgid (passwd:gid (getpwnam "oci-container")))
|
||||
(setuid (passwd:uid (getpw "oci-container")))
|
||||
|
||||
(let* ((outputs
|
||||
(list #$@commands))
|
||||
(outputs-responses
|
||||
(zip outputs responses)))
|
||||
(for-each
|
||||
(match-lambda
|
||||
((output response)
|
||||
(call-with-output-file response
|
||||
(lambda (port)
|
||||
(display (string-join output "\n") port)))))
|
||||
outputs-responses))))
|
||||
(pid
|
||||
(cdr (waitpid pid))))
|
||||
|
||||
(for-each wait-for-file responses)
|
||||
(map
|
||||
(lambda (response)
|
||||
(sort (slurp "cat" response) string<=?))
|
||||
responses)))
|
||||
|
||||
(define %oci-rootless-podman-os
|
||||
(simple-operating-system
|
||||
(service dhcpcd-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))
|
||||
(volumes
|
||||
(list %oci-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)
|
||||
(newline)
|
||||
(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 build oci-containers)
|
||||
(gnu build dbus-service)
|
||||
(gnu services herd)
|
||||
(guix combinators))))
|
||||
|
||||
(define vm
|
||||
(virtual-machine
|
||||
(operating-system os)
|
||||
(volatile? #f)
|
||||
(memory-size 1024)
|
||||
(disk-image-size (* 5000 (expt 2 20)))
|
||||
(port-forwardings '())))
|
||||
|
||||
(define test
|
||||
(with-imported-modules '((gnu build oci-containers)
|
||||
(gnu build dbus-service)
|
||||
(gnu build marionette))
|
||||
#~(begin
|
||||
(use-modules (srfi srfi-1) (srfi srfi-11) (srfi srfi-64)
|
||||
(gnu build dbus-service)
|
||||
(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 "rootless-podman-oci-service")
|
||||
|
||||
(marionette-eval
|
||||
'(begin
|
||||
(use-modules (gnu services herd))
|
||||
(wait-for-service 'user-processes))
|
||||
marionette)
|
||||
|
||||
(test-assert "podman-volumes running"
|
||||
(begin
|
||||
(define (run-test)
|
||||
(first
|
||||
(marionette-eval
|
||||
`(begin
|
||||
#$@(%oci-rootless-podman-run
|
||||
#~((oci-object-service-available?
|
||||
"/run/current-system/profile/bin/podman"
|
||||
"volume"
|
||||
'("my-volume")
|
||||
#:verbose? #t))))
|
||||
marionette)))
|
||||
;; Allow services to come up on slower machines.
|
||||
(with-retries 80 1 (equal? '("my-volume") (run-test)))))
|
||||
|
||||
(test-assert "podman-networks running"
|
||||
(begin
|
||||
(define (run-test)
|
||||
(first
|
||||
(marionette-eval
|
||||
`(begin
|
||||
#$@(%oci-rootless-podman-run
|
||||
#~((oci-object-service-available?
|
||||
"/run/current-system/profile/bin/podman"
|
||||
"network"
|
||||
'("my-network")
|
||||
#:verbose? #t))))
|
||||
marionette)))
|
||||
;; Allow services to come up on slower machines.
|
||||
(with-retries 80 1 (equal? '("my-network" "podman") (run-test)))))
|
||||
|
||||
(test-assert "image loaded"
|
||||
(begin
|
||||
(define (run-test)
|
||||
(first
|
||||
(marionette-eval
|
||||
`(begin
|
||||
#$@(%oci-rootless-podman-run
|
||||
#~((oci-object-service-available?
|
||||
"/run/current-system/profile/bin/podman"
|
||||
"image"
|
||||
'("localhost/guile:latest")
|
||||
#:format-string "{{.Repository}}:{{.Tag}}"
|
||||
#:verbose? #t))))
|
||||
marionette)))
|
||||
;; Allow services to come up on slower machines.
|
||||
(with-retries 80 1
|
||||
(equal?
|
||||
'("localhost/guile:latest")
|
||||
(run-test)))))
|
||||
|
||||
(test-assert "passing host environment variables"
|
||||
(begin
|
||||
(define (run-test)
|
||||
(first
|
||||
(marionette-eval
|
||||
`(begin
|
||||
#$@(%oci-rootless-podman-run
|
||||
#~((slurp
|
||||
"/run/current-system/profile/bin/podman"
|
||||
"exec" "first"
|
||||
"/bin/guile" "-c"
|
||||
"'(display (getenv \"VARIABLE\"))'"))))
|
||||
marionette)))
|
||||
;; Allow services to come up on slower machines.
|
||||
(with-retries 80 1 (equal? '("value") (run-test)))))
|
||||
|
||||
(test-equal "mounting host files"
|
||||
'("hello")
|
||||
(first
|
||||
(marionette-eval
|
||||
`(begin
|
||||
#$@(%oci-rootless-podman-run
|
||||
#~((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)))'"))))
|
||||
marionette)))
|
||||
|
||||
(test-equal "read and write to provisioned volumes"
|
||||
'("world")
|
||||
(second
|
||||
(marionette-eval
|
||||
`(begin
|
||||
#$@(%oci-rootless-podman-run
|
||||
#~((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))))'")
|
||||
(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)))'"))))
|
||||
marionette)))
|
||||
|
||||
(test-equal
|
||||
"can read and write to ports over provisioned network"
|
||||
'("out of office")
|
||||
(first
|
||||
(marionette-eval
|
||||
`(begin
|
||||
#$@(%oci-rootless-podman-run
|
||||
#~((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))'"))))
|
||||
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-run commands)
|
||||
#~((use-modules (srfi srfi-1)
|
||||
(ice-9 format)
|
||||
(ice-9 popen)
|
||||
(ice-9 match)
|
||||
(ice-9 rdelim)
|
||||
(gnu build oci-containers))
|
||||
|
||||
#$%oci-read-lines
|
||||
#$%oci-slurp
|
||||
|
||||
(let ((outputs (list #$@commands)))
|
||||
(map
|
||||
(lambda (output)
|
||||
(sort output string<=?))
|
||||
outputs))))
|
||||
|
||||
(define %oci-docker-os
|
||||
(simple-operating-system
|
||||
(service dhcpcd-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))
|
||||
(volumes
|
||||
(list %oci-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)
|
||||
(newline)
|
||||
(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 build oci-containers)
|
||||
(gnu build dbus-service)
|
||||
(gnu services herd)
|
||||
(guix combinators))))
|
||||
|
||||
(define vm
|
||||
(virtual-machine
|
||||
(operating-system os)
|
||||
(volatile? #f)
|
||||
(memory-size 1024)
|
||||
(disk-image-size (* 5000 (expt 2 20)))
|
||||
(port-forwardings '())))
|
||||
|
||||
(define test
|
||||
(with-imported-modules '((gnu build oci-containers)
|
||||
(gnu build dbus-service)
|
||||
(gnu build marionette))
|
||||
#~(begin
|
||||
(use-modules (srfi srfi-1) (srfi srfi-11) (srfi srfi-64)
|
||||
(gnu build dbus-service)
|
||||
(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)
|
||||
(first
|
||||
(marionette-eval
|
||||
`(begin
|
||||
#$@(%oci-docker-run
|
||||
#~((oci-object-service-available?
|
||||
"/run/current-system/profile/bin/docker"
|
||||
"volume"
|
||||
'("my-volume")
|
||||
#:verbose? #t))))
|
||||
marionette)))
|
||||
;; Allow services to come up on slower machines.
|
||||
(with-retries 80 1 (equal? '("my-volume") (run-test)))))
|
||||
|
||||
(test-assert "docker-networks running"
|
||||
(begin
|
||||
(define (run-test)
|
||||
(first
|
||||
(marionette-eval
|
||||
`(begin
|
||||
#$@(%oci-docker-run
|
||||
#~((oci-object-service-available?
|
||||
"/run/current-system/profile/bin/docker"
|
||||
"network"
|
||||
'("my-network")
|
||||
#:verbose? #t))))
|
||||
marionette)))
|
||||
;; Allow services to come up on slower machines.
|
||||
(with-retries 80 1 (equal?
|
||||
'("my-network" "none")
|
||||
(run-test)))))
|
||||
|
||||
(test-assert "passing host environment variables"
|
||||
(begin
|
||||
(define (run-test)
|
||||
(first
|
||||
(marionette-eval
|
||||
`(begin
|
||||
#$@(%oci-docker-run
|
||||
#~((slurp
|
||||
"/run/current-system/profile/bin/docker"
|
||||
"exec" "first"
|
||||
"/bin/guile" "-c"
|
||||
"'(display (getenv \"VARIABLE\"))'"))))
|
||||
marionette)))
|
||||
;; Allow services to come up on slower machines.
|
||||
(with-retries 80 1 (equal? '("value") (run-test)))))
|
||||
|
||||
(test-equal "read and write to provisioned volumes"
|
||||
'("world")
|
||||
(second
|
||||
(marionette-eval
|
||||
`(begin
|
||||
#$@(%oci-docker-run
|
||||
#~((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 and write to ports over provisioned network"
|
||||
'("out of office")
|
||||
(first
|
||||
(marionette-eval
|
||||
`(begin
|
||||
#$@(%oci-docker-run
|
||||
#~((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))))
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue