summaryrefslogtreecommitdiff
path: root/gnu
diff options
context:
space:
mode:
authorGiacomo Leidi <goodoldpaul@autistici.org>2025-08-24 16:59:45 +0200
committerMaxim Cournoyer <maxim@guixotic.coop>2025-08-25 13:04:36 +0900
commit60f4d72590abf11885ea3e2ec2a7c277683417aa (patch)
treea224ee352a609ac50d59735cb666600cda42a960 /gnu
parentd6200cefcc18e55df07fc0e5dabbb4f5f7de7bb4 (diff)
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>
Diffstat (limited to 'gnu')
-rw-r--r--gnu/build/oci-containers.scm210
-rw-r--r--gnu/local.mk1
-rw-r--r--gnu/services/containers.scm1353
-rw-r--r--gnu/services/docker.scm38
-rw-r--r--gnu/tests/containers.scm561
5 files changed, 1954 insertions, 209 deletions
diff --git a/gnu/build/oci-containers.scm b/gnu/build/oci-containers.scm
new file mode 100644
index 00000000000..38704e9e4a4
--- /dev/null
+++ b/gnu/build/oci-containers.scm
@@ -0,0 +1,210 @@
1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2025 Giacomo Leidi <goodoldpaul@autistici.org>
3;;;
4;;; This file is part of GNU Guix.
5;;;
6;;; GNU Guix is free software; you can redistribute it and/or modify it
7;;; under the terms of the GNU General Public License as published by
8;;; the Free Software Foundation; either version 3 of the License, or (at
9;;; your option) any later version.
10;;;
11;;; GNU Guix is distributed in the hope that it will be useful, but
12;;; WITHOUT ANY WARRANTY; without even the implied warranty of
13;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14;;; GNU General Public License for more details.
15;;;
16;;; You should have received a copy of the GNU General Public License
17;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
18
19;;; Commentary:
20;;;
21;;; This module contains helpers used as part of the oci-service-type
22;;; definition.
23;;;
24;;; Code:
25
26(define-module (gnu build oci-containers)
27 #:use-module (ice-9 format)
28 #:use-module (ice-9 match)
29 #:use-module (ice-9 popen)
30 #:use-module (ice-9 rdelim)
31 #:use-module (ice-9 textual-ports)
32 #:use-module (srfi srfi-1)
33 #:export (oci-read-lines
34 oci-system*
35 oci-object-exists?
36 oci-object-service-available?
37 oci-image-load
38 oci-log-verbose
39 oci-container-execlp
40 oci-object-create))
41
42(define* (oci-read-lines invocation #:key verbose?)
43 (define (get-lines port)
44 (let ((lines-string (get-string-all port)))
45 (string-split lines-string #\newline)))
46
47 (define command
48 (string-join invocation " "))
49
50 (when verbose? (format #t "Running ~a~%" command))
51
52 (with-input-from-port (open-input-pipe command)
53 (lambda _
54 (get-lines (current-input-port)))))
55
56(define* (oci-log-verbose invocation)
57 (format #t "Running in verbose mode...
58Current user: ~a ~a
59Current group: ~a ~a
60Current directory: ~a~%"
61 (getuid) (passwd:name (getpwuid (getuid)))
62 (getgid) (group:name (getgrgid (getgid)))
63 (getcwd))
64
65 (format #t "Running~{ ~a~}~%" invocation))
66
67(define* (oci-system* invocation #:key verbose?)
68 (when verbose?
69 (format #t "Running~{ ~a~}~%" invocation))
70
71 (let* ((status (apply system* invocation))
72 (exit-code (status:exit-val status)))
73 (when verbose?
74 (format #t "Exit code: ~a~%" exit-code))
75 status))
76
77(define* (oci-object-member name objects
78 #:key verbose?)
79
80 (define member? (member name objects))
81
82 (when (and verbose? (> (length objects) 0))
83 (format #t "~a is ~apart of:~{ ~a~}~%"
84 name
85 (if member? "" "not ")
86 objects))
87 member?)
88
89(define* (oci-object-list runtime-cli object
90 #:key verbose?
91 (format-string "{{.Name}}"))
92
93 (define invocation
94 (list runtime-cli object "ls" "--format"
95 (string-append "\"" format-string "\"")))
96
97 (filter
98 (lambda (name)
99 (not (string=? (string-trim name) "")))
100 (oci-read-lines invocation #:verbose? verbose?)))
101
102(define* (docker-object-exist? runtime-cli object name
103 #:key verbose?
104 (format-string "{{.Name}}"))
105
106 (define objects
107 (oci-object-list runtime-cli object
108 #:verbose? verbose?
109 #:format-string format-string))
110
111 (oci-object-member name objects #:verbose? verbose?))
112
113(define* (podman-object-exist? runtime-cli object name #:key verbose?)
114 (let ((invocation (list runtime-cli object "exists" name)))
115 (define exit-code
116 (status:exit-val (oci-system* invocation #:verbose? verbose?)))
117 (equal? EXIT_SUCCESS exit-code)))
118
119(define* (oci-object-exists? runtime runtime-cli object name
120 #:key verbose?
121 (format-string "{{.Name}}"))
122 (if (eq? runtime 'podman)
123 (podman-object-exist? runtime-cli object name
124 #:verbose? verbose?)
125 (docker-object-exist? runtime-cli object name
126 #:verbose? verbose?
127 #:format-string format-string)))
128
129(define* (oci-object-service-available? runtime-cli object names
130 #:key verbose?
131 (format-string "{{.Name}}"))
132 "Whether NAMES are provisioned in the current OBJECT environment."
133 (define environment
134 (oci-object-list runtime-cli object
135 #:verbose? verbose?
136 #:format-string format-string))
137 (when verbose?
138 (format #t "~a environment:~{ ~a~}~%" object environment))
139
140 (define available?
141 (every
142 (lambda (name)
143 (oci-object-member name environment #:verbose? verbose?))
144 names))
145
146 (when verbose?
147 (format #t "~a service is~a available~%" object (if available? "" " not")))
148
149 available?)
150
151(define* (oci-image-load runtime runtime-cli tarball name tag
152 #:key verbose?
153 (format-string "{{.Repository}}:{{.Tag}}"))
154 (define load-invocation
155 (list runtime-cli "load" "-i" tarball))
156
157 (if (oci-object-exists? runtime runtime-cli "image" tag
158 #:verbose? verbose?
159 #:format-string format-string)
160 (format #t "~a image already exists, skipping.~%" tag)
161 (begin
162 (format #t "Loading image for ~a from ~a...~%" name tarball)
163
164 (let ((line (first
165 (oci-read-lines load-invocation #:verbose? verbose?))))
166 (unless (or (eof-object? line)
167 (string-null? line))
168
169 (format #t "~a~%" line)
170
171 (let* ((repository&tag
172 (string-drop line
173 (string-length
174 "Loaded image: ")))
175 (tag-invocation
176 (list runtime-cli "tag" repository&tag tag))
177 (drop-old-tag-invocation
178 (list runtime-cli "image" "rm" "-f" repository&tag)))
179
180 (unless (string=? repository&tag tag)
181 (let ((exit-code
182 (status:exit-val
183 (oci-system* tag-invocation #:verbose? verbose?))))
184 (format #t "Tagged ~a with ~a...~%" tarball tag)
185
186 (when (equal? EXIT_SUCCESS exit-code)
187 (oci-system* drop-old-tag-invocation #:verbose? verbose?))))))))))
188
189(define* (oci-container-execlp invocation #:key verbose? pre-script)
190 (when pre-script
191 (pre-script))
192 (when verbose?
193 (oci-log-verbose invocation))
194 (apply execlp (first invocation) invocation))
195
196(define* (oci-object-create runtime runtime-cli runtime-name
197 object
198 invocations
199 #:key verbose?
200 (format-string "{{.Name}}"))
201 (for-each
202 (lambda (invocation)
203 (define name (last invocation))
204 (if (oci-object-exists? runtime runtime-cli object name
205 #:format-string format-string
206 #:verbose? verbose?)
207 (format #t "~a ~a ~a already exists, skipping creation.~%"
208 runtime-name name object)
209 (oci-system* invocation #:verbose? verbose?)))
210 invocations))
diff --git a/gnu/local.mk b/gnu/local.mk
index 0bc93651997..74a85cad369 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -837,6 +837,7 @@ GNU_SYSTEM_MODULES = \
837 %D%/build/linux-initrd.scm \ 837 %D%/build/linux-initrd.scm \
838 %D%/build/linux-modules.scm \ 838 %D%/build/linux-modules.scm \
839 %D%/build/marionette.scm \ 839 %D%/build/marionette.scm \
840 %D%/build/oci-containers.scm \
840 %D%/build/secret-service.scm \ 841 %D%/build/secret-service.scm \
841 \ 842 \
842 %D%/tests.scm \ 843 %D%/tests.scm \
diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm
index 24f31c756b8..c9eadea9b47 100644
--- a/gnu/services/containers.scm
+++ b/gnu/services/containers.scm
@@ -35,12 +35,15 @@
35 #:use-module (guix diagnostics) 35 #:use-module (guix diagnostics)
36 #:use-module (guix gexp) 36 #:use-module (guix gexp)
37 #:use-module (guix i18n) 37 #:use-module (guix i18n)
38 #:use-module (guix modules)
38 #:use-module (guix monads) 39 #:use-module (guix monads)
39 #:use-module (guix packages) 40 #:use-module (guix packages)
40 #:use-module (guix profiles) 41 #:use-module (guix profiles)
41 #:use-module ((guix scripts pack) #:prefix pack:) 42 #:use-module ((guix scripts pack) #:prefix pack:)
43 #:use-module (guix records)
42 #:use-module (guix store) 44 #:use-module (guix store)
43 #:use-module (srfi srfi-1) 45 #:use-module (srfi srfi-1)
46 #:use-module (ice-9 format)
44 #:use-module (ice-9 match) 47 #:use-module (ice-9 match)
45 #:export (rootless-podman-configuration 48 #:export (rootless-podman-configuration
46 rootless-podman-configuration? 49 rootless-podman-configuration?
@@ -96,8 +99,82 @@
96 oci-container-configuration-workdir 99 oci-container-configuration-workdir
97 oci-container-configuration-extra-arguments 100 oci-container-configuration-extra-arguments
98 101
102 list-of-oci-containers?
103 list-of-oci-networks?
104 list-of-oci-volumes?
105
106 %oci-supported-runtimes
107 oci-runtime?
108 oci-runtime-system-environment
109 oci-runtime-system-extra-arguments
110 oci-runtime-system-requirement
111 oci-runtime-cli
112 oci-runtime-system-cli
113 oci-runtime-home-cli
114 oci-runtime-name
115 oci-runtime-group
116
117 oci-network-configuration
118 oci-network-configuration?
119 oci-network-configuration-fields
120 oci-network-configuration-name
121 oci-network-configuration-driver
122 oci-network-configuration-gateway
123 oci-network-configuration-internal?
124 oci-network-configuration-ip-range
125 oci-network-configuration-ipam-driver
126 oci-network-configuration-ipv6?
127 oci-network-configuration-subnet
128 oci-network-configuration-labels
129 oci-network-configuration-extra-arguments
130
131 oci-volume-configuration
132 oci-volume-configuration?
133 oci-volume-configuration-fields
134 oci-volume-configuration-name
135 oci-volume-configuration-labels
136 oci-volume-configuration-extra-arguments
137
138 oci-configuration
139 oci-configuration?
140 oci-configuration-fields
141 oci-configuration-runtime
142 oci-configuration-runtime-cli
143 oci-configuration-runtime-extra-arguments
144 oci-configuration-user
145 oci-configuration-group
146 oci-configuration-containers
147 oci-configuration-networks
148 oci-configuration-volumes
149 oci-configuration-verbose?
150 oci-configuration-valid?
151
152 oci-extension
153 oci-extension?
154 oci-extension-fields
155 oci-extension-containers
156 oci-extension-networks
157 oci-extension-volumes
158
159 oci-container-shepherd-name
160 oci-networks-shepherd-name
161 oci-networks-home-shepherd-name
162 oci-volumes-shepherd-name
163 oci-volumes-home-shepherd-name
164
165 oci-container-configuration->options
166 oci-network-configuration->options
167 oci-volume-configuration->options
168
99 oci-container-shepherd-service 169 oci-container-shepherd-service
100 %oci-container-accounts)) 170 oci-objects-merge-lst
171 oci-extension-merge
172 oci-service-type
173 oci-service-accounts
174 oci-service-profile
175 oci-service-subids
176 oci-configuration->shepherd-services
177 oci-configuration-extend))
101 178
102(define (gexp-or-string? value) 179(define (gexp-or-string? value)
103 (or (gexp? value) 180 (or (gexp? value)
@@ -296,9 +373,42 @@ to be shared. This service sets it so.")
296 373
297 374
298;;; 375;;;
299;;; OCI container. 376;;; OCI provisioning service.
300;;; 377;;;
301 378
379(define %oci-supported-runtimes
380 '(docker podman))
381
382(define (oci-runtime-system-requirement runtime)
383 "Return a list of Shepherd service names required by a given OCI runtime,
384before it is able to run containers."
385 (if (eq? 'podman runtime)
386 '(cgroups2-fs-owner cgroups2-limits
387 rootless-podman-shared-root-fs user-processes)
388 '(dockerd user-processes)))
389
390(define (oci-runtime-name runtime)
391 "Return a human readable name for a given OCI runtime."
392 (if (eq? 'podman runtime)
393 "Podman" "Docker"))
394
395(define (oci-runtime-group runtime maybe-group)
396 "Implement the logic behind selection of the group that is to be used by
397Shepherd to execute OCI commands."
398 (if (maybe-value-set? maybe-group)
399 maybe-group
400 (if (eq? 'podman runtime)
401 "cgroup"
402 "docker")))
403
404(define (oci-runtime? value)
405 (unless (member value %oci-supported-runtimes)
406 (raise
407 (formatted-message
408 (G_ "OCI runtime must be a symbol and one of ~a,
409but ~a was found") %oci-supported-runtimes value)))
410 (symbol? value))
411
302(define (oci-sanitize-pair pair delimiter) 412(define (oci-sanitize-pair pair delimiter)
303 (define (valid? member) 413 (define (valid? member)
304 (or (string? member) 414 (or (string? member)
@@ -332,21 +442,41 @@ found!")
332 ;; '(("HOME" . "/home/nobody") "JAVA_HOME=/java") 442 ;; '(("HOME" . "/home/nobody") "JAVA_HOME=/java")
333 (oci-sanitize-mixed-list "host-environment" value "=")) 443 (oci-sanitize-mixed-list "host-environment" value "="))
334 444
445(define (oci-container-host-environment? value)
446 (list? (oci-sanitize-host-environment value)))
447
335(define (oci-sanitize-environment value) 448(define (oci-sanitize-environment value)
336 ;; Expected spec format: 449 ;; Expected spec format:
337 ;; '(("HOME" . "/home/nobody") "JAVA_HOME=/java") 450 ;; '(("HOME" . "/home/nobody") "JAVA_HOME=/java")
338 (oci-sanitize-mixed-list "environment" value "=")) 451 (oci-sanitize-mixed-list "environment" value "="))
339 452
453(define (oci-container-environment? value)
454 (list? (oci-sanitize-environment value)))
455
340(define (oci-sanitize-ports value) 456(define (oci-sanitize-ports value)
341 ;; Expected spec format: 457 ;; Expected spec format:
342 ;; '(("8088" . "80") "2022:22") 458 ;; '(("8088" . "80") "2022:22")
343 (oci-sanitize-mixed-list "ports" value ":")) 459 (oci-sanitize-mixed-list "ports" value ":"))
344 460
461(define (oci-container-ports? value)
462 (list? (oci-sanitize-ports value)))
463
345(define (oci-sanitize-volumes value) 464(define (oci-sanitize-volumes value)
346 ;; Expected spec format: 465 ;; Expected spec format:
347 ;; '(("/mnt/dir" . "/dir") "/run/current-system/profile:/java") 466 ;; '(("/mnt/dir" . "/dir") "/run/current-system/profile:/java")
348 (oci-sanitize-mixed-list "volumes" value ":")) 467 (oci-sanitize-mixed-list "volumes" value ":"))
349 468
469(define (oci-container-volumes? value)
470 (list? (oci-sanitize-volumes value)))
471
472(define (oci-sanitize-labels value)
473 ;; Expected spec format:
474 ;; '(("foo" . "bar") "foo=bar")
475 (oci-sanitize-mixed-list "labels" value "="))
476
477(define (oci-object-labels? value)
478 (list? (oci-sanitize-labels value)))
479
350(define (oci-sanitize-shepherd-actions value) 480(define (oci-sanitize-shepherd-actions value)
351 (map 481 (map
352 (lambda (el) 482 (lambda (el)
@@ -358,6 +488,9 @@ found!")
358but ~a was found") el)))) 488but ~a was found") el))))
359 value)) 489 value))
360 490
491(define (oci-container-shepherd-actions? value)
492 (list? (oci-sanitize-shepherd-actions value)))
493
361(define (oci-sanitize-extra-arguments value) 494(define (oci-sanitize-extra-arguments value)
362 (define (valid? member) 495 (define (valid? member)
363 (or (string? member) 496 (or (string? member)
@@ -373,11 +506,19 @@ but ~a was found") el))))
373but ~a was found") el)))) 506but ~a was found") el))))
374 value)) 507 value))
375 508
509(define (oci-object-extra-arguments? value)
510 (list? (oci-sanitize-extra-arguments value)))
511
376(define (oci-image-reference image) 512(define (oci-image-reference image)
377 (if (string? image) 513 "Return a string OCI image reference representing IMAGE."
378 image 514 (define reference
379 (string-append (oci-image-repository image) 515 (if (string? image)
380 ":" (oci-image-tag image)))) 516 image
517 (string-append (oci-image-repository image)
518 ":" (oci-image-tag image))))
519 (if (> (length (string-split reference #\/)) 1)
520 reference
521 (string-append "localhost/" reference)))
381 522
382(define (oci-lowerable-image? image) 523(define (oci-lowerable-image? image)
383 (or (manifest? image) 524 (or (manifest? image)
@@ -392,7 +533,19 @@ but ~a was found") el))))
392(define list-of-symbols? 533(define list-of-symbols?
393 (list-of symbol?)) 534 (list-of symbol?))
394 535
536(define (list-of-oci-records? name predicate value)
537 (map
538 (lambda (el)
539 (if (predicate el)
540 el
541 (raise
542 (formatted-message
543 (G_ "~a contains an illegal value: ~a") name el))))
544 value))
545
395(define-maybe/no-serialization string) 546(define-maybe/no-serialization string)
547(define-maybe/no-serialization package)
548(define-maybe/no-serialization subid-range)
396 549
397(define-configuration/no-serialization oci-image 550(define-configuration/no-serialization oci-image
398 (repository 551 (repository
@@ -437,11 +590,15 @@ value will be ignored.")
437 590
438(define-configuration/no-serialization oci-container-configuration 591(define-configuration/no-serialization oci-container-configuration
439 (user 592 (user
440 (string "oci-container") 593 (maybe-string)
441 "The user under whose authority docker commands will be run.") 594 "The user name under whose authority OCI commands will be run. This field will
595override the @code{user} field of @code{oci-configuration}.")
442 (group 596 (group
443 (string "docker") 597 (maybe-string)
444 "The group under whose authority docker commands will be run.") 598 "The group name under whose authority OCI commands will be run. When
599using the @code{'podman} OCI runtime, this field will be ignored and the
600default group of the user configured in the @code{user} field will be used.
601This field will override the @code{group} field of @code{oci-configuration}.")
445 (command 602 (command
446 (list-of-strings '()) 603 (list-of-strings '())
447 "Overwrite the default command (@code{CMD}) of the image.") 604 "Overwrite the default command (@code{CMD}) of the image.")
@@ -449,11 +606,11 @@ value will be ignored.")
449 (maybe-string) 606 (maybe-string)
450 "Overwrite the default entrypoint (@code{ENTRYPOINT}) of the image.") 607 "Overwrite the default entrypoint (@code{ENTRYPOINT}) of the image.")
451 (host-environment 608 (host-environment
452 (list '()) 609 (oci-container-host-environment '())
453 "Set environment variables in the host environment where @command{docker run} 610 "Set environment variables in the host environment where @command{docker run}
454is invoked. This is especially useful to pass secrets from the host to the 611or @command{podman run} are invoked. This is especially useful to pass secrets
455container without having them on the @command{docker run}'s command line: by 612from the host to the container without having them on the OCI runtime command line,
456setting the @code{MYSQL_PASSWORD} on the host and by passing 613for example: by setting the @code{MYSQL_PASSWORD} on the host and by passing
457@code{--env MYSQL_PASSWORD} through the @code{extra-arguments} field, it is 614@code{--env MYSQL_PASSWORD} through the @code{extra-arguments} field, it is
458possible to securely set values in the container environment. This field's 615possible to securely set values in the container environment. This field's
459value can be a list of pairs or strings, even mixed: 616value can be a list of pairs or strings, even mixed:
@@ -467,7 +624,7 @@ Pair members can be strings, gexps or file-like objects. Strings are passed
467directly to @code{make-forkexec-constructor}." 624directly to @code{make-forkexec-constructor}."
468 (sanitizer oci-sanitize-host-environment)) 625 (sanitizer oci-sanitize-host-environment))
469 (environment 626 (environment
470 (list '()) 627 (oci-container-environment '())
471 "Set environment variables inside the container. This can be a list of pairs 628 "Set environment variables inside the container. This can be a list of pairs
472or strings, even mixed: 629or strings, even mixed:
473 630
@@ -477,15 +634,16 @@ or strings, even mixed:
477@end lisp 634@end lisp
478 635
479Pair members can be strings, gexps or file-like objects. Strings are passed 636Pair members can be strings, gexps or file-like objects. Strings are passed
480directly to the Docker CLI. You can refer to the 637directly to the OCI runtime CLI. You can refer to the
481@url{https://docs.docker.com/engine/reference/commandline/run/#env,upstream} 638@url{https://docs.docker.com/engine/reference/commandline/run/#env,Docker}
482documentation for semantics." 639or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#env-e-env,Podman}
640upstream documentation for semantics."
483 (sanitizer oci-sanitize-environment)) 641 (sanitizer oci-sanitize-environment))
484 (image 642 (image
485 (string-or-oci-image) 643 (string-or-oci-image)
486 "The image used to build the container. It can be a string or an 644 "The image used to build the container. It can be a string or an
487@code{oci-image} record. Strings are resolved by the Docker 645@code{oci-image} record. Strings are resolved by the OCI runtime,
488Engine, and follow the usual format 646and follow the usual format
489@code{myregistry.local:5000/testing/test-image:tag}.") 647@code{myregistry.local:5000/testing/test-image:tag}.")
490 (provision 648 (provision
491 (maybe-string) 649 (maybe-string)
@@ -508,15 +666,15 @@ is @code{#f} the service has to be started manually with @command{herd start}.")
508 "Whether to restart the service when it stops, for instance when the 666 "Whether to restart the service when it stops, for instance when the
509underlying process dies.") 667underlying process dies.")
510 (shepherd-actions 668 (shepherd-actions
511 (list '()) 669 (oci-container-shepherd-actions '())
512 "This is a list of @code{shepherd-action} records defining actions supported 670 "This is a list of @code{shepherd-action} records defining actions supported
513by the service." 671by the service."
514 (sanitizer oci-sanitize-shepherd-actions)) 672 (sanitizer oci-sanitize-shepherd-actions))
515 (network 673 (network
516 (maybe-string) 674 (maybe-string)
517 "Set a Docker network for the spawned container.") 675 "Set an OCI network for the spawned container.")
518 (ports 676 (ports
519 (list '()) 677 (oci-container-ports '())
520 "Set the port or port ranges to expose from the spawned container. This can 678 "Set the port or port ranges to expose from the spawned container. This can
521be a list of pairs or strings, even mixed: 679be a list of pairs or strings, even mixed:
522 680
@@ -526,12 +684,13 @@ be a list of pairs or strings, even mixed:
526@end lisp 684@end lisp
527 685
528Pair members can be strings, gexps or file-like objects. Strings are passed 686Pair members can be strings, gexps or file-like objects. Strings are passed
529directly to the Docker CLI. You can refer to the 687directly to the OCI runtime CLI. You can refer to the
530@url{https://docs.docker.com/engine/reference/commandline/run/#publish,upstream} 688@url{https://docs.docker.com/engine/reference/commandline/run/#publish,Docker}
531documentation for semantics." 689or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#publish-p-ip-hostport-containerport-protocol,Podman}
690upstream documentation for semantics."
532 (sanitizer oci-sanitize-ports)) 691 (sanitizer oci-sanitize-ports))
533 (volumes 692 (volumes
534 (list '()) 693 (oci-container-volumes '())
535 "Set volume mappings for the spawned container. This can be a 694 "Set volume mappings for the spawned container. This can be a
536list of pairs or strings, even mixed: 695list of pairs or strings, even mixed:
537 696
@@ -541,71 +700,342 @@ list of pairs or strings, even mixed:
541@end lisp 700@end lisp
542 701
543Pair members can be strings, gexps or file-like objects. Strings are passed 702Pair members can be strings, gexps or file-like objects. Strings are passed
544directly to the Docker CLI. You can refer to the 703directly to the OCI runtime CLI. You can refer to the
545@url{https://docs.docker.com/engine/reference/commandline/run/#volume,upstream} 704@url{https://docs.docker.com/engine/reference/commandline/run/#volume,Docker}
546documentation for semantics." 705or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#volume-v-source-volume-host-dir-container-dir-options,Podman}
706upstream documentation for semantics."
547 (sanitizer oci-sanitize-volumes)) 707 (sanitizer oci-sanitize-volumes))
548 (container-user 708 (container-user
549 (maybe-string) 709 (maybe-string)
550 "Set the current user inside the spawned container. You can refer to the 710 "Set the current user inside the spawned container. You can refer to the
551@url{https://docs.docker.com/engine/reference/run/#user,upstream} 711@url{https://docs.docker.com/engine/reference/run/#user,Docker}
552documentation for semantics.") 712or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#user-u-user-group,Podman}
713upstream documentation for semantics.")
553 (workdir 714 (workdir
554 (maybe-string) 715 (maybe-string)
555 "Set the current working for the spawned Shepherd service. 716 "Set the current working directory for the spawned Shepherd service.
556You can refer to the 717You can refer to the
557@url{https://docs.docker.com/engine/reference/run/#workdir,upstream} 718@url{https://docs.docker.com/engine/reference/run/#workdir,Docker}
558documentation for semantics.") 719or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#workdir-w-dir,Podman}
720upstream documentation for semantics.")
559 (extra-arguments 721 (extra-arguments
560 (list '()) 722 (oci-object-extra-arguments '())
561 "A list of strings, gexps or file-like objects that will be directly passed 723 "A list of strings, gexps or file-like objects that will be directly passed
562to the @command{docker run} invokation." 724to the @command{docker run} or @command{podman run} invocation."
563 (sanitizer oci-sanitize-extra-arguments))) 725 (sanitizer oci-sanitize-extra-arguments)))
564 726
565(define oci-container-configuration->options 727(define (list-of-oci-containers? value)
566 (lambda (config) 728 (list-of-oci-records? "containers" oci-container-configuration? value))
567 (let ((entrypoint 729
568 (oci-container-configuration-entrypoint config)) 730(define-configuration/no-serialization oci-volume-configuration
569 (network 731 (name
570 (oci-container-configuration-network config)) 732 (string)
571 (user 733 "The name of the OCI volume to provision.")
572 (oci-container-configuration-container-user config)) 734 (labels
573 (workdir 735 (oci-object-labels '())
574 (oci-container-configuration-workdir config))) 736 "The list of labels that will be used to tag the current volume."
575 (apply append 737 (sanitizer oci-sanitize-labels))
576 (filter (compose not unspecified?) 738 (extra-arguments
577 `(,(if (maybe-value-set? entrypoint) 739 (oci-object-extra-arguments '())
578 `("--entrypoint" ,entrypoint) 740 "A list of strings, gexps or file-like objects that will be directly passed
579 '()) 741to the @command{docker volume create} or @command{podman volume create}
580 ,(append-map 742invocation."
581 (lambda (spec) 743 (sanitizer oci-sanitize-extra-arguments)))
582 (list "--env" spec)) 744
583 (oci-container-configuration-environment config)) 745(define (list-of-oci-volumes? value)
584 ,(if (maybe-value-set? network) 746 (list-of-oci-records? "volumes" oci-volume-configuration? value))
585 `("--network" ,network) 747
586 '()) 748(define-configuration/no-serialization oci-network-configuration
587 ,(if (maybe-value-set? user) 749 (name
588 `("--user" ,user) 750 (string)
589 '()) 751 "The name of the OCI network to provision.")
590 ,(if (maybe-value-set? workdir) 752 (driver
591 `("--workdir" ,workdir) 753 (maybe-string)
592 '()) 754 "The driver to manage the network.")
593 ,(append-map 755 (gateway
594 (lambda (spec) 756 (maybe-string)
595 (list "-p" spec)) 757 "IPv4 or IPv6 gateway for the subnet.")
596 (oci-container-configuration-ports config)) 758 (internal?
597 ,(append-map 759 (boolean #f)
598 (lambda (spec) 760 "Restrict external access to the network")
599 (list "-v" spec)) 761 (ip-range
600 (oci-container-configuration-volumes config)))))))) 762 (maybe-string)
601 763 "Allocate container ip from a sub-range in CIDR format.")
602(define* (get-keyword-value args keyword #:key (default #f)) 764 (ipam-driver
603 (let ((kv (memq keyword args))) 765 (maybe-string)
604 (if (and kv (>= (length kv) 2)) 766 "IP Address Management Driver.")
605 (cadr kv) 767 (ipv6?
606 default))) 768 (boolean #f)
769 "Enable IPv6 networking.")
770 (subnet
771 (maybe-string)
772 "Subnet in CIDR format that represents a network segment.")
773 (labels
774 (oci-object-labels '())
775 "The list of labels that will be used to tag the current volume."
776 (sanitizer oci-sanitize-labels))
777 (extra-arguments
778 (oci-object-extra-arguments '())
779 "A list of strings, gexps or file-like objects that will be directly passed
780to the @command{docker network create} or @command{podman network create}
781invocation."
782 (sanitizer oci-sanitize-extra-arguments)))
783
784(define (list-of-oci-networks? value)
785 (list-of-oci-records? "networks" oci-network-configuration? value))
786
787(define (package-or-string? value)
788 (or (package? value) (string? value)))
789
790(define-maybe/no-serialization package-or-string)
791
792(define-configuration/no-serialization oci-configuration
793 (runtime
794 (oci-runtime 'docker)
795 "The OCI runtime to use to run commands. It can be either @code{'docker} or
796@code{'podman}.")
797 (runtime-cli
798 (maybe-package-or-string)
799 "The OCI runtime command line to be installed in the system profile and used
800to provision OCI resources, it can be either a package or a string representing
801an absolute file name to the runtime binary entrypoint. When unset it will default
802to @code{docker-cli} package for the @code{'docker} runtime or to @code{podman}
803package for the @code{'podman} runtime.")
804 (runtime-extra-arguments
805 (list '())
806 "A list of strings, gexps or file-like objects that will be placed
807after each @command{docker} or @command{podman} invokation.")
808 (user
809 (string "oci-container")
810 "The user name under whose authority OCI runtime commands will be run.")
811 (group
812 (maybe-string)
813 "The group name under whose authority OCI commands will be run. When
814using the @code{'podman} OCI runtime, this field will be ignored and the
815default group of the user configured in the @code{user} field will be used.")
816 (subuids-range
817 (maybe-subid-range)
818 "An optional @code{subid-range} record allocating subuids for the user from
819the @code{user} field. When unset, with the rootless Podman OCI runtime, it
820defaults to @code{(subid-range (name \"oci-container\"))}.")
821 (subgids-range
822 (maybe-subid-range)
823 "An optional @code{subid-range} record allocating subgids for the user from
824the @code{user} field. When unset, with the rootless Podman OCI runtime, it
825defaults to @code{(subid-range (name \"oci-container\"))}.")
826 (containers
827 (list-of-oci-containers '())
828 "The list of @code{oci-container-configuration} records representing the
829containers to provision. The use of the @code{oci-extension} record should
830be preferred for most cases.")
831 (networks
832 (list-of-oci-networks '())
833 "The list of @code{oci-network-configuration} records representing the
834networks to provision. The use of the @code{oci-extension} record should
835be preferred for most cases.")
836 (volumes
837 (list-of-oci-volumes '())
838 "The list of @code{oci-volume-configuration} records representing the
839volumes to provision. The use of the @code{oci-extension} record should
840be preferred for most cases.")
841 (verbose?
842 (boolean #f)
843 "When true, additional output will be printed, allowing to better follow the
844flow of execution.")
845 (home-service?
846 (boolean for-home?)
847 "This is an internal field denoting whether this configuration is used in a
848Guix Home context, as opposed to the default Guix System context."))
849
850(define (oci-runtime-system-environment runtime user)
851 (if (eq? runtime 'podman)
852 (list
853 #~(string-append
854 "HOME=" (passwd:dir (getpwnam #$user))))
855 #~()))
856
857(define (oci-runtime-cli runtime runtime-cli profile-directory)
858 "Return a gexp that, when lowered, evaluates to the of the OCI
859runtime command requested by the user."
860 (if (string? runtime-cli)
861 ;; It is a user defined absolute file name.
862 runtime-cli
863 #~(string-append
864 #$(if (maybe-value-set? runtime-cli)
865 runtime-cli
866 profile-directory)
867 #$(if (eq? 'podman runtime)
868 "/bin/podman"
869 "/bin/docker"))))
870
871(define* (oci-runtime-system-cli config #:key (profile-directory "/run/current-system/profile"))
872 (let ((runtime-cli
873 (oci-configuration-runtime-cli config))
874 (runtime
875 (oci-configuration-runtime config)))
876 (oci-runtime-cli runtime runtime-cli profile-directory)))
877
878(define (oci-runtime-home-cli config)
879 (let ((runtime-cli
880 (oci-configuration-runtime-cli config))
881 (runtime
882 (oci-configuration-runtime config)))
883 (oci-runtime-cli runtime runtime-cli
884 (string-append (getenv "HOME")
885 "/.guix-home/profile"))))
886
887(define-configuration/no-serialization oci-extension
888 (containers
889 (list-of-oci-containers '())
890 "The list of @code{oci-container-configuration} records representing the
891containers to add.")
892 (networks
893 (list-of-oci-networks '())
894 "The list of @code{oci-network-configuration} records representing the
895networks to add.")
896 (volumes
897 (list-of-oci-volumes '())
898 "The list of @code{oci-volume-configuration} records representing the
899volumes to add."))
900
901(define (oci-image->container-name image)
902 "Infer the name of an OCI backed Shepherd service from its OCI image."
903 (basename
904 (if (string? image)
905 (first (string-split image #\:))
906 (oci-image-repository image))))
907
908(define (oci-command-line-shepherd-action object-name invocation entrypoint)
909 "Return a Shepherd action printing a given INVOCATION of an OCI command for the
910given OBJECT-NAME."
911 (shepherd-action
912 (name 'command-line)
913 (documentation
914 (format #f "Prints ~a's OCI runtime command line invocation."
915 object-name))
916 (procedure
917 #~(lambda _
918 (format #t "Entrypoint:~%~a~%" #$entrypoint)
919 (format #t "Invocation:~%~a~%" #$invocation)))))
920
921(define (oci-container-shepherd-name runtime config)
922 "Return the name of an OCI backed Shepherd service based on CONFIG.
923The name configured in the configuration record is returned when
924CONFIG's name field has a value, otherwise a name is inferred from CONFIG's
925image field."
926 (define name (oci-container-configuration-provision config))
927 (define image (oci-container-configuration-image config))
928
929 (if (maybe-value-set? name)
930 name
931 (string-append (symbol->string runtime) "-"
932 (oci-image->container-name image))))
933
934(define (oci-networks-shepherd-name runtime)
935 "Return the name of the OCI networks provisioning Shepherd service based on
936RUNTIME."
937 (string-append (symbol->string runtime) "-networks"))
938
939(define (oci-volumes-shepherd-name runtime)
940 "Return the name of the OCI volumes provisioning Shepherd service based on
941RUNTIME."
942 (string-append (symbol->string runtime) "-volumes"))
943
944(define (oci-networks-home-shepherd-name runtime)
945 "Return the name of the OCI volumes provisioning Home Shepherd service based on
946RUNTIME."
947 (string-append "home-" (oci-networks-shepherd-name runtime)))
948
949(define (oci-volumes-home-shepherd-name runtime)
950 "Return the name of the OCI volumes provisioning Home Shepherd service based on
951RUNTIME."
952 (string-append "home-" (oci-volumes-shepherd-name runtime)))
953
954(define (oci-container-configuration->options config)
955 "Map CONFIG, an oci-container-configuration record, to a gexp that, upon
956lowering, will be evaluated to a list of strings containing command line options
957for the OCI runtime run command."
958 (let ((entrypoint (oci-container-configuration-entrypoint config))
959 (network (oci-container-configuration-network config))
960 (user (oci-container-configuration-container-user config))
961 (workdir (oci-container-configuration-workdir config)))
962 (apply append
963 (filter (compose not unspecified?)
964 (list (if (maybe-value-set? entrypoint)
965 `("--entrypoint" ,entrypoint)
966 '())
967 (append-map
968 (lambda (spec)
969 (list "--env" spec))
970 (oci-container-configuration-environment config))
971 (if (maybe-value-set? network)
972 `("--network" ,network)
973 '())
974 (if (maybe-value-set? user)
975 `("--user" ,user)
976 '())
977 (if (maybe-value-set? workdir)
978 `("--workdir" ,workdir)
979 '())
980 (append-map
981 (lambda (spec)
982 (list "-p" spec))
983 (oci-container-configuration-ports config))
984 (append-map
985 (lambda (spec)
986 (list "-v" spec))
987 (oci-container-configuration-volumes config)))))))
988
989(define (oci-network-configuration->options config)
990 "Map CONFIG, an oci-network-configuration record, to a gexp that, upon
991lowering, will be evaluated to a list of strings containing command line options
992for the OCI runtime network create command."
993 (let ((driver (oci-network-configuration-driver config))
994 (gateway (oci-network-configuration-gateway config))
995 (internal? (oci-network-configuration-internal? config))
996 (ip-range (oci-network-configuration-ip-range config))
997 (ipam-driver (oci-network-configuration-ipam-driver config))
998 (ipv6? (oci-network-configuration-ipv6? config))
999 (subnet (oci-network-configuration-subnet config)))
1000 (apply append
1001 (filter (compose not unspecified?)
1002 (list (if (maybe-value-set? driver)
1003 `("--driver" ,driver)
1004 '())
1005 (if (maybe-value-set? gateway)
1006 `("--gateway" ,gateway)
1007 '())
1008 (if internal?
1009 `("--internal")
1010 '())
1011 (if (maybe-value-set? ip-range)
1012 `("--ip-range" ,ip-range)
1013 '())
1014 (if (maybe-value-set? ipam-driver)
1015 `("--ipam-driver" ,ipam-driver)
1016 '())
1017 (if ipv6?
1018 `("--ipv6")
1019 '())
1020 (if (maybe-value-set? subnet)
1021 `("--subnet" ,subnet)
1022 '())
1023 (append-map
1024 (lambda (spec)
1025 (list "--label" spec))
1026 (oci-network-configuration-labels config)))))))
1027
1028(define (oci-volume-configuration->options config)
1029 "Map CONFIG, an oci-volume-configuration record, to a gexp that, upon
1030lowering, will be evaluated to a list of strings containing command line options
1031for the OCI runtime volume create command."
1032 (append-map
1033 (lambda (spec)
1034 (list "--label" spec))
1035 (oci-volume-configuration-labels config)))
607 1036
608(define (lower-operating-system os target system) 1037(define (lower-operating-system os target system)
1038 "Lower OS, an operating-system record, into a tarball containing an OCI image."
609 (mlet* %store-monad 1039 (mlet* %store-monad
610 ((tarball 1040 ((tarball
611 (lower-object 1041 (lower-object
@@ -614,24 +1044,11 @@ to the @command{docker run} invokation."
614 #:target target))) 1044 #:target target)))
615 (return tarball))) 1045 (return tarball)))
616 1046
617(define (lower-manifest name image target system) 1047(define (lower-manifest name value options image-reference
618 (define value (oci-image-value image)) 1048 target system grafts?)
619 (define options (oci-image-pack-options image)) 1049 "Lower VALUE, a manifest record, into a tarball containing an OCI image."
620 (define image-reference
621 (oci-image-reference image))
622 (define image-tag
623 (let* ((extra-options
624 (get-keyword-value options #:extra-options))
625 (image-tag-option
626 (and extra-options
627 (get-keyword-value extra-options #:image-tag))))
628 (if image-tag-option
629 '()
630 `(#:extra-options (#:image-tag ,image-reference)))))
631
632 (mlet* %store-monad 1050 (mlet* %store-monad
633 ((_ (set-grafting 1051 ((_ (set-grafting grafts?))
634 (oci-image-grafts? image)))
635 (guile (set-guile-for-build (default-guile))) 1052 (guile (set-guile-for-build (default-guile)))
636 (profile 1053 (profile
637 (profile-derivation value 1054 (profile-derivation value
@@ -642,14 +1059,11 @@ to the @command{docker run} invokation."
642 (tarball (apply pack:docker-image 1059 (tarball (apply pack:docker-image
643 `(,name ,profile 1060 `(,name ,profile
644 ,@options 1061 ,@options
645 ,@image-tag
646 #:localstatedir? #t)))) 1062 #:localstatedir? #t))))
647 (return tarball))) 1063 (return tarball)))
648 1064
649(define (lower-oci-image name image) 1065(define (lower-oci-image-state name value options reference
650 (define value (oci-image-value image)) 1066 image-target image-system grafts?)
651 (define image-target (oci-image-target image))
652 (define image-system (oci-image-system image))
653 (define target 1067 (define target
654 (if (maybe-value-set? image-target) 1068 (if (maybe-value-set? image-target)
655 image-target 1069 image-target
@@ -662,7 +1076,8 @@ to the @command{docker run} invokation."
662 (run-with-store store 1076 (run-with-store store
663 (match value 1077 (match value
664 ((? manifest? value) 1078 ((? manifest? value)
665 (lower-manifest name image target system)) 1079 (lower-manifest name value options reference
1080 target system grafts?))
666 ((? operating-system? value) 1081 ((? operating-system? value)
667 (lower-operating-system value target system)) 1082 (lower-operating-system value target system))
668 ((or (? gexp? value) 1083 ((or (? gexp? value)
@@ -677,113 +1092,661 @@ operating-system, gexp or file-like records but ~a was found")
677 #:target target 1092 #:target target
678 #:system system))) 1093 #:system system)))
679 1094
680(define (%oci-image-loader name image tag) 1095(define (lower-oci-image name image)
681 (let ((docker (file-append docker-cli "/bin/docker")) 1096 "Lower IMAGE, a oci-image record, into a tarball containing an OCI image."
682 (tarball (lower-oci-image name image))) 1097 (lower-oci-image-state
683 (with-imported-modules '((guix build utils)) 1098 name
684 (program-file (format #f "~a-image-loader" name) 1099 (oci-image-value image)
1100 (oci-image-pack-options image)
1101 (oci-image-reference image)
1102 (oci-image-target image)
1103 (oci-image-system image)
1104 (oci-image-grafts? image)))
1105
1106(define-record-type* <oci-runtime-state>
1107 oci-runtime-state
1108 make-oci-runtime-state
1109 oci-runtime-state?
1110 this-oci-runtime-state
1111
1112 (runtime oci-runtime-state-runtime
1113 (default 'docker))
1114 (runtime-cli oci-runtime-state-runtime-cli)
1115 (user oci-runtime-state-user)
1116 (group oci-runtime-state-group)
1117 (runtime-environment oci-runtime-state-runtime-environment
1118 (default #~()))
1119 (runtime-requirement oci-runtime-state-runtime-requirement
1120 (default '()))
1121 (runtime-extra-arguments oci-runtime-state-runtime-extra-arguments
1122 (default '())))
1123
1124(define-record-type* <oci-state>
1125 oci-state
1126 make-oci-state
1127 oci-state?
1128 this-oci-state
1129
1130 (networks oci-state-networks)
1131 (volumes oci-state-volumes)
1132 (containers oci-state-containers)
1133 (networks-name oci-state-networks-name
1134 (default #f))
1135 (volumes-name oci-state-volumes-name
1136 (default #f))
1137 (networks-requirement oci-state-networks-requirement
1138 (default '()))
1139 (volumes-requirement oci-state-volumes-requirement
1140 (default '()))
1141 (containers-requirement oci-state-containers-requirement
1142 (default '())))
1143
1144(define-record-type* <oci-container-invocation>
1145 oci-container-invocation
1146 make-oci-container-invocation
1147 oci-container-invocation?
1148 this-oci-container-invocation
1149
1150 (runtime oci-container-invocation-runtime
1151 (default 'docker))
1152 (runtime-cli oci-container-invocation-runtime-cli)
1153 (name oci-container-invocation-name)
1154 (command oci-container-invocation-command
1155 (default '()))
1156 (image-reference oci-container-invocation-image-reference)
1157 (options oci-container-invocation-options
1158 (default '()))
1159 (run-extra-arguments oci-container-invocation-run-extra-arguments
1160 (default '()))
1161 (runtime-extra-arguments oci-container-invocation-runtime-extra-arguments
1162 (default '())))
1163
1164(define (oci-container-configuration->oci-container-invocation runtime-state
1165 config)
1166 (oci-container-invocation
1167 (runtime (oci-runtime-state-runtime runtime-state))
1168 (runtime-cli (oci-runtime-state-runtime-cli runtime-state))
1169 (name
1170 (oci-container-shepherd-name runtime config))
1171 (command
1172 (oci-container-configuration-command config))
1173 (image-reference
1174 (oci-image-reference (oci-container-configuration-image config)))
1175 (options
1176 (oci-container-configuration->options config))
1177 (run-extra-arguments
1178 (oci-container-configuration-extra-arguments config))
1179 (runtime-extra-arguments
1180 (oci-runtime-state-runtime-extra-arguments runtime-state))))
1181
1182(define* (oci-image-loader runtime-state name image tag #:key verbose?)
1183 "Return a file-like object that, once lowered, will evaluate to a program able
1184to load IMAGE through RUNTIME-CLI and to tag it with TAG afterwards."
1185 (let ((tarball (lower-oci-image name image)))
1186 (with-imported-modules (source-module-closure '((gnu build oci-containers)))
1187 (program-file
1188 (format #f "~a-image-loader" name)
685 #~(begin 1189 #~(begin
686 (use-modules (guix build utils) 1190 (use-modules (gnu build oci-containers))
687 (ice-9 popen) 1191 (oci-image-load '#$(oci-runtime-state-runtime runtime-state)
688 (ice-9 rdelim)) 1192 #$(oci-runtime-state-runtime-cli runtime-state)
689 1193 #$tarball #$name #$tag
690 (format #t "Loading image for ~a from ~a...~%" #$name #$tarball) 1194 #:verbose? #$verbose?))))))
691 (define line 1195
692 (read-line 1196(define (oci-container-run-invocation container-invocation)
693 (open-input-pipe 1197 "Return a list representing the OCI runtime
694 (string-append #$docker " load -i " #$tarball)))) 1198invocation for running containers."
695 1199 ;; run [OPTIONS] IMAGE [COMMAND] [ARG...]
696 (unless (or (eof-object? line) 1200 `(,(oci-container-invocation-runtime-cli container-invocation)
697 (string-null? line)) 1201 ,@(oci-container-invocation-runtime-extra-arguments container-invocation)
698 (format #t "~a~%" line) 1202 "run" "--rm"
699 (let ((repository&tag 1203 ,@(if (eq? (oci-container-invocation-runtime container-invocation)
700 (string-drop line 1204 'podman)
701 (string-length 1205 ;; This is because podman takes some time to
702 "Loaded image: ")))) 1206 ;; release container names. --replace seems
703 1207 ;; to be required to be able to restart services.
704 (invoke #$docker "tag" repository&tag #$tag) 1208 '("--replace")
705 (format #t "Tagged ~a with ~a...~%" #$tarball #$tag)))))))) 1209 '())
706 1210 "--name" ,(oci-container-invocation-name container-invocation)
707(define (oci-container-shepherd-service config) 1211 ,@(oci-container-invocation-options container-invocation)
708 (define (guess-name name image) 1212 ,@(oci-container-invocation-run-extra-arguments container-invocation)
709 (if (maybe-value-set? name) 1213 ,(oci-container-invocation-image-reference container-invocation)
710 name 1214 ,@(oci-container-invocation-command container-invocation)))
711 (string-append "docker-" 1215
712 (basename 1216(define* (oci-container-entrypoint name invocation
713 (if (string? image) 1217 #:key verbose?
714 (first (string-split image #\:)) 1218 (pre-script #~()))
715 (oci-image-repository image)))))) 1219 "Return a file-like object that, once lowered, will evaluate to the entrypoint
716 1220for the Shepherd service that will run INVOCATION."
717 (let* ((docker (file-append docker-cli "/bin/docker")) 1221 (program-file
718 (actions (oci-container-configuration-shepherd-actions config)) 1222 (string-append "oci-entrypoint-" name)
719 (auto-start? 1223 (with-imported-modules (source-module-closure
720 (oci-container-configuration-auto-start? config)) 1224 '((gnu build oci-containers)))
721 (user (oci-container-configuration-user config)) 1225 #~(begin
722 (group (oci-container-configuration-group config)) 1226 (use-modules (gnu build oci-containers)
723 (host-environment 1227 (srfi srfi-1))
724 (oci-container-configuration-host-environment config)) 1228 (oci-container-execlp
725 (command (oci-container-configuration-command config)) 1229 (list #$@invocation)
726 (log-file (oci-container-configuration-log-file config)) 1230 #:verbose? #$verbose?
727 (provision (oci-container-configuration-provision config)) 1231 #:pre-script
728 (requirement (oci-container-configuration-requirement config)) 1232 (lambda _
729 (respawn? 1233 (when (and #$verbose?
730 (oci-container-configuration-respawn? config)) 1234 (zero? (length '(#$@pre-script))))
731 (image (oci-container-configuration-image config)) 1235 (format #t "No pre script to run..."))
732 (image-reference (oci-image-reference image)) 1236 #$@pre-script))))))
733 (options (oci-container-configuration->options config)) 1237
734 (name (guess-name provision image)) 1238(define* (oci-container-shepherd-service state runtime-state config
735 (extra-arguments 1239 #:key verbose?
736 (oci-container-configuration-extra-arguments config))) 1240 networks?
737 1241 volumes?)
738 (shepherd-service (provision `(,(string->symbol name))) 1242 "Return a Shepherd service object that will run the OCI container represented
739 (requirement `(dockerd user-processes ,@requirement)) 1243by CONFIG through RUNTIME-CLI."
1244 (match-record config <oci-container-configuration>
1245 (shepherd-actions auto-start? user group host-environment
1246 log-file requirement respawn? image)
1247 (define runtime (oci-runtime-state-runtime runtime-state))
1248 (define runtime-cli (oci-runtime-state-runtime-cli runtime-state))
1249 (define image-reference (oci-image-reference image))
1250 (define shepherd-name (oci-container-shepherd-name runtime config))
1251 (define oci-container-user
1252 (if (maybe-value-set? user)
1253 user
1254 (oci-runtime-state-user runtime-state)))
1255 (define oci-container-group
1256 (if (maybe-value-set? group)
1257 group
1258 (oci-runtime-state-group runtime-state)))
1259 (define networks-service
1260 (if networks?
1261 (list
1262 (string->symbol
1263 (oci-state-networks-name state)))
1264 '()))
1265 (define volumes-service
1266 (if volumes?
1267 (list
1268 (string->symbol
1269 (oci-state-volumes-name state)))
1270 '()))
1271 (define oci-container-requirement
1272 (append requirement
1273 (oci-state-containers-requirement state)
1274 (oci-runtime-state-runtime-requirement runtime-state)
1275 networks-service
1276 volumes-service))
1277 (define environment-variables
1278 #~(append
1279 (list #$@host-environment)
1280 (list #$@(oci-runtime-state-runtime-environment runtime-state))))
1281 (define invocation
1282 (oci-container-run-invocation
1283 (oci-container-configuration->oci-container-invocation
1284 runtime-state config)))
1285 (define* (container-action command)
1286 #~(lambda _
1287 (fork+exec-command
1288 (list #$@command)
1289 #$@(if oci-container-user
1290 (list #:user oci-container-user)
1291 '())
1292 #$@(if oci-container-group
1293 (list #:group oci-container-group)
1294 '())
1295 #$@(if (maybe-value-set? log-file)
1296 (list #:log-file log-file)
1297 '())
1298 #$@(if (and oci-container-user (eq? runtime 'podman))
1299 (list #:directory
1300 #~(passwd:dir
1301 (getpwnam #$oci-container-user)))
1302 '())
1303 #:environment-variables
1304 #$environment-variables)))
1305 (define start-entrypoint
1306 (oci-container-entrypoint
1307 shepherd-name invocation
1308 #:verbose? verbose?
1309 #:pre-script
1310 (if (oci-image? image)
1311 #~((system*
1312 #$(oci-image-loader
1313 runtime-state shepherd-name image
1314 image-reference
1315 #:verbose? verbose?)))
1316 #~())))
1317
1318 (shepherd-service (provision `(,(string->symbol shepherd-name)))
1319 (requirement oci-container-requirement)
740 (respawn? respawn?) 1320 (respawn? respawn?)
741 (auto-start? auto-start?) 1321 (auto-start? auto-start?)
742 (documentation 1322 (documentation
743 (string-append 1323 (string-append
744 "Docker backed Shepherd service for " 1324 (oci-runtime-name runtime)
745 (if (oci-image? image) name image) ".")) 1325 " backed Shepherd service for "
1326 (if (oci-image? image) shepherd-name image) "."))
746 (start 1327 (start
747 #~(lambda () 1328 (container-action
748 #$@(if (oci-image? image) 1329 (list start-entrypoint)))
749 #~((invoke #$(%oci-image-loader
750 name image image-reference)))
751 #~())
752 (fork+exec-command
753 ;; docker run [OPTIONS] IMAGE [COMMAND] [ARG...]
754 (list #$docker "run" "--rm" "--name" #$name
755 #$@options #$@extra-arguments
756 #$image-reference #$@command)
757 #:user #$user
758 #:group #$group
759 #$@(if (maybe-value-set? log-file)
760 (list #:log-file log-file)
761 '())
762 #:environment-variables
763 (list #$@host-environment))))
764 (stop 1330 (stop
765 #~(lambda _ 1331 (container-action
766 (invoke #$docker "rm" "-f" #$name))) 1332 (list
1333 (oci-container-entrypoint
1334 shepherd-name (list runtime-cli "rm" "-f" shepherd-name)
1335 #:verbose? verbose?))))
767 (actions 1336 (actions
768 (if (oci-image? image) 1337 (append
769 '() 1338 (list
770 (append 1339 (oci-command-line-shepherd-action
1340 shepherd-name #~(string-join (list #$@invocation) " ")
1341 start-entrypoint))
1342 (if (oci-image? image)
1343 '()
771 (list 1344 (list
772 (shepherd-action 1345 (shepherd-action
773 (name 'pull) 1346 (name 'pull)
774 (documentation 1347 (documentation
775 (format #f "Pull ~a's image (~a)." 1348 (format #f "Pull ~a's image (~a)."
776 name image)) 1349 shepherd-name image))
777 (procedure 1350 (procedure
778 #~(lambda _ 1351 (container-action
779 (invoke #$docker "pull" #$image))))) 1352 (list
780 actions)))))) 1353 (oci-container-entrypoint
781 1354 shepherd-name (list runtime-cli "pull" image)
782(define %oci-container-accounts 1355 #:verbose? verbose?)))))))
1356 shepherd-actions)))))
1357
1358(define (oci-object-create-invocation object runtime-cli name options
1359 runtime-extra-arguments
1360 create-extra-arguments)
1361 "Return a gexp that, upon lowering, will evaluate to the OCI runtime
1362invocation for creating networks and volumes."
1363 ;; network|volume create [options] [NAME]
1364 #~(list #$runtime-cli #$@runtime-extra-arguments #$object "create"
1365 #$@options #$@create-extra-arguments #$name))
1366
1367(define (format-oci-invocations invocations)
1368 "Return a gexp that, upon lowering, will evaluate to a formatted message
1369containing the INVOCATIONS that the OCI runtime will execute to provision
1370networks or volumes."
1371 #~(string-join (map (lambda (i) (string-join i " "))
1372 (list #$@invocations))
1373 "\n"))
1374
1375(define* (oci-object-create-script object runtime runtime-cli invocations
1376 #:key verbose?)
1377 "Return a file-like object that, once lowered, will evaluate to a program able
1378to create OCI networks and volumes through RUNTIME-CLI."
1379 (define runtime-string (symbol->string runtime))
1380 (define runtime-name (oci-runtime-name runtime))
1381 (with-imported-modules (source-module-closure
1382 '((gnu build oci-containers)))
1383
1384 (program-file
1385 (string-append runtime-string "-" object "s-create.scm")
1386 #~(begin
1387 (use-modules (gnu build oci-containers))
1388 (oci-object-create '#$runtime #$runtime-cli #$runtime-name
1389 #$object (list #$@invocations)
1390 #:verbose? #$verbose?)))))
1391
1392(define* (oci-object-shepherd-service object runtime-state name
1393 oci-state-requirement invocations
1394 #:key verbose?)
1395 "Return a Shepherd service object that will provision the OBJECTs represented
1396by INVOCATIONS through RUNTIME-STATE."
1397 (match-record runtime-state <oci-runtime-state>
1398 (runtime runtime-cli runtime-requirement user group
1399 runtime-environment)
1400 (define entrypoint
1401 (oci-object-create-script
1402 object runtime runtime-cli invocations #:verbose? verbose?))
1403 (define requirement
1404 (append runtime-requirement oci-state-requirement))
1405
1406 (shepherd-service (provision (list (string->symbol name)))
1407 (requirement requirement)
1408 (one-shot? #t)
1409 (documentation
1410 (string-append
1411 (oci-runtime-name runtime) " " object
1412 " provisioning service"))
1413 (start
1414 #~(lambda _
1415 (fork+exec-command
1416 (list #$entrypoint)
1417 #$@(if user (list #:user user) '())
1418 #$@(if group (list #:group group) '())
1419 #:environment-variables
1420 (list #$@runtime-environment))))
1421 (actions
1422 (list
1423 (oci-command-line-shepherd-action
1424 name (format-oci-invocations invocations)
1425 entrypoint))))))
1426
1427(define* (oci-networks-shepherd-service state runtime-state
1428 #:key verbose?)
1429 "Return a Shepherd service object that will create the networks represented
1430in STATE."
1431 (define runtime-cli
1432 (oci-runtime-state-runtime-cli runtime-state))
1433 (define invocations
1434 (map
1435 (lambda (network)
1436 (oci-object-create-invocation
1437 "network" runtime-cli
1438 (oci-network-configuration-name network)
1439 (oci-network-configuration->options network)
1440 (oci-runtime-state-runtime-extra-arguments runtime-state)
1441 (oci-network-configuration-extra-arguments network)))
1442 (oci-state-networks state)))
1443
1444 (oci-object-shepherd-service
1445 "network" runtime-state (oci-state-networks-name state)
1446 (oci-state-networks-requirement state)
1447 invocations #:verbose? verbose?))
1448
1449(define* (oci-volumes-shepherd-service state runtime-state
1450 #:key verbose?)
1451 "Return a Shepherd service object that will create the volumes represented
1452in STATE."
1453 (define runtime-cli
1454 (oci-runtime-state-runtime-cli runtime-state))
1455 (define invocations
1456 (map
1457 (lambda (volume)
1458 (oci-object-create-invocation
1459 "volume" runtime-cli
1460 (oci-volume-configuration-name volume)
1461 (oci-volume-configuration->options volume)
1462 (oci-runtime-state-runtime-extra-arguments runtime-state)
1463 (oci-volume-configuration-extra-arguments volume)))
1464 (oci-state-volumes state)))
1465
1466 (oci-object-shepherd-service
1467 "volume" runtime-state (oci-state-volumes-name state)
1468 (oci-state-volumes-requirement state)
1469 invocations #:verbose? verbose?))
1470
1471(define (oci-service-accounts config)
1472 (define user (oci-configuration-user config))
1473 (define maybe-group (oci-configuration-group config))
1474 (define runtime (oci-configuration-runtime config))
783 (list (user-account 1475 (list (user-account
784 (name "oci-container") 1476 (name user)
785 (comment "OCI services account") 1477 (comment "OCI services account")
786 (group "docker") 1478 (group "users")
787 (system? #t) 1479 (supplementary-groups
788 (home-directory "/var/empty") 1480 (list (oci-runtime-group runtime maybe-group)))
1481 (system? (eq? 'docker runtime))
1482 (home-directory (if (eq? 'podman runtime)
1483 (string-append "/home/" user)
1484 "/var/empty"))
1485 (create-home-directory? (eq? 'podman runtime))
789 (shell (file-append shadow "/sbin/nologin"))))) 1486 (shell (file-append shadow "/sbin/nologin")))))
1487
1488(define* (oci-state->shepherd-services state runtime-state #:key verbose?)
1489 "Returns a list of Shepherd services based on the input OCI state."
1490 (define networks?
1491 (> (length (oci-state-networks state)) 0))
1492 (define volumes?
1493 (> (length (oci-state-volumes state)) 0))
1494 (append
1495 (map
1496 (lambda (c)
1497 (oci-container-shepherd-service
1498 state runtime-state c
1499 #:verbose? verbose?
1500 #:volumes? volumes?
1501 #:networks? networks?))
1502 (oci-state-containers state))
1503 (if networks?
1504 (list
1505 (oci-networks-shepherd-service
1506 state runtime-state
1507 #:verbose? verbose?))
1508 '())
1509 (if volumes?
1510 (list
1511 (oci-volumes-shepherd-service
1512 state runtime-state
1513 #:verbose? verbose?))
1514 '())))
1515
1516(define* (oci-configuration->oci-runtime-state config #:key verbose?)
1517 (define runtime
1518 (oci-configuration-runtime config))
1519 (define home-service?
1520 (oci-configuration-home-service? config))
1521 (define runtime-cli
1522 (if home-service?
1523 (oci-runtime-home-cli config)
1524 (oci-runtime-system-cli config)))
1525 (define user
1526 (if home-service?
1527 #f
1528 (oci-configuration-user config)))
1529 (define group
1530 (if home-service?
1531 #f
1532 (if (eq? runtime 'podman)
1533 #~(group:name
1534 (getgrgid
1535 (passwd:gid
1536 (getpwnam #$user))))
1537 (oci-runtime-group config (oci-configuration-group config)))))
1538 (define runtime-requirement
1539 (if home-service?
1540 '()
1541 (oci-runtime-system-requirement runtime)))
1542 (define runtime-environment
1543 (if home-service?
1544 #~()
1545 (oci-runtime-system-environment runtime user)))
1546 (oci-runtime-state
1547 (runtime runtime)
1548 (runtime-cli runtime-cli)
1549 (user user)
1550 (group group)
1551 (runtime-extra-arguments
1552 (oci-configuration-runtime-extra-arguments config))
1553 (runtime-environment runtime-environment)
1554 (runtime-requirement runtime-requirement)))
1555
1556(define (oci-configuration->oci-state config)
1557 (define runtime
1558 (oci-configuration-runtime config))
1559 (define home-service?
1560 (oci-configuration-home-service? config))
1561 (define networks-name
1562 (if home-service?
1563 (oci-networks-home-shepherd-name runtime)
1564 (oci-networks-shepherd-name runtime)))
1565 (define volumes-name
1566 (if home-service?
1567 (oci-volumes-home-shepherd-name runtime)
1568 (oci-volumes-shepherd-name runtime)))
1569 (define networks-requirement
1570 (if home-service?
1571 '()
1572 '(networking)))
1573 (oci-state
1574 (containers (oci-configuration-containers config))
1575 (networks (oci-configuration-networks config))
1576 (volumes (oci-configuration-volumes config))
1577 (networks-name networks-name)
1578 (volumes-name volumes-name)
1579 (networks-requirement networks-requirement)))
1580
1581(define (oci-configuration->shepherd-services config)
1582 (let* ((verbose? (oci-configuration-verbose? config))
1583 (state (oci-configuration->oci-state config))
1584 (runtime-state
1585 (oci-configuration->oci-runtime-state config #:verbose? verbose?)))
1586 (oci-state->shepherd-services state runtime-state #:verbose? verbose?)))
1587
1588(define (oci-service-subids config)
1589 "Return a subids-extension record representing subuids and subgids required by
1590the rootless Podman backend."
1591 (define (find-duplicates subids)
1592 (let loop ((names '())
1593 (subids subids))
1594 (if (null? names)
1595 names
1596 (loop
1597 (let ((name (subid-range-name (car subids))))
1598 (if (member name names)
1599 (raise
1600 (formatted-message
1601 (G_ "Duplicated subid-range: ~a. subid-ranges names should be
1602unique, please remove the duplicate.") name))
1603 (cons name names)))
1604 (cdr subids)))))
1605
1606 (define runtime
1607 (oci-configuration-runtime config))
1608 (define user
1609 (oci-configuration-user config))
1610
1611 (define subgids (oci-configuration-subgids-range config))
1612 (find-duplicates subgids)
1613
1614 (define subuids (oci-configuration-subuids-range config))
1615 (find-duplicates subgids)
1616
1617 (define container-users
1618 (filter (lambda (range)
1619 (and (maybe-value-set?
1620 (subid-range-name range))
1621 (not (string=? (subid-range-name range) user))))
1622 (map (lambda (container)
1623 (subid-range
1624 (name
1625 (oci-container-configuration-user container))))
1626 (oci-configuration-containers config))))
1627 (define subgid-ranges
1628 (cons
1629 (if (maybe-value-set? subgids)
1630 subgids
1631 (subid-range (name user)))
1632 container-users))
1633 (define subuid-ranges
1634 (cons
1635 (if (maybe-value-set? subuids)
1636 subuids
1637 (subid-range (name user)))
1638 container-users))
1639
1640 (if (eq? 'podman runtime)
1641 (subids-extension
1642 (subgids
1643 subgid-ranges)
1644 (subuids
1645 subuid-ranges))
1646 (subids-extension)))
1647
1648(define (oci-objects-merge-lst a b object get-name)
1649 (define (contains? value lst)
1650 (member value (map get-name lst)))
1651 (let loop ((merged '())
1652 (lst (append a b)))
1653 (if (null? lst)
1654 merged
1655 (loop
1656 (let ((element (car lst)))
1657 (when (contains? element merged)
1658 (raise
1659 (formatted-message
1660 (G_ "Duplicated ~a: ~a. Names of ~a should be unique, please
1661remove the duplicate.") object (get-name element) object)))
1662 (cons element merged))
1663 (cdr lst)))))
1664
1665(define (oci-extension-merge a b)
1666 (oci-extension
1667 (containers (oci-objects-merge-lst
1668 (oci-extension-containers a)
1669 (oci-extension-containers b)
1670 "container"
1671 (lambda (config)
1672 (define maybe-name
1673 (oci-container-configuration-provision config))
1674 (if (maybe-value-set? maybe-name)
1675 maybe-name
1676 (oci-image->container-name
1677 (oci-container-configuration-image config))))))
1678 (networks (oci-objects-merge-lst
1679 (oci-extension-networks a)
1680 (oci-extension-networks b)
1681 "network"
1682 oci-network-configuration-name))
1683 (volumes (oci-objects-merge-lst
1684 (oci-extension-volumes a)
1685 (oci-extension-volumes b)
1686 "volume"
1687 oci-volume-configuration-name))))
1688
1689(define (oci-service-profile runtime runtime-cli)
1690 `(,bash-minimal
1691 ,@(if (string? runtime-cli)
1692 '()
1693 (list
1694 (cond
1695 ((maybe-value-set? runtime-cli)
1696 runtime-cli)
1697 ((eq? 'podman runtime)
1698 podman)
1699 (else
1700 docker-cli))))))
1701
1702(define (oci-configuration-extend config extension)
1703 (oci-configuration
1704 (inherit config)
1705 (containers
1706 (oci-objects-merge-lst
1707 (oci-configuration-containers config)
1708 (oci-extension-containers extension)
1709 "container"
1710 (lambda (oci-config)
1711 (define runtime
1712 (oci-configuration-runtime config))
1713 (oci-container-shepherd-name runtime oci-config))))
1714 (networks (oci-objects-merge-lst
1715 (oci-configuration-networks config)
1716 (oci-extension-networks extension)
1717 "network"
1718 oci-network-configuration-name))
1719 (volumes (oci-objects-merge-lst
1720 (oci-configuration-volumes config)
1721 (oci-extension-volumes extension)
1722 "volume"
1723 oci-volume-configuration-name))))
1724
1725(define oci-service-type
1726 (service-type
1727 (name 'oci)
1728 (extensions
1729 (list
1730 (service-extension profile-service-type
1731 (lambda (config)
1732 (let ((runtime-cli
1733 (oci-configuration-runtime-cli config))
1734 (runtime
1735 (oci-configuration-runtime config)))
1736 (oci-service-profile runtime runtime-cli))))
1737 (service-extension subids-service-type
1738 oci-service-subids)
1739 (service-extension account-service-type
1740 oci-service-accounts)
1741 (service-extension shepherd-root-service-type
1742 oci-configuration->shepherd-services)))
1743 ;; Concatenate OCI object lists.
1744 (compose (lambda (args)
1745 (fold oci-extension-merge
1746 (oci-extension)
1747 args)))
1748 (extend oci-configuration-extend)
1749 (default-value (oci-configuration))
1750 (description
1751 "This service implements the provisioning of OCI objects such
1752as containers, networks and volumes.")))
diff --git a/gnu/services/docker.scm b/gnu/services/docker.scm
index 828ceea313a..6abfbc49a0b 100644
--- a/gnu/services/docker.scm
+++ b/gnu/services/docker.scm
@@ -31,7 +31,10 @@
31 #:use-module (gnu system shadow) 31 #:use-module (gnu system shadow)
32 #:use-module (gnu packages docker) 32 #:use-module (gnu packages docker)
33 #:use-module (gnu packages linux) ;singularity 33 #:use-module (gnu packages linux) ;singularity
34 #:use-module (guix deprecation)
35 #:use-module (guix diagnostics)
34 #:use-module (guix gexp) 36 #:use-module (guix gexp)
37 #:use-module (guix i18n)
35 #:use-module (guix records) 38 #:use-module (guix records)
36 #:use-module (srfi srfi-1) 39 #:use-module (srfi srfi-1)
37 #:use-module (ice-9 format) 40 #:use-module (ice-9 format)
@@ -67,16 +70,18 @@
67 oci-container-configuration-volumes 70 oci-container-configuration-volumes
68 oci-container-configuration-container-user 71 oci-container-configuration-container-user
69 oci-container-configuration-workdir 72 oci-container-configuration-workdir
70 oci-container-configuration-extra-arguments 73 oci-container-configuration-extra-arguments)
71 oci-container-shepherd-service
72 %oci-container-accounts)
73 74
74 #:export (containerd-configuration 75 #:export (containerd-configuration
75 containerd-service-type 76 containerd-service-type
76 docker-configuration 77 docker-configuration
77 docker-service-type 78 docker-service-type
78 singularity-service-type 79 singularity-service-type
79 oci-container-service-type)) 80 ;; For backwards compatibility, until the
81 ;; oci-container-service-type is fully deprecated.
82 oci-container-shepherd-service
83 oci-container-service-type
84 %oci-container-accounts))
80 85
81(define-maybe file-like) 86(define-maybe file-like)
82 87
@@ -297,17 +302,26 @@ bundles in Docker containers.")
297;;; OCI container. 302;;; OCI container.
298;;; 303;;;
299 304
300(define (configs->shepherd-services configs) 305;; For backwards compatibility, until the
301 (map oci-container-shepherd-service configs)) 306;; oci-container-service-type is fully deprecated.
307(define-deprecated (oci-container-shepherd-service config)
308 oci-service-type
309 ((@ (gnu services containers) oci-container-shepherd-service)
310 'docker config))
311(define %oci-container-accounts
312 (filter user-account? (oci-service-accounts (oci-configuration))))
302 313
303(define oci-container-service-type 314(define oci-container-service-type
304 (service-type (name 'oci-container) 315 (service-type (name 'oci-container)
305 (extensions (list (service-extension profile-service-type 316 (extensions
306 (lambda _ (list docker-cli))) 317 (list (service-extension oci-service-type
307 (service-extension account-service-type 318 (lambda (containers)
308 (const %oci-container-accounts)) 319 (warning
309 (service-extension shepherd-root-service-type 320 (G_
310 configs->shepherd-services))) 321 "'oci-container-service-type' is\
322 deprecated, use 'oci-service-type' instead~%"))
323 (oci-extension
324 (containers containers))))))
311 (default-value '()) 325 (default-value '())
312 (extend append) 326 (extend append)
313 (compose concatenate) 327 (compose concatenate)
diff --git a/gnu/tests/containers.scm b/gnu/tests/containers.scm
index 618da2a92ce..1a442cddc64 100644
--- a/gnu/tests/containers.scm
+++ b/gnu/tests/containers.scm
@@ -27,6 +27,9 @@
27 #:use-module (gnu services) 27 #:use-module (gnu services)
28 #:use-module (gnu services containers) 28 #:use-module (gnu services containers)
29 #:use-module (gnu services desktop) 29 #:use-module (gnu services desktop)
30 #:use-module ((gnu services docker)
31 #:select (containerd-service-type
32 docker-service-type))
30 #:use-module (gnu services dbus) 33 #:use-module (gnu services dbus)
31 #:use-module (gnu services networking) 34 #:use-module (gnu services networking)
32 #:use-module (gnu system) 35 #:use-module (gnu system)
@@ -39,7 +42,9 @@
39 #:use-module (guix profiles) 42 #:use-module (guix profiles)
40 #:use-module ((guix scripts pack) #:prefix pack:) 43 #:use-module ((guix scripts pack) #:prefix pack:)
41 #:use-module (guix store) 44 #:use-module (guix store)
42 #:export (%test-rootless-podman)) 45 #:export (%test-rootless-podman
46 %test-oci-service-rootless-podman
47 %test-oci-service-docker))
43 48
44 49
45(define %rootless-podman-os 50(define %rootless-podman-os
@@ -133,7 +138,7 @@
133 (status (close-pipe port))) 138 (status (close-pipe port)))
134 output))) 139 output)))
135 (let* ((bash 140 (let* ((bash
136 ,(string-append #$bash "/bin/bash")) 141 (string-append #$bash "/bin/bash"))
137 (response1 142 (response1
138 (slurp bash "-c" 143 (slurp bash "-c"
139 (string-append "ls -la /sys/fs/cgroup | " 144 (string-append "ls -la /sys/fs/cgroup | "
@@ -345,3 +350,555 @@ standard output device and then enters a new line.")
345 (name "rootless-podman") 350 (name "rootless-podman")
346 (description "Test rootless Podman service.") 351 (description "Test rootless Podman service.")
347 (value (build-tarball&run-rootless-podman-test)))) 352 (value (build-tarball&run-rootless-podman-test))))
353
354
355(define %oci-network
356 (oci-network-configuration (name "my-network")))
357
358(define %oci-volume
359 (oci-volume-configuration (name "my-volume")))
360
361(define %oci-wait-for-file
362 #~(define (wait-for-file file)
363 ;; Wait until FILE shows up.
364 (let loop ((i 6))
365 (cond ((file-exists? file)
366 #t)
367 ((zero? i)
368 (error "file didn't show up" file))
369 (else
370 (pk 'wait-for-file file)
371 (sleep 1)
372 (loop (- i 1)))))))
373
374(define %oci-read-lines
375 #~(define (read-lines file-or-port)
376 (define (loop-lines port)
377 (let loop ((lines '()))
378 (match (read-line port)
379 ((? eof-object?)
380 (reverse lines))
381 (line
382 (loop (cons line lines))))))
383
384 (if (port? file-or-port)
385 (loop-lines file-or-port)
386 (call-with-input-file file-or-port
387 loop-lines))))
388
389(define %oci-slurp
390 #~(define slurp
391 (lambda args
392 (let* ((port
393 (apply open-pipe* OPEN_READ
394 (list "sh" "-l" "-c"
395 (string-join args " "))))
396 (output (read-lines port))
397 (status (close-pipe port)))
398 output))))
399
400(define (%oci-rootless-podman-run commands)
401 #~((use-modules (srfi srfi-1)
402 (ice-9 format)
403 (ice-9 popen)
404 (ice-9 match)
405 (ice-9 rdelim)
406 (gnu build oci-containers))
407
408 #$%oci-wait-for-file
409 #$%oci-read-lines
410 #$%oci-slurp
411
412 (define responses
413 (map
414 (lambda (index)
415 (format #f "/tmp/response_~a" index))
416 (iota (length '#$commands))))
417
418 (match (primitive-fork)
419 (0
420 (begin
421 (setgid (passwd:gid (getpwnam "oci-container")))
422 (setuid (passwd:uid (getpw "oci-container")))
423
424 (let* ((outputs
425 (list #$@commands))
426 (outputs-responses
427 (zip outputs responses)))
428 (for-each
429 (match-lambda
430 ((output response)
431 (call-with-output-file response
432 (lambda (port)
433 (display (string-join output "\n") port)))))
434 outputs-responses))))
435 (pid
436 (cdr (waitpid pid))))
437
438 (for-each wait-for-file responses)
439 (map
440 (lambda (response)
441 (sort (slurp "cat" response) string<=?))
442 responses)))
443
444(define %oci-rootless-podman-os
445 (simple-operating-system
446 (service dhcpcd-service-type)
447 (service dbus-root-service-type)
448 (service polkit-service-type)
449 (service elogind-service-type)
450 (service iptables-service-type)
451 (service rootless-podman-service-type)
452 (extra-special-file "/shared.txt"
453 (plain-file "shared.txt" "hello"))
454 (service oci-service-type
455 (oci-configuration
456 (runtime 'podman)
457 (verbose? #t)))
458 (simple-service 'oci-provisioning
459 oci-service-type
460 (oci-extension
461 (networks
462 (list %oci-network))
463 (volumes
464 (list %oci-volume))
465 (containers
466 (list
467 (oci-container-configuration
468 (provision "first")
469 (image
470 (oci-image
471 (repository "guile")
472 (value
473 (specifications->manifest '("guile")))
474 (pack-options
475 '(#:symlinks (("/bin" -> "bin"))))))
476 (entrypoint "/bin/guile")
477 (network "my-network")
478 (command
479 '("-c" "(use-modules (web server))
480(define (handler request request-body)
481 (values '((content-type . (text/plain))) \"out of office\"))
482(run-server handler 'http `(#:addr ,(inet-pton AF_INET \"0.0.0.0\")))"))
483 (host-environment
484 '(("VARIABLE" . "value")))
485 (volumes
486 '(("my-volume" . "/my-volume")))
487 (extra-arguments
488 '("--env" "VARIABLE")))
489 (oci-container-configuration
490 (provision "second")
491 (image
492 (oci-image
493 (repository "guile")
494 (value
495 (specifications->manifest '("guile")))
496 (pack-options
497 '(#:symlinks (("/bin" -> "bin"))))))
498 (entrypoint "/bin/guile")
499 (network "my-network")
500 (command
501 '("-c" "(let l ((c 300))
502(display c)
503(newline)
504(sleep 1)
505(when (positive? c)
506 (l (- c 1))))"))
507 (volumes
508 '(("my-volume" . "/my-volume")
509 ("/shared.txt" . "/shared.txt:ro"))))))))))
510
511(define (run-rootless-podman-oci-service-test)
512 (define os
513 (marionette-operating-system
514 (operating-system-with-gc-roots
515 %oci-rootless-podman-os
516 (list))
517 #:imported-modules '((gnu build oci-containers)
518 (gnu build dbus-service)
519 (gnu services herd)
520 (guix combinators))))
521
522 (define vm
523 (virtual-machine
524 (operating-system os)
525 (volatile? #f)
526 (memory-size 1024)
527 (disk-image-size (* 5000 (expt 2 20)))
528 (port-forwardings '())))
529
530 (define test
531 (with-imported-modules '((gnu build oci-containers)
532 (gnu build dbus-service)
533 (gnu build marionette))
534 #~(begin
535 (use-modules (srfi srfi-1) (srfi srfi-11) (srfi srfi-64)
536 (gnu build dbus-service)
537 (gnu build marionette))
538
539 (define marionette
540 ;; Relax timeout to accommodate older systems and
541 ;; allow for pulling the image.
542 (make-marionette (list #$vm) #:timeout 60))
543
544 (test-runner-current (system-test-runner #$output))
545 (test-begin "rootless-podman-oci-service")
546
547 (marionette-eval
548 '(begin
549 (use-modules (gnu services herd))
550 (wait-for-service 'user-processes))
551 marionette)
552
553 (test-assert "podman-volumes running"
554 (begin
555 (define (run-test)
556 (first
557 (marionette-eval
558 `(begin
559 #$@(%oci-rootless-podman-run
560 #~((oci-object-service-available?
561 "/run/current-system/profile/bin/podman"
562 "volume"
563 '("my-volume")
564 #:verbose? #t))))
565 marionette)))
566 ;; Allow services to come up on slower machines.
567 (with-retries 80 1 (equal? '("my-volume") (run-test)))))
568
569 (test-assert "podman-networks running"
570 (begin
571 (define (run-test)
572 (first
573 (marionette-eval
574 `(begin
575 #$@(%oci-rootless-podman-run
576 #~((oci-object-service-available?
577 "/run/current-system/profile/bin/podman"
578 "network"
579 '("my-network")
580 #:verbose? #t))))
581 marionette)))
582 ;; Allow services to come up on slower machines.
583 (with-retries 80 1 (equal? '("my-network" "podman") (run-test)))))
584
585 (test-assert "image loaded"
586 (begin
587 (define (run-test)
588 (first
589 (marionette-eval
590 `(begin
591 #$@(%oci-rootless-podman-run
592 #~((oci-object-service-available?
593 "/run/current-system/profile/bin/podman"
594 "image"
595 '("localhost/guile:latest")
596 #:format-string "{{.Repository}}:{{.Tag}}"
597 #:verbose? #t))))
598 marionette)))
599 ;; Allow services to come up on slower machines.
600 (with-retries 80 1
601 (equal?
602 '("localhost/guile:latest")
603 (run-test)))))
604
605 (test-assert "passing host environment variables"
606 (begin
607 (define (run-test)
608 (first
609 (marionette-eval
610 `(begin
611 #$@(%oci-rootless-podman-run
612 #~((slurp
613 "/run/current-system/profile/bin/podman"
614 "exec" "first"
615 "/bin/guile" "-c"
616 "'(display (getenv \"VARIABLE\"))'"))))
617 marionette)))
618 ;; Allow services to come up on slower machines.
619 (with-retries 80 1 (equal? '("value") (run-test)))))
620
621 (test-equal "mounting host files"
622 '("hello")
623 (first
624 (marionette-eval
625 `(begin
626 #$@(%oci-rootless-podman-run
627 #~((slurp
628 "/run/current-system/profile/bin/podman"
629 "exec" "second"
630 "/bin/guile" "-c" "'(begin
631(use-modules (ice-9 popen) (ice-9 rdelim))
632(display (call-with-input-file \"/shared.txt\" read-line)))'"))))
633 marionette)))
634
635 (test-equal "read and write to provisioned volumes"
636 '("world")
637 (second
638 (marionette-eval
639 `(begin
640 #$@(%oci-rootless-podman-run
641 #~((slurp
642 "/run/current-system/profile/bin/podman"
643 "exec" "first"
644 "/bin/guile" "-c" "'(begin
645(use-modules (ice-9 popen) (ice-9 rdelim))
646(call-with-output-file \"/my-volume/out.txt\"
647 (lambda (p) (display \"world\" p))))'")
648 (slurp
649 "/run/current-system/profile/bin/podman"
650 "exec" "second"
651 "/bin/guile" "-c" "'(begin
652(use-modules (ice-9 popen) (ice-9 rdelim))
653(display
654 (call-with-input-file \"/my-volume/out.txt\" read-line)))'"))))
655 marionette)))
656
657 (test-equal
658 "can read and write to ports over provisioned network"
659 '("out of office")
660 (first
661 (marionette-eval
662 `(begin
663 #$@(%oci-rootless-podman-run
664 #~((slurp
665 "/run/current-system/profile/bin/podman"
666 "exec" "second"
667 "/bin/guile" "-c" "'(begin
668(use-modules (web client))
669(define-values (response out) (http-get \"http://first:8080\"))
670(display out))'"))))
671 marionette)))
672
673 (test-end))))
674
675 (gexp->derivation "rootless-podman-oci-service-test" test))
676
677(define %test-oci-service-rootless-podman
678 (system-test
679 (name "oci-service-rootless-podman")
680 (description "Test Rootless-Podman backed OCI provisioning service.")
681 (value (run-rootless-podman-oci-service-test))))
682
683(define (%oci-docker-run commands)
684 #~((use-modules (srfi srfi-1)
685 (ice-9 format)
686 (ice-9 popen)
687 (ice-9 match)
688 (ice-9 rdelim)
689 (gnu build oci-containers))
690
691 #$%oci-read-lines
692 #$%oci-slurp
693
694 (let ((outputs (list #$@commands)))
695 (map
696 (lambda (output)
697 (sort output string<=?))
698 outputs))))
699
700(define %oci-docker-os
701 (simple-operating-system
702 (service dhcpcd-service-type)
703 (service dbus-root-service-type)
704 (service polkit-service-type)
705 (service elogind-service-type)
706 (service containerd-service-type)
707 (service docker-service-type)
708 (extra-special-file "/shared.txt"
709 (plain-file "shared.txt" "hello"))
710 (service oci-service-type
711 (oci-configuration
712 (verbose? #t)))
713 (simple-service 'oci-provisioning
714 oci-service-type
715 (oci-extension
716 (networks
717 (list %oci-network))
718 (volumes
719 (list %oci-volume))
720 (containers
721 (list
722 (oci-container-configuration
723 (provision "first")
724 (image
725 (oci-image
726 (repository "guile")
727 (value
728 (specifications->manifest '("guile")))
729 (pack-options
730 '(#:symlinks (("/bin" -> "bin"))))))
731 (entrypoint "/bin/guile")
732 (network "my-network")
733 (command
734 '("-c" "(use-modules (web server))
735(define (handler request request-body)
736 (values '((content-type . (text/plain))) \"out of office\"))
737(run-server handler 'http `(#:addr ,(inet-pton AF_INET \"0.0.0.0\")))"))
738 (host-environment
739 '(("VARIABLE" . "value")))
740 (volumes
741 '(("my-volume" . "/my-volume")))
742 (extra-arguments
743 '("--env" "VARIABLE")))
744 (oci-container-configuration
745 (provision "second")
746 (image
747 (oci-image
748 (repository "guile")
749 (value
750 (specifications->manifest '("guile")))
751 (pack-options
752 '(#:symlinks (("/bin" -> "bin"))))))
753 (entrypoint "/bin/guile")
754 (network "my-network")
755 (command
756 '("-c" "(let l ((c 300))
757(display c)
758(newline)
759(sleep 1)
760(when (positive? c)
761 (l (- c 1))))"))
762 (volumes
763 '(("my-volume" . "/my-volume")
764 ("/shared.txt" . "/shared.txt:ro"))))))))))
765
766(define (run-docker-oci-service-test)
767 (define os
768 (marionette-operating-system
769 (operating-system-with-gc-roots
770 %oci-docker-os
771 (list))
772 #:imported-modules '((gnu build oci-containers)
773 (gnu build dbus-service)
774 (gnu services herd)
775 (guix combinators))))
776
777 (define vm
778 (virtual-machine
779 (operating-system os)
780 (volatile? #f)
781 (memory-size 1024)
782 (disk-image-size (* 5000 (expt 2 20)))
783 (port-forwardings '())))
784
785 (define test
786 (with-imported-modules '((gnu build oci-containers)
787 (gnu build dbus-service)
788 (gnu build marionette))
789 #~(begin
790 (use-modules (srfi srfi-1) (srfi srfi-11) (srfi srfi-64)
791 (gnu build dbus-service)
792 (gnu build marionette))
793
794 (define marionette
795 ;; Relax timeout to accommodate older systems and
796 ;; allow for pulling the image.
797 (make-marionette (list #$vm) #:timeout 60))
798
799 (test-runner-current (system-test-runner #$output))
800 (test-begin "docker-oci-service")
801
802 (marionette-eval
803 '(begin
804 (use-modules (gnu services herd))
805 (wait-for-service 'dockerd))
806 marionette)
807
808 (test-assert "docker-volumes running"
809 (begin
810 (define (run-test)
811 (first
812 (marionette-eval
813 `(begin
814 #$@(%oci-docker-run
815 #~((oci-object-service-available?
816 "/run/current-system/profile/bin/docker"
817 "volume"
818 '("my-volume")
819 #:verbose? #t))))
820 marionette)))
821 ;; Allow services to come up on slower machines.
822 (with-retries 80 1 (equal? '("my-volume") (run-test)))))
823
824 (test-assert "docker-networks running"
825 (begin
826 (define (run-test)
827 (first
828 (marionette-eval
829 `(begin
830 #$@(%oci-docker-run
831 #~((oci-object-service-available?
832 "/run/current-system/profile/bin/docker"
833 "network"
834 '("my-network")
835 #:verbose? #t))))
836 marionette)))
837 ;; Allow services to come up on slower machines.
838 (with-retries 80 1 (equal?
839 '("my-network" "none")
840 (run-test)))))
841
842 (test-assert "passing host environment variables"
843 (begin
844 (define (run-test)
845 (first
846 (marionette-eval
847 `(begin
848 #$@(%oci-docker-run
849 #~((slurp
850 "/run/current-system/profile/bin/docker"
851 "exec" "first"
852 "/bin/guile" "-c"
853 "'(display (getenv \"VARIABLE\"))'"))))
854 marionette)))
855 ;; Allow services to come up on slower machines.
856 (with-retries 80 1 (equal? '("value") (run-test)))))
857
858 (test-equal "read and write to provisioned volumes"
859 '("world")
860 (second
861 (marionette-eval
862 `(begin
863 #$@(%oci-docker-run
864 #~((slurp
865 "/run/current-system/profile/bin/docker"
866 "exec" "first"
867 "/bin/guile" "-c" "'(begin
868(use-modules (ice-9 popen) (ice-9 rdelim))
869(call-with-output-file \"/my-volume/out.txt\"
870 (lambda (p) (display \"world\" p))))'")
871 (slurp
872 "/run/current-system/profile/bin/docker"
873 "exec" "second"
874 "/bin/guile" "-c" "'(begin
875(use-modules (ice-9 popen) (ice-9 rdelim))
876(display
877 (call-with-input-file \"/my-volume/out.txt\" read-line)))'"))))
878 marionette)))
879
880 (test-equal
881 "can read and write to ports over provisioned network"
882 '("out of office")
883 (first
884 (marionette-eval
885 `(begin
886 #$@(%oci-docker-run
887 #~((slurp
888 "/run/current-system/profile/bin/docker"
889 "exec" "second"
890 "/bin/guile" "-c" "'(begin (use-modules (web client))
891 (define-values (response out)
892 (http-get \"http://first:8080\"))
893 (display out))'"))))
894 marionette)))
895
896 (test-end))))
897
898 (gexp->derivation "docker-oci-service-test" test))
899
900(define %test-oci-service-docker
901 (system-test
902 (name "oci-service-docker")
903 (description "Test Docker backed OCI provisioning service.")
904 (value (run-docker-oci-service-test))))