Package: guix-patches;
Reported by: paul <goodoldpaul <at> autistici.org>
Date: Wed, 5 Feb 2025 22:01:03 UTC
Severity: normal
Tags: moreinfo
Message #194 received at 76081 <at> debbugs.gnu.org (full text, mbox):
From: Maxim Cournoyer <maxim.cournoyer <at> gmail.com> To: Giacomo Leidi <goodoldpaul <at> autistici.org> Cc: Ludovic Courtès <ludo <at> gnu.org>, Gabriel Wicki <gabriel <at> erlikon.ch>, 76081 <at> debbugs.gnu.org Subject: Re: [bug#76081] [PATCH v10 4/7] services: Add oci-service-type. Date: Fri, 16 May 2025 10:38:54 +0900
Hi,
Giacomo Leidi <goodoldpaul <at> autistici.org> writes:
> 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.
Sounds useful!
> 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.
Nitpick: you can combine multiple variables/procedures, like:
(oci-runtime-cli, oci-runtime-name)
(oci-network-configuration, oci-volume-configuration)
[...]
(oci-service-type): New variables.
The above change log appears incomplete, for example oci-image-reference
was changed but isn't listed.
[...]
> @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")))))))
I was curious: was is the gain to have by using the extension mechanism
instead of directly accepting a list of 'oci-configuration' or similarly
named record to the oci-service-type?
> @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
I know not all of these instances are newly added, but @command should
only be used with a single command name. For a command line, use @samp.
> +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
s/absolute path/absolute file name/
[...]
> +@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.
Maybe streamline to 'The use of the @code{oci-extension} record should
be preferred for most cases.' As I wondered above, what is the
benefit?
> +
> +@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.
Ditto.
> +@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.
Ditto.
[...]
> diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm
> index 24f31c756b8..66b46456800 100644
> --- a/gnu/services/containers.scm
> +++ b/gnu/services/containers.scm
[...]
> +(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))
Instead of using explicit sanitizers, it'd be better to define a
oci-runtime? predicate and use it as a type in the configuration. This
way errors are reported with source location information.
[...]
> +
> +(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"))))
I'd replace the 'path' instances in the source with 'file' or 'file-name', to
better match our GNU conventions.
[...]
> +(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)))))))
That's a complex piece of staged code; have you considered placing it in
a supporting build-side module, e.g. gnu/build/oci-containers.scm ?
Then it could be more simply imported in the gexp environment and used.
See the gnu/build/jami-service.scm for an example.
> +(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)
That's a lot of arguments! Perhaps it could accept a record instead?
Please also mind the 80 chars max width.
> + "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 #~()))
The default value for a keyword argument is #f, so I'd omit the explicit
default for verbose?.
> + "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)))
I'd use a single format call; you can format the string naturally like
(format #t "\
Running in verbose mode...
Current user: ~a ~a
...
" arg1 arg2, ...)
> + (define invocation (list #$@invocation))
> + #$@pre-script
> + (when #$verbose?
> + (format #t "Running~{ ~a~}~%" invocation))
> + (apply execlp `(,(first invocation) ,@invocation)))))
You can more simply: (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)
> + '()))))))
That's a very long let. Since many values appear to simply be accessed
from theh oci-container-configuration, match-record could be used to
great effect. For readability, I'd also define the action procedures
using nested 'define' inside the let/match-record.
[...]
[...]
> + (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
Max width :-).
> + #:key
> + (runtime-environment #~())
> + (user #f)
> + (group #f)
> + (verbose? #f))
I'd drop the default #f values, here and elsewhere.
[...]
> +(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)))))
I don't understand how the above 'delete-duplicate-ranges' procedure
works; the 2nd argument of delete-duplicates is normally a predicate
that accepts two values, but here it's a lambda that disregards the
arguments: it seems it'd be wasteful to compute the same result over and
over?
> + (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))
Here and above, I'd reverse your if branches, so you do not need to use 'not'.
> + (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
s/~as names/names of ~a/, perhaps?
> +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))
Max width.
[...]
> +(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))))
You can nest the fields under (service-type to meet the max columns width.
> + (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
s/OCI object/OCI objects/
> +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
Please punctuate fully standalone comments (here, capitalizing the first
letter and adding a trailing period).
> + 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
Ditto.
> +(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~%"))
Max width; you can break long strings with \ (backslash) escape.
> + (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
[...]
> +(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"))
Unquote-splice is not necessary here, you can more directly #$(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"))))
Is there perhaps an easier way to check that the podman services were
started successfully? Perhaps using the podman command directly to
query the state of the running containers?
'ls' is usually frowned for scripting; it's meant for interactive use.
Perhaps you could use the shell wildcard feature or the find command
instead? I comment explaining what the above does/check exactly would
be useful; it's not obvious.
> + (list (string-join response1 "\n") (string-join response2 "\n"))))
> + marionette))
> + ;; Allow services to come up on slower machines
^ missing period
> + (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))))))))
Note that we have a 'with-retries' definition in (gnu build
jami-service) which could be used here; perhaps it should be relocated
elsewhere.
> +
> + (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")
I'd remove 'out-dir' and hard-code "/tmp/response" directly.
> + (lambda (port)
> + (display (string-join response "\n") port)))))
> + (lambda ()
> + (primitive-exit 127))))
The fork is used to be able to run the podman command with the right
passwd and uid, right? Maybe you could use the shepherd's provided
'command' or 'fork+exec-command', which have a nice API to do this.
Also, is the dynamic-wind unnecessary? I would have thought that if a
forked children aborts, its exit status should be reflected accordingly?
> + (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
missing trailing '.'.
> + (let loop ((attempts 0))
> + (if (= attempts 80)
> + (error "Service didn't come up after more than 80 seconds")
nitpick: error messages do not need to be complete sentences/be punctuated, as
they are intended for debugging.
> + (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))
The definitions boilerplate could be defined as data above the tests and
spliced in for reuse.
> + (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'")))
Max width :-).
> + (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<=?))
I don't think using the stable variant here is necessary/useful.
> + 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)
No need for #t.
> + marionette))
> +
> + (test-assert "second container running"
> + (marionette-eval
> + '(begin
> + (use-modules (gnu services herd))
> + (wait-for-service 'second #:timeout 120)
> + #t)
Ditto.
> + 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))))))))
I'm curious, did you test this on a slow machine to see how much time it
needed there?
> + (test-equal "mounting host files"
[...]
> + (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
[...]
> + (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))))
The idiom of forking ot invoke podman is used so commonly it should be
extracted to a procedure or syntax and reused.
> +
> + (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
[...]
> + (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))))"))
You can indent the snippet normally on multiple lines, for readability,
or extract it as some expression to splice in.
> + (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))))
Make sure to mirror my earlier comments to the docker test as well.
Phew, that was a large chunk! I'll continue my review with the
remaining commits, but when I'm done, could you please submit a v11,
taking into account my comments?
--
Thanks,
Maxim
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.