projects/guix·blob python-team · refs

1769 lines · 65.9 KiB

1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2024, 2025 Giacomo Leidi <[email protected]>
3;;; Copyright © 2025 Owen T. Heisler <[email protected]>
4;;;
5;;; This file is part of GNU Guix.
6;;;
7;;; GNU Guix is free software; you can redistribute it and/or modify it
8;;; under the terms of the GNU General Public License as published by
9;;; the Free Software Foundation; either version 3 of the License, or (at
10;;; your option) any later version.
11;;;
12;;; GNU Guix is distributed in the hope that it will be useful, but
13;;; WITHOUT ANY WARRANTY; without even the implied warranty of
14;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15;;; GNU General Public License for more details.
16;;;
17;;; You should have received a copy of the GNU General Public License
18;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
19
20(define-module (gnu services containers)
21 #:use-module (gnu image)
22 #:use-module (gnu packages admin)
23 #:use-module (gnu packages bash)
24 #:use-module (gnu packages containers)
25 #:use-module (gnu packages file-systems)
26 #:use-module (gnu services)
27 #:use-module (gnu services base)
28 #:use-module (gnu services configuration)
29 #:use-module (gnu services shepherd)
30 #:use-module (gnu system)
31 #:use-module (gnu system accounts)
32 #:use-module (gnu system image)
33 #:use-module (gnu system shadow)
34 #:use-module (gnu system pam)
35 #:use-module (guix diagnostics)
36 #:use-module (guix gexp)
37 #:use-module (guix i18n)
38 #:use-module (guix modules)
39 #:use-module (guix monads)
40 #:use-module (guix packages)
41 #:use-module (guix profiles)
42 #:use-module ((guix scripts pack) #:prefix pack:)
43 #:use-module (guix records)
44 #:use-module (guix store)
45 #:use-module (srfi srfi-1)
46 #:use-module (ice-9 format)
47 #:use-module (ice-9 match)
48 #:export (rootless-podman-configuration
49 rootless-podman-configuration?
50 rootless-podman-configuration-fields
51 rootless-podman-configuration-podman
52 rootless-podman-configuration-group-name
53 rootless-podman-configuration-containers-registries
54 rootless-podman-configuration-containers-storage
55 rootless-podman-configuration-containers-policy
56 rootless-podman-configuration-pam-limits
57 rootless-podman-configuration-subgids
58 rootless-podman-configuration-subuids
59
60 rootless-podman-service-subids
61 rootless-podman-service-accounts
62 rootless-podman-service-profile
63 rootless-podman-shepherd-services
64 rootless-podman-service-etc
65
66 rootless-podman-service-type
67
68 oci-image
69 oci-image?
70 oci-image-fields
71 oci-image-repository
72 oci-image-tag
73 oci-image-value
74 oci-image-pack-options
75 oci-image-target
76 oci-image-system
77 oci-image-grafts?
78
79 oci-container-configuration
80 oci-container-configuration?
81 oci-container-configuration-fields
82 oci-container-configuration-user
83 oci-container-configuration-group
84 oci-container-configuration-command
85 oci-container-configuration-entrypoint
86 oci-container-configuration-host-environment
87 oci-container-configuration-environment
88 oci-container-configuration-image
89 oci-container-configuration-provision
90 oci-container-configuration-requirement
91 oci-container-configuration-log-file
92 oci-container-configuration-auto-start?
93 oci-container-configuration-respawn?
94 oci-container-configuration-shepherd-actions
95 oci-container-configuration-network
96 oci-container-configuration-ports
97 oci-container-configuration-volumes
98 oci-container-configuration-container-user
99 oci-container-configuration-workdir
100 oci-container-configuration-extra-arguments
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
169 oci-container-shepherd-service
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))
178
179(define (gexp-or-string? value)
180 (or (gexp? value)
181 (string? value)))
182
183(define (lowerable? value)
184 (or (file-like? value)
185 (gexp-or-string? value)))
186
187(define list-of-pam-limits-entries?
188 (list-of pam-limits-entry?))
189
190(define list-of-subid-ranges?
191 (list-of subid-range?))
192
193(define (package-or-#f? val)
194 (or (not val)
195 (package? val)))
196
197(define-configuration/no-serialization rootless-podman-configuration
198 (podman
199 (package-or-#f podman)
200 "The Podman package that will be installed in the system profile.
201@code{#f} can be passed to suppress the installation.")
202 (group-name
203 (string "cgroup")
204 "The name of the group that will own /sys/fs/cgroup resources. Users that
205want to use rootless Podman have to be in this group.")
206 (containers-registries
207 (lowerable
208 (plain-file "registries.conf"
209 (string-append "unqualified-search-registries = ['docker.io','"
210 "registry.fedora.org','registry.opensuse.org']")))
211 "A string or a gexp evaluating to the path of Podman's
212@code{containers/registries.conf} configuration file.")
213 (containers-storage
214 (lowerable
215 (plain-file "storage.conf"
216 "[storage]
217driver = \"overlay\""))
218 "A string or a gexp evaluating to the path of Podman's
219@code{containers/storage.conf} configuration file.")
220 (containers-policy
221 (lowerable
222 (plain-file "policy.json"
223 "{\"default\": [{\"type\": \"insecureAcceptAnything\"}]}"))
224 "A string or a gexp evaluating to the path of Podman's
225@code{containers/policy.json} configuration file.")
226 (pam-limits
227 (list-of-pam-limits-entries
228 (list (pam-limits-entry "*" 'both 'nofile 100000)))
229 "The PAM limits to be set for rootless Podman.")
230 (subgids
231 (list-of-subid-ranges '())
232 "A list of subid ranges representing the subgids that will be
233available for each configured user.")
234 (subuids
235 (list-of-subid-ranges '())
236 "A list of subid ranges representing the subuids that will be
237available for each configured user."))
238
239(define rootless-podman-service-profile
240 (lambda (config)
241 (or (and=> (rootless-podman-configuration-podman config) list)
242 (list))))
243
244(define rootless-podman-service-etc
245 (lambda (config)
246 (list `("containers/registries.conf"
247 ,(rootless-podman-configuration-containers-registries config))
248 `("containers/storage.conf"
249 ,(rootless-podman-configuration-containers-storage config))
250 `("containers/policy.json"
251 ,(rootless-podman-configuration-containers-policy config)))))
252
253(define rootless-podman-service-subids
254 (lambda (config)
255 (subids-extension
256 (subgids (rootless-podman-configuration-subgids config))
257 (subuids (rootless-podman-configuration-subuids config)))))
258
259(define rootless-podman-service-accounts
260 (lambda (config)
261 (list (user-group (name (rootless-podman-configuration-group-name config))
262 (system? #t)))))
263
264(define (cgroups-fs-owner-entrypoint config)
265 (define group
266 (rootless-podman-configuration-group-name config))
267 (program-file "cgroups2-fs-owner-entrypoint"
268 #~(system*
269 (string-append #+bash-minimal "/bin/bash") "-l" "-c"
270 (string-append "echo Setting /sys/fs/cgroup "
271 "group ownership to " #$group " && chown -v "
272 "root:" #$group " /sys/fs/cgroup && "
273 "chmod -v 775 /sys/fs/cgroup && chown -v "
274 "root:" #$group " /sys/fs/cgroup/cgroup."
275 "{procs,subtree_control,threads} && "
276 "chmod -v 664 /sys/fs/cgroup/cgroup."
277 "{procs,subtree_control,threads}"))))
278
279(define (rootless-podman-cgroups-fs-owner-service config)
280 (shepherd-service (provision '(cgroups2-fs-owner))
281 (requirement
282 '(user-processes
283 dbus-system
284 elogind
285 file-system-/sys/fs/cgroup
286 networking
287 udev
288 cgroups2-limits))
289 (one-shot? #t)
290 (documentation
291 "Set ownership of /sys/fs/cgroup to the configured group.")
292 (start
293 #~(make-forkexec-constructor
294 (list
295 #$(cgroups-fs-owner-entrypoint config))))
296 (stop
297 #~(make-kill-destructor))))
298
299(define cgroups-limits-entrypoint
300 (program-file "cgroups2-limits-entrypoint"
301 #~(system*
302 (string-append #+bash-minimal "/bin/bash") "-c"
303 (string-append "echo Setting cgroups v2 limits && "
304 "echo +cpu +cpuset +io +memory +pids"
305 " >> /sys/fs/cgroup/cgroup.subtree_control"))))
306
307(define (rootless-podman-cgroups-limits-service config)
308 (shepherd-service (provision '(cgroups2-limits))
309 (requirement
310 '(user-processes
311 dbus-system
312 elogind
313 networking
314 udev
315 file-system-/sys/fs/cgroup
316 rootless-podman-shared-root-fs))
317 (one-shot? #t)
318 (documentation
319 "Allow setting cgroups limits: cpu, cpuset, io, memory and
320pids.")
321 (start
322 #~(make-forkexec-constructor
323 (list
324 #$cgroups-limits-entrypoint)))
325 (stop
326 #~(make-kill-destructor))))
327
328(define rootless-podman-shared-root-fs-entrypoint
329 (program-file "rootless-podman-shared-root-fs-entrypoint"
330 #~(system*
331 "/run/privileged/bin/mount" "--make-shared" "/")))
332
333(define (rootless-podman-shared-root-fs-service config)
334 (shepherd-service (provision '(rootless-podman-shared-root-fs))
335 (requirement
336 '(user-processes))
337 (one-shot? #t)
338 (documentation
339 "Buildah/Podman running as rootless expects the bind mount
340to be shared. This service sets it so.")
341 (start
342 #~(make-forkexec-constructor
343 (list
344 #$rootless-podman-shared-root-fs-entrypoint)))
345 (stop
346 #~(make-kill-destructor))))
347
348(define (rootless-podman-shepherd-services config)
349 (list
350 (rootless-podman-shared-root-fs-service config)
351 (rootless-podman-cgroups-limits-service config)
352 (rootless-podman-cgroups-fs-owner-service config)))
353
354(define rootless-podman-service-type
355 (service-type (name 'rootless-podman)
356 (extensions
357 (list
358 (service-extension subids-service-type
359 rootless-podman-service-subids)
360 (service-extension account-service-type
361 rootless-podman-service-accounts)
362 (service-extension profile-service-type
363 rootless-podman-service-profile)
364 (service-extension shepherd-root-service-type
365 rootless-podman-shepherd-services)
366 (service-extension pam-limits-service-type
367 rootless-podman-configuration-pam-limits)
368 (service-extension etc-service-type
369 rootless-podman-service-etc)))
370 (default-value (rootless-podman-configuration))
371 (description
372 "This service configures rootless @code{podman} on the Guix System.")))
373
374
375;;;
376;;; OCI provisioning service.
377;;;
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
412(define (oci-sanitize-pair pair delimiter)
413 (define (valid? member)
414 (or (string? member)
415 (gexp? member)
416 (file-like? member)))
417 (match pair
418 (((? valid? key) . (? valid? value))
419 #~(string-append #$key #$delimiter #$value))
420 (_
421 (raise
422 (formatted-message
423 (G_ "pair members must contain only strings, gexps or file-like objects
424but ~a was found")
425 pair)))))
426
427(define (oci-sanitize-mixed-list name value delimiter)
428 (map
429 (lambda (el)
430 (cond ((string? el) el)
431 ((pair? el) (oci-sanitize-pair el delimiter))
432 (else
433 (raise
434 (formatted-message
435 (G_ "~a members must be either a string or a pair but ~a was
436found!")
437 name el)))))
438 value))
439
440(define (oci-sanitize-host-environment value)
441 ;; Expected spec format:
442 ;; '(("HOME" . "/home/nobody") "JAVA_HOME=/java")
443 (oci-sanitize-mixed-list "host-environment" value "="))
444
445(define (oci-container-host-environment? value)
446 (list? (oci-sanitize-host-environment value)))
447
448(define (oci-sanitize-environment value)
449 ;; Expected spec format:
450 ;; '(("HOME" . "/home/nobody") "JAVA_HOME=/java")
451 (oci-sanitize-mixed-list "environment" value "="))
452
453(define (oci-container-environment? value)
454 (list? (oci-sanitize-environment value)))
455
456(define (oci-sanitize-ports value)
457 ;; Expected spec format:
458 ;; '(("8088" . "80") "2022:22")
459 (oci-sanitize-mixed-list "ports" value ":"))
460
461(define (oci-container-ports? value)
462 (list? (oci-sanitize-ports value)))
463
464(define (oci-sanitize-volumes value)
465 ;; Expected spec format:
466 ;; '(("/mnt/dir" . "/dir") "/run/current-system/profile:/java")
467 (oci-sanitize-mixed-list "volumes" value ":"))
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
480(define (oci-sanitize-shepherd-actions value)
481 (map
482 (lambda (el)
483 (if (shepherd-action? el)
484 el
485 (raise
486 (formatted-message
487 (G_ "shepherd-actions may only be shepherd-action records
488but ~a was found") el))))
489 value))
490
491(define (oci-container-shepherd-actions? value)
492 (list? (oci-sanitize-shepherd-actions value)))
493
494(define (oci-sanitize-extra-arguments value)
495 (define (valid? member)
496 (or (string? member)
497 (gexp? member)
498 (file-like? member)))
499 (map
500 (lambda (el)
501 (if (valid? el)
502 el
503 (raise
504 (formatted-message
505 (G_ "extra arguments may only be strings, gexps or file-like objects
506but ~a was found") el))))
507 value))
508
509(define (oci-object-extra-arguments? value)
510 (list? (oci-sanitize-extra-arguments value)))
511
512(define (oci-image-reference image)
513 "Return a string OCI image reference representing IMAGE."
514 (define reference
515 (if (string? 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)))
522
523(define (string-or-list-of-strings? value)
524 (if (or (string? value)
525 ((list-of string) value))
526 value
527 (raise
528 (formatted-message
529 (G_ "entrypoint may only be a single string or a list of strings
530but ~a was found") value))))
531
532(define (oci-lowerable-image? image)
533 (or (manifest? image)
534 (operating-system? image)
535 (file-like? image)))
536
537(define (string-or-oci-image? image)
538 (or (string? image)
539 (oci-image? image)))
540
541(define list-of-symbols?
542 (list-of symbol?))
543
544(define (list-of-oci-records? name predicate value)
545 (map
546 (lambda (el)
547 (if (predicate el)
548 el
549 (raise
550 (formatted-message
551 (G_ "~a contains an illegal value: ~a") name el))))
552 value))
553
554(define-maybe/no-serialization string)
555(define-maybe/no-serialization string-or-list-of-strings)
556(define-maybe/no-serialization package)
557(define-maybe/no-serialization subid-range)
558
559(define-configuration/no-serialization oci-image
560 (repository
561 (string)
562 "A string like @code{myregistry.local:5000/testing/test-image} that names
563the OCI image.")
564 (tag
565 (string "latest")
566 "A string representing the OCI image tag. Defaults to @code{latest}.")
567 (value
568 (oci-lowerable-image)
569 "A @code{manifest} or @code{operating-system} record that will be lowered
570into an OCI compatible tarball. Otherwise this field's value can be a
571file-like object that evaluates to an OCI compatible tarball.")
572 (pack-options
573 (list '())
574 "An optional set of keyword arguments that will be passed to the
575@code{docker-image} procedure from @code{guix scripts pack}. They can be used
576to replicate @command{guix pack} behavior:
577
578@lisp
579(oci-image
580 (repository \"guile\")
581 (tag \"3\")
582 (manifest (specifications->manifest '(\"guile\")))
583 (pack-options
584 '(#:symlinks ((\"/bin/guile\" -> \"bin/guile\"))
585 #:max-layers 2)))
586@end lisp
587
588If the @code{value} field is an @code{operating-system} record, this field's
589value will be ignored.")
590 (system
591 (maybe-string)
592 "Attempt to build for a given system, e.g. \"i686-linux\"")
593 (target
594 (maybe-string)
595 "Attempt to cross-build for a given triple, e.g. \"aarch64-linux-gnu\"")
596 (grafts?
597 (boolean #f)
598 "Whether to allow grafting or not in the pack build."))
599
600(define-configuration/no-serialization oci-container-configuration
601 (user
602 (maybe-string)
603 "The user name under whose authority OCI commands will be run. This field will
604override the @code{user} field of @code{oci-configuration}.")
605 (group
606 (maybe-string)
607 "The group name under whose authority OCI commands will be run. When
608using the @code{'podman} OCI runtime, this field will be ignored and the
609default group of the user configured in the @code{user} field will be used.
610This field will override the @code{group} field of @code{oci-configuration}.")
611 (command
612 (list-of-strings '())
613 "Overwrite the default command (@code{CMD}) of the image.")
614 (entrypoint
615 (maybe-string-or-list-of-strings)
616 "Overwrite the default entrypoint (@code{ENTRYPOINT}) of the image. It can
617be either a string, or a list of strings.")
618 (host-environment
619 (oci-container-host-environment '())
620 "Set environment variables in the host environment where @command{docker run}
621or @command{podman run} are invoked. This is especially useful to pass secrets
622from the host to the container without having them on the OCI runtime command line,
623for example: by setting the @code{MYSQL_PASSWORD} on the host and by passing
624@code{--env MYSQL_PASSWORD} through the @code{extra-arguments} field, it is
625possible to securely set values in the container environment. This field's
626value can be a list of pairs or strings, even mixed:
627
628@lisp
629(list '(\"LANGUAGE\" . \"eo:ca:eu\")
630 \"JAVA_HOME=/opt/java\")
631@end lisp
632
633Pair members can be strings, gexps or file-like objects. Strings are passed
634directly to @code{make-forkexec-constructor}."
635 (sanitizer oci-sanitize-host-environment))
636 (environment
637 (oci-container-environment '())
638 "Set environment variables inside the container. This can be a list of pairs
639or strings, even mixed:
640
641@lisp
642(list '(\"LANGUAGE\" . \"eo:ca:eu\")
643 \"JAVA_HOME=/opt/java\")
644@end lisp
645
646Pair members can be strings, gexps or file-like objects. Strings are passed
647directly to the OCI runtime CLI. You can refer to the
648@url{https://docs.docker.com/engine/reference/commandline/run/#env,Docker}
649or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#env-e-env,Podman}
650upstream documentation for semantics."
651 (sanitizer oci-sanitize-environment))
652 (image
653 (string-or-oci-image)
654 "The image used to build the container. It can be a string or an
655@code{oci-image} record. Strings are resolved by the OCI runtime,
656and follow the usual format
657@code{myregistry.local:5000/testing/test-image:tag}.")
658 (provision
659 (maybe-string)
660 "Set the name of the provisioned Shepherd service.")
661 (requirement
662 (list-of-symbols '())
663 "Set additional Shepherd services dependencies to the provisioned Shepherd
664service.")
665 (log-file
666 (maybe-string)
667 "When @code{log-file} is set, it names the file to which the service’s
668standard output and standard error are redirected. @code{log-file} is created
669if it does not exist, otherwise it is appended to.")
670 (auto-start?
671 (boolean #t)
672 "Whether this service should be started automatically by the Shepherd. If it
673is @code{#f} the service has to be started manually with @command{herd start}.")
674 (respawn?
675 (boolean #f)
676 "Whether to restart the service when it stops, for instance when the
677underlying process dies.")
678 (shepherd-actions
679 (oci-container-shepherd-actions '())
680 "This is a list of @code{shepherd-action} records defining actions supported
681by the service."
682 (sanitizer oci-sanitize-shepherd-actions))
683 (network
684 (maybe-string)
685 "Set an OCI network for the spawned container.")
686 (ports
687 (oci-container-ports '())
688 "Set the port or port ranges to expose from the spawned container. This can
689be a list of pairs or strings, even mixed:
690
691@lisp
692(list '(\"8080\" . \"80\")
693 \"10443:443\")
694@end lisp
695
696Pair members can be strings, gexps or file-like objects. Strings are passed
697directly to the OCI runtime CLI. You can refer to the
698@url{https://docs.docker.com/engine/reference/commandline/run/#publish,Docker}
699or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#publish-p-ip-hostport-containerport-protocol,Podman}
700upstream documentation for semantics."
701 (sanitizer oci-sanitize-ports))
702 (volumes
703 (oci-container-volumes '())
704 "Set volume mappings for the spawned container. This can be a
705list of pairs or strings, even mixed:
706
707@lisp
708(list '(\"/root/data/grafana\" . \"/var/lib/grafana\")
709 \"/gnu/store:/gnu/store\")
710@end lisp
711
712Pair members can be strings, gexps or file-like objects. Strings are passed
713directly to the OCI runtime CLI. You can refer to the
714@url{https://docs.docker.com/engine/reference/commandline/run/#volume,Docker}
715or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#volume-v-source-volume-host-dir-container-dir-options,Podman}
716upstream documentation for semantics."
717 (sanitizer oci-sanitize-volumes))
718 (container-user
719 (maybe-string)
720 "Set the current user inside the spawned container. You can refer to the
721@url{https://docs.docker.com/engine/reference/run/#user,Docker}
722or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#user-u-user-group,Podman}
723upstream documentation for semantics.")
724 (workdir
725 (maybe-string)
726 "Set the current working directory for the spawned Shepherd service.
727You can refer to the
728@url{https://docs.docker.com/engine/reference/run/#workdir,Docker}
729or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#workdir-w-dir,Podman}
730upstream documentation for semantics.")
731 (extra-arguments
732 (oci-object-extra-arguments '())
733 "A list of strings, gexps or file-like objects that will be directly passed
734to the @command{docker run} or @command{podman run} invocation."
735 (sanitizer oci-sanitize-extra-arguments)))
736
737(define (list-of-oci-containers? value)
738 (list-of-oci-records? "containers" oci-container-configuration? value))
739
740(define-configuration/no-serialization oci-volume-configuration
741 (name
742 (string)
743 "The name of the OCI volume to provision.")
744 (labels
745 (oci-object-labels '())
746 "The list of labels that will be used to tag the current volume."
747 (sanitizer oci-sanitize-labels))
748 (extra-arguments
749 (oci-object-extra-arguments '())
750 "A list of strings, gexps or file-like objects that will be directly passed
751to the @command{docker volume create} or @command{podman volume create}
752invocation."
753 (sanitizer oci-sanitize-extra-arguments)))
754
755(define (list-of-oci-volumes? value)
756 (list-of-oci-records? "volumes" oci-volume-configuration? value))
757
758(define-configuration/no-serialization oci-network-configuration
759 (name
760 (string)
761 "The name of the OCI network to provision.")
762 (driver
763 (maybe-string)
764 "The driver to manage the network.")
765 (gateway
766 (maybe-string)
767 "IPv4 or IPv6 gateway for the subnet.")
768 (internal?
769 (boolean #f)
770 "Restrict external access to the network")
771 (ip-range
772 (maybe-string)
773 "Allocate container ip from a sub-range in CIDR format.")
774 (ipam-driver
775 (maybe-string)
776 "IP Address Management Driver.")
777 (ipv6?
778 (boolean #f)
779 "Enable IPv6 networking.")
780 (subnet
781 (maybe-string)
782 "Subnet in CIDR format that represents a network segment.")
783 (labels
784 (oci-object-labels '())
785 "The list of labels that will be used to tag the current volume."
786 (sanitizer oci-sanitize-labels))
787 (extra-arguments
788 (oci-object-extra-arguments '())
789 "A list of strings, gexps or file-like objects that will be directly passed
790to the @command{docker network create} or @command{podman network create}
791invocation."
792 (sanitizer oci-sanitize-extra-arguments)))
793
794(define (list-of-oci-networks? value)
795 (list-of-oci-records? "networks" oci-network-configuration? value))
796
797(define (package-or-string? value)
798 (or (package? value) (string? value)))
799
800(define-maybe/no-serialization package-or-string)
801
802(define-configuration/no-serialization oci-configuration
803 (runtime
804 (oci-runtime 'docker)
805 "The OCI runtime to use to run commands. It can be either @code{'docker} or
806@code{'podman}.")
807 (runtime-cli
808 (maybe-package-or-string)
809 "The OCI runtime command line to be installed in the system profile and used
810to provision OCI resources, it can be either a package or a string representing
811an absolute file name to the runtime binary entrypoint. When unset it will default
812to @code{docker-cli} package for the @code{'docker} runtime or to @code{podman}
813package for the @code{'podman} runtime.")
814 (runtime-extra-arguments
815 (list '())
816 "A list of strings, gexps or file-like objects that will be placed
817after each @command{docker} or @command{podman} invokation.")
818 (user
819 (string "oci-container")
820 "The user name under whose authority OCI runtime commands will be run.")
821 (group
822 (maybe-string)
823 "The group name under whose authority OCI commands will be run. When
824using the @code{'podman} OCI runtime, this field will be ignored and the
825default group of the user configured in the @code{user} field will be used.")
826 (subuids-range
827 (maybe-subid-range)
828 "An optional @code{subid-range} record allocating subuids for the user from
829the @code{user} field. When unset, with the rootless Podman OCI runtime, it
830defaults to @code{(subid-range (name \"oci-container\"))}.")
831 (subgids-range
832 (maybe-subid-range)
833 "An optional @code{subid-range} record allocating subgids for the user from
834the @code{user} field. When unset, with the rootless Podman OCI runtime, it
835defaults to @code{(subid-range (name \"oci-container\"))}.")
836 (containers
837 (list-of-oci-containers '())
838 "The list of @code{oci-container-configuration} records representing the
839containers to provision. The use of the @code{oci-extension} record should
840be preferred for most cases.")
841 (networks
842 (list-of-oci-networks '())
843 "The list of @code{oci-network-configuration} records representing the
844networks to provision. The use of the @code{oci-extension} record should
845be preferred for most cases.")
846 (volumes
847 (list-of-oci-volumes '())
848 "The list of @code{oci-volume-configuration} records representing the
849volumes to provision. The use of the @code{oci-extension} record should
850be preferred for most cases.")
851 (verbose?
852 (boolean #f)
853 "When true, additional output will be printed, allowing to better follow the
854flow of execution.")
855 (home-service?
856 (boolean for-home?)
857 "This is an internal field denoting whether this configuration is used in a
858Guix Home context, as opposed to the default Guix System context."))
859
860(define (oci-runtime-system-environment runtime user)
861 (if (eq? runtime 'podman)
862 (list
863 #~(string-append
864 "HOME=" (passwd:dir (getpwnam #$user))))
865 #~()))
866
867(define (oci-runtime-cli runtime runtime-cli profile-directory)
868 "Return a gexp that, when lowered, evaluates to the of the OCI
869runtime command requested by the user."
870 (if (string? runtime-cli)
871 ;; It is a user defined absolute file name.
872 runtime-cli
873 #~(string-append
874 #$(if (maybe-value-set? runtime-cli)
875 runtime-cli
876 profile-directory)
877 #$(if (eq? 'podman runtime)
878 "/bin/podman"
879 "/bin/docker"))))
880
881(define* (oci-runtime-system-cli config #:key (profile-directory "/run/current-system/profile"))
882 (let ((runtime-cli
883 (oci-configuration-runtime-cli config))
884 (runtime
885 (oci-configuration-runtime config)))
886 (oci-runtime-cli runtime runtime-cli profile-directory)))
887
888(define (oci-runtime-home-cli config)
889 (let ((runtime-cli
890 (oci-configuration-runtime-cli config))
891 (runtime
892 (oci-configuration-runtime config)))
893 (oci-runtime-cli runtime runtime-cli
894 (string-append (getenv "HOME")
895 "/.guix-home/profile"))))
896
897(define-configuration/no-serialization oci-extension
898 (containers
899 (list-of-oci-containers '())
900 "The list of @code{oci-container-configuration} records representing the
901containers to add.")
902 (networks
903 (list-of-oci-networks '())
904 "The list of @code{oci-network-configuration} records representing the
905networks to add.")
906 (volumes
907 (list-of-oci-volumes '())
908 "The list of @code{oci-volume-configuration} records representing the
909volumes to add."))
910
911(define (oci-image->container-name image)
912 "Infer the name of an OCI backed Shepherd service from its OCI image."
913 (basename
914 (if (string? image)
915 (first (string-split image #\:))
916 (oci-image-repository image))))
917
918(define (oci-command-line-shepherd-action object-name invocation entrypoint)
919 "Return a Shepherd action printing a given INVOCATION of an OCI command for the
920given OBJECT-NAME."
921 (shepherd-action
922 (name 'command-line)
923 (documentation
924 (format #f "Prints ~a's OCI runtime command line invocation."
925 object-name))
926 (procedure
927 #~(lambda _
928 (format #t "Entrypoint:~%~a~%" #$entrypoint)
929 (format #t "Invocation:~%~a~%" #$invocation)))))
930
931(define (oci-container-shepherd-name runtime config)
932 "Return the name of an OCI backed Shepherd service based on CONFIG.
933The name configured in the configuration record is returned when
934CONFIG's name field has a value, otherwise a name is inferred from CONFIG's
935image field."
936 (define name (oci-container-configuration-provision config))
937 (define image (oci-container-configuration-image config))
938
939 (if (maybe-value-set? name)
940 name
941 (string-append (symbol->string runtime) "-"
942 (oci-image->container-name image))))
943
944(define (oci-networks-shepherd-name runtime)
945 "Return the name of the OCI networks provisioning Shepherd service based on
946RUNTIME."
947 (string-append (symbol->string runtime) "-networks"))
948
949(define (oci-volumes-shepherd-name runtime)
950 "Return the name of the OCI volumes provisioning Shepherd service based on
951RUNTIME."
952 (string-append (symbol->string runtime) "-volumes"))
953
954(define (oci-networks-home-shepherd-name runtime)
955 "Return the name of the OCI volumes provisioning Home Shepherd service based on
956RUNTIME."
957 (string-append "home-" (oci-networks-shepherd-name runtime)))
958
959(define (oci-volumes-home-shepherd-name runtime)
960 "Return the name of the OCI volumes provisioning Home Shepherd service based on
961RUNTIME."
962 (string-append "home-" (oci-volumes-shepherd-name runtime)))
963
964(define (oci-container-configuration->options config)
965 "Map CONFIG, an oci-container-configuration record, to a gexp that, upon
966lowering, will be evaluated to a list of strings containing command line options
967for the OCI runtime run command."
968 (let ((entrypoint (oci-container-configuration-entrypoint config))
969 (network (oci-container-configuration-network config))
970 (user (oci-container-configuration-container-user config))
971 (workdir (oci-container-configuration-workdir config)))
972 (apply append
973 (filter (compose not unspecified?)
974 (list (if (maybe-value-set? entrypoint)
975 `("--entrypoint"
976 ,(if (list? entrypoint)
977 (string-join entrypoint " ")
978 entrypoint))
979 '())
980 (append-map
981 (lambda (spec)
982 (list "--env" spec))
983 (oci-container-configuration-environment config))
984 (if (maybe-value-set? network)
985 `("--network" ,network)
986 '())
987 (if (maybe-value-set? user)
988 `("--user" ,user)
989 '())
990 (if (maybe-value-set? workdir)
991 `("--workdir" ,workdir)
992 '())
993 (append-map
994 (lambda (spec)
995 (list "-p" spec))
996 (oci-container-configuration-ports config))
997 (append-map
998 (lambda (spec)
999 (list "-v" spec))
1000 (oci-container-configuration-volumes config)))))))
1001
1002(define (oci-network-configuration->options config)
1003 "Map CONFIG, an oci-network-configuration record, to a gexp that, upon
1004lowering, will be evaluated to a list of strings containing command line options
1005for the OCI runtime network create command."
1006 (let ((driver (oci-network-configuration-driver config))
1007 (gateway (oci-network-configuration-gateway config))
1008 (internal? (oci-network-configuration-internal? config))
1009 (ip-range (oci-network-configuration-ip-range config))
1010 (ipam-driver (oci-network-configuration-ipam-driver config))
1011 (ipv6? (oci-network-configuration-ipv6? config))
1012 (subnet (oci-network-configuration-subnet config)))
1013 (apply append
1014 (filter (compose not unspecified?)
1015 (list (if (maybe-value-set? driver)
1016 `("--driver" ,driver)
1017 '())
1018 (if (maybe-value-set? gateway)
1019 `("--gateway" ,gateway)
1020 '())
1021 (if internal?
1022 `("--internal")
1023 '())
1024 (if (maybe-value-set? ip-range)
1025 `("--ip-range" ,ip-range)
1026 '())
1027 (if (maybe-value-set? ipam-driver)
1028 `("--ipam-driver" ,ipam-driver)
1029 '())
1030 (if ipv6?
1031 `("--ipv6")
1032 '())
1033 (if (maybe-value-set? subnet)
1034 `("--subnet" ,subnet)
1035 '())
1036 (append-map
1037 (lambda (spec)
1038 (list "--label" spec))
1039 (oci-network-configuration-labels config)))))))
1040
1041(define (oci-volume-configuration->options config)
1042 "Map CONFIG, an oci-volume-configuration record, to a gexp that, upon
1043lowering, will be evaluated to a list of strings containing command line options
1044for the OCI runtime volume create command."
1045 (append-map
1046 (lambda (spec)
1047 (list "--label" spec))
1048 (oci-volume-configuration-labels config)))
1049
1050(define (lower-operating-system os target system)
1051 "Lower OS, an operating-system record, into a tarball containing an OCI image."
1052 (mlet* %store-monad
1053 ((tarball
1054 (lower-object
1055 (system-image (os->image os #:type docker-image-type))
1056 system
1057 #:target target)))
1058 (return tarball)))
1059
1060(define (lower-manifest value options image-reference
1061 target system grafts?)
1062 "Lower VALUE, a manifest record, into a tarball containing an OCI image."
1063 (define (format reference)
1064 ;; Remove from REFERENCE characters that cannot be used in the store.
1065 (string-map (lambda (chr)
1066 (if (and (char-set-contains? char-set:ascii chr)
1067 (char-set-contains? char-set:graphic chr)
1068 (not (memv chr '(#\. #\/ #\: #\space))))
1069 chr
1070 #\-))
1071 reference))
1072 (mlet* %store-monad
1073 ((_ (set-grafting grafts?))
1074 (guile (set-guile-for-build (default-guile)))
1075 (profile
1076 (profile-derivation value
1077 #:target target
1078 #:system system
1079 #:hooks '()
1080 #:locales? #f))
1081 (tarball (apply pack:docker-image
1082 `(,(format image-reference)
1083 ,profile
1084 ,@options
1085 #:localstatedir? #t))))
1086 (return tarball)))
1087
1088(define (lower-oci-image image)
1089 "Lower IMAGE, a oci-image record, into a tarball containing an OCI image."
1090 (match-record image <oci-image>
1091 (value pack-options target system grafts?)
1092 (define image-target
1093 (if (maybe-value-set? target)
1094 target
1095 (%current-target-system)))
1096 (define image-system
1097 (if (maybe-value-set? system)
1098 system
1099 (%current-system)))
1100 (match value
1101 ((? manifest? value)
1102 (lower-manifest value pack-options
1103 (oci-image-reference image)
1104 image-target image-system grafts?))
1105 ((? operating-system? value)
1106 (lower-operating-system value image-target image-system))
1107 ((? file-like? value)
1108 (lower-object value))
1109 (_
1110 (raise
1111 (formatted-message
1112 (G_ "oci-image value must contain only manifest,
1113operating-system, or file-like records but ~a was found")
1114 value))))))
1115
1116(define-gexp-compiler (oci-image-compiler (image <oci-image>) system target)
1117 (lower-oci-image image))
1118
1119(define-record-type* <oci-runtime-state>
1120 oci-runtime-state
1121 make-oci-runtime-state
1122 oci-runtime-state?
1123 this-oci-runtime-state
1124
1125 (runtime oci-runtime-state-runtime
1126 (default 'docker))
1127 (runtime-cli oci-runtime-state-runtime-cli)
1128 (user oci-runtime-state-user)
1129 (group oci-runtime-state-group)
1130 (runtime-environment oci-runtime-state-runtime-environment
1131 (default #~()))
1132 (runtime-requirement oci-runtime-state-runtime-requirement
1133 (default '()))
1134 (runtime-extra-arguments oci-runtime-state-runtime-extra-arguments
1135 (default '())))
1136
1137(define-record-type* <oci-state>
1138 oci-state
1139 make-oci-state
1140 oci-state?
1141 this-oci-state
1142
1143 (networks oci-state-networks)
1144 (volumes oci-state-volumes)
1145 (containers oci-state-containers)
1146 (networks-name oci-state-networks-name
1147 (default #f))
1148 (volumes-name oci-state-volumes-name
1149 (default #f))
1150 (networks-requirement oci-state-networks-requirement
1151 (default '()))
1152 (volumes-requirement oci-state-volumes-requirement
1153 (default '()))
1154 (containers-requirement oci-state-containers-requirement
1155 (default '())))
1156
1157(define-record-type* <oci-container-invocation>
1158 oci-container-invocation
1159 make-oci-container-invocation
1160 oci-container-invocation?
1161 this-oci-container-invocation
1162
1163 (runtime oci-container-invocation-runtime
1164 (default 'docker))
1165 (runtime-cli oci-container-invocation-runtime-cli)
1166 (name oci-container-invocation-name)
1167 (command oci-container-invocation-command
1168 (default '()))
1169 (image-reference oci-container-invocation-image-reference)
1170 (options oci-container-invocation-options
1171 (default '()))
1172 (run-extra-arguments oci-container-invocation-run-extra-arguments
1173 (default '()))
1174 (runtime-extra-arguments oci-container-invocation-runtime-extra-arguments
1175 (default '())))
1176
1177(define (oci-container-configuration->oci-container-invocation runtime-state
1178 config)
1179 (oci-container-invocation
1180 (runtime (oci-runtime-state-runtime runtime-state))
1181 (runtime-cli (oci-runtime-state-runtime-cli runtime-state))
1182 (name
1183 (oci-container-shepherd-name runtime config))
1184 (command
1185 (oci-container-configuration-command config))
1186 (image-reference
1187 (oci-image-reference (oci-container-configuration-image config)))
1188 (options
1189 (oci-container-configuration->options config))
1190 (run-extra-arguments
1191 (oci-container-configuration-extra-arguments config))
1192 (runtime-extra-arguments
1193 (oci-runtime-state-runtime-extra-arguments runtime-state))))
1194
1195(define* (oci-image-loader runtime-state name image tag #:key verbose?)
1196 "Return a file-like object that, once lowered, will evaluate to a program able
1197to load IMAGE through RUNTIME-CLI and to tag it with TAG afterwards."
1198 (with-imported-modules (source-module-closure '((gnu build oci-containers)))
1199 (program-file
1200 (format #f "~a-image-loader" name)
1201 #~(begin
1202 (use-modules (gnu build oci-containers))
1203 (oci-image-load '#$(oci-runtime-state-runtime runtime-state)
1204 #$(oci-runtime-state-runtime-cli runtime-state)
1205 #$image #$name #$tag
1206 #:verbose? #$verbose?)))))
1207
1208(define (oci-container-run-invocation container-invocation)
1209 "Return a list representing the OCI runtime
1210invocation for running containers."
1211 ;; run [OPTIONS] IMAGE [COMMAND] [ARG...]
1212 `(,(oci-container-invocation-runtime-cli container-invocation)
1213 ,@(oci-container-invocation-runtime-extra-arguments container-invocation)
1214 "run" "--rm"
1215 ,@(if (eq? (oci-container-invocation-runtime container-invocation)
1216 'podman)
1217 ;; This is because podman takes some time to
1218 ;; release container names. --replace seems
1219 ;; to be required to be able to restart services.
1220 '("--replace")
1221 '())
1222 "--name" ,(oci-container-invocation-name container-invocation)
1223 ,@(oci-container-invocation-options container-invocation)
1224 ,@(oci-container-invocation-run-extra-arguments container-invocation)
1225 ,(oci-container-invocation-image-reference container-invocation)
1226 ,@(oci-container-invocation-command container-invocation)))
1227
1228(define* (oci-container-entrypoint name invocation
1229 #:key verbose?
1230 (pre-script #~()))
1231 "Return a file-like object that, once lowered, will evaluate to the entrypoint
1232for the Shepherd service that will run INVOCATION."
1233 (program-file
1234 (string-append "oci-entrypoint-" name)
1235 (with-imported-modules (source-module-closure
1236 '((gnu build oci-containers)))
1237 #~(begin
1238 (use-modules (gnu build oci-containers)
1239 (srfi srfi-1))
1240 (oci-container-execlp
1241 (list #$@invocation)
1242 #:verbose? #$verbose?
1243 #:pre-script
1244 (lambda _
1245 (when (and #$verbose?
1246 (zero? (length '(#$@pre-script))))
1247 (format #t "No pre script to run..."))
1248 #$@pre-script))))))
1249
1250(define* (oci-container-shepherd-service state runtime-state config
1251 #:key verbose?
1252 networks?
1253 volumes?)
1254 "Return a Shepherd service object that will run the OCI container represented
1255by CONFIG through RUNTIME-CLI."
1256 (match-record config <oci-container-configuration>
1257 (shepherd-actions auto-start? user group host-environment
1258 log-file requirement respawn? image)
1259 (define runtime (oci-runtime-state-runtime runtime-state))
1260 (define runtime-cli (oci-runtime-state-runtime-cli runtime-state))
1261 (define image-reference (oci-image-reference image))
1262 (define shepherd-name (oci-container-shepherd-name runtime config))
1263 (define oci-container-user
1264 (if (maybe-value-set? user)
1265 user
1266 (oci-runtime-state-user runtime-state)))
1267 (define oci-container-group
1268 (if (maybe-value-set? group)
1269 group
1270 (oci-runtime-state-group runtime-state)))
1271 (define networks-service
1272 (if networks?
1273 (list
1274 (string->symbol
1275 (oci-state-networks-name state)))
1276 '()))
1277 (define volumes-service
1278 (if volumes?
1279 (list
1280 (string->symbol
1281 (oci-state-volumes-name state)))
1282 '()))
1283 (define oci-container-requirement
1284 (append requirement
1285 (oci-state-containers-requirement state)
1286 (oci-runtime-state-runtime-requirement runtime-state)
1287 networks-service
1288 volumes-service))
1289 (define environment-variables
1290 #~(append
1291 (list #$@host-environment)
1292 ;; In case this specific container is not run through the user
1293 ;; provisioned by the oci-service-type, its environment is different
1294 ;; from the globally provisioned one and must be recomputed.
1295 (list #$@(if (maybe-value-set? user)
1296 (oci-runtime-system-environment runtime user)
1297 (oci-runtime-state-runtime-environment runtime-state)))))
1298 (define invocation
1299 (oci-container-run-invocation
1300 (oci-container-configuration->oci-container-invocation
1301 runtime-state config)))
1302 (define* (container-action command)
1303 #~(lambda _
1304 (fork+exec-command
1305 (list #$@command)
1306 #$@(if oci-container-user
1307 (list #:user oci-container-user)
1308 '())
1309 #$@(if oci-container-group
1310 (list #:group oci-container-group)
1311 '())
1312 #$@(if (maybe-value-set? log-file)
1313 (list #:log-file log-file)
1314 '())
1315 #$@(if (and oci-container-user (eq? runtime 'podman))
1316 (list #:directory
1317 #~(passwd:dir
1318 (getpwnam #$oci-container-user)))
1319 '())
1320 #:environment-variables
1321 #$environment-variables)))
1322 (define start-entrypoint
1323 (oci-container-entrypoint
1324 shepherd-name invocation
1325 #:verbose? verbose?
1326 #:pre-script
1327 (if (oci-image? image)
1328 #~((system*
1329 #$(oci-image-loader
1330 runtime-state shepherd-name image
1331 image-reference
1332 #:verbose? verbose?)))
1333 #~())))
1334
1335 (shepherd-service (provision `(,(string->symbol shepherd-name)))
1336 (requirement oci-container-requirement)
1337 (respawn? respawn?)
1338 (auto-start? auto-start?)
1339 (documentation
1340 (string-append
1341 (oci-runtime-name runtime)
1342 " backed Shepherd service for "
1343 (if (oci-image? image) shepherd-name image) "."))
1344 (start
1345 (container-action
1346 (list start-entrypoint)))
1347 (stop
1348 (container-action
1349 (list
1350 (oci-container-entrypoint
1351 shepherd-name (list runtime-cli "rm" "-f" shepherd-name)
1352 #:verbose? verbose?))))
1353 (actions
1354 (append
1355 (list
1356 (oci-command-line-shepherd-action
1357 shepherd-name #~(string-join (list #$@invocation) " ")
1358 start-entrypoint))
1359 (if (oci-image? image)
1360 '()
1361 (list
1362 (shepherd-action
1363 (name 'pull)
1364 (documentation
1365 (format #f "Pull ~a's image (~a)."
1366 shepherd-name image))
1367 (procedure
1368 (container-action
1369 (list
1370 (oci-container-entrypoint
1371 shepherd-name (list runtime-cli "pull" image)
1372 #:verbose? verbose?)))))))
1373 shepherd-actions)))))
1374
1375(define (oci-object-create-invocation object runtime-cli name options
1376 runtime-extra-arguments
1377 create-extra-arguments)
1378 "Return a gexp that, upon lowering, will evaluate to the OCI runtime
1379invocation for creating networks and volumes."
1380 ;; network|volume create [options] [NAME]
1381 #~(list #$runtime-cli #$@runtime-extra-arguments #$object "create"
1382 #$@options #$@create-extra-arguments #$name))
1383
1384(define (format-oci-invocations invocations)
1385 "Return a gexp that, upon lowering, will evaluate to a formatted message
1386containing the INVOCATIONS that the OCI runtime will execute to provision
1387networks or volumes."
1388 #~(string-join (map (lambda (i) (string-join i " "))
1389 (list #$@invocations))
1390 "\n"))
1391
1392(define* (oci-object-create-script object runtime runtime-cli invocations
1393 #:key verbose?)
1394 "Return a file-like object that, once lowered, will evaluate to a program able
1395to create OCI networks and volumes through RUNTIME-CLI."
1396 (define runtime-string (symbol->string runtime))
1397 (define runtime-name (oci-runtime-name runtime))
1398 (with-imported-modules (source-module-closure
1399 '((gnu build oci-containers)))
1400
1401 (program-file
1402 (string-append runtime-string "-" object "s-create.scm")
1403 #~(begin
1404 (use-modules (gnu build oci-containers))
1405 (oci-object-create '#$runtime #$runtime-cli #$runtime-name
1406 #$object (list #$@invocations)
1407 #:verbose? #$verbose?)))))
1408
1409(define* (oci-object-shepherd-service object runtime-state name
1410 oci-state-requirement invocations
1411 #:key verbose?)
1412 "Return a Shepherd service object that will provision the OBJECTs represented
1413by INVOCATIONS through RUNTIME-STATE."
1414 (match-record runtime-state <oci-runtime-state>
1415 (runtime runtime-cli runtime-requirement user group
1416 runtime-environment)
1417 (define entrypoint
1418 (oci-object-create-script
1419 object runtime runtime-cli invocations #:verbose? verbose?))
1420 (define requirement
1421 (append runtime-requirement oci-state-requirement))
1422
1423 (shepherd-service (provision (list (string->symbol name)))
1424 (requirement requirement)
1425 (one-shot? #t)
1426 (documentation
1427 (string-append
1428 (oci-runtime-name runtime) " " object
1429 " provisioning service"))
1430 (start
1431 #~(lambda _
1432 (fork+exec-command
1433 (list #$entrypoint)
1434 #$@(if user (list #:user user) '())
1435 #$@(if group (list #:group group) '())
1436 #:environment-variables
1437 (list #$@runtime-environment))))
1438 (actions
1439 (list
1440 (oci-command-line-shepherd-action
1441 name (format-oci-invocations invocations)
1442 entrypoint))))))
1443
1444(define* (oci-networks-shepherd-service state runtime-state
1445 #:key verbose?)
1446 "Return a Shepherd service object that will create the networks represented
1447in STATE."
1448 (define runtime-cli
1449 (oci-runtime-state-runtime-cli runtime-state))
1450 (define invocations
1451 (map
1452 (lambda (network)
1453 (oci-object-create-invocation
1454 "network" runtime-cli
1455 (oci-network-configuration-name network)
1456 (oci-network-configuration->options network)
1457 (oci-runtime-state-runtime-extra-arguments runtime-state)
1458 (oci-network-configuration-extra-arguments network)))
1459 (oci-state-networks state)))
1460
1461 (oci-object-shepherd-service
1462 "network" runtime-state (oci-state-networks-name state)
1463 (oci-state-networks-requirement state)
1464 invocations #:verbose? verbose?))
1465
1466(define* (oci-volumes-shepherd-service state runtime-state
1467 #:key verbose?)
1468 "Return a Shepherd service object that will create the volumes represented
1469in STATE."
1470 (define runtime-cli
1471 (oci-runtime-state-runtime-cli runtime-state))
1472 (define invocations
1473 (map
1474 (lambda (volume)
1475 (oci-object-create-invocation
1476 "volume" runtime-cli
1477 (oci-volume-configuration-name volume)
1478 (oci-volume-configuration->options volume)
1479 (oci-runtime-state-runtime-extra-arguments runtime-state)
1480 (oci-volume-configuration-extra-arguments volume)))
1481 (oci-state-volumes state)))
1482
1483 (oci-object-shepherd-service
1484 "volume" runtime-state (oci-state-volumes-name state)
1485 (oci-state-volumes-requirement state)
1486 invocations #:verbose? verbose?))
1487
1488(define (oci-service-accounts config)
1489 (define user (oci-configuration-user config))
1490 (define maybe-group (oci-configuration-group config))
1491 (define runtime (oci-configuration-runtime config))
1492 (list (user-account
1493 (name user)
1494 (comment "OCI services account")
1495 (group "users")
1496 (supplementary-groups
1497 (list (oci-runtime-group runtime maybe-group)))
1498 (system? (eq? 'docker runtime))
1499 (home-directory (if (eq? 'podman runtime)
1500 (string-append "/home/" user)
1501 "/var/empty"))
1502 (create-home-directory? (eq? 'podman runtime))
1503 (shell (file-append shadow "/sbin/nologin")))))
1504
1505(define* (oci-state->shepherd-services state runtime-state #:key verbose?)
1506 "Returns a list of Shepherd services based on the input OCI state."
1507 (define networks?
1508 (> (length (oci-state-networks state)) 0))
1509 (define volumes?
1510 (> (length (oci-state-volumes state)) 0))
1511 (append
1512 (map
1513 (lambda (c)
1514 (oci-container-shepherd-service
1515 state runtime-state c
1516 #:verbose? verbose?
1517 #:volumes? volumes?
1518 #:networks? networks?))
1519 (oci-state-containers state))
1520 (if networks?
1521 (list
1522 (oci-networks-shepherd-service
1523 state runtime-state
1524 #:verbose? verbose?))
1525 '())
1526 (if volumes?
1527 (list
1528 (oci-volumes-shepherd-service
1529 state runtime-state
1530 #:verbose? verbose?))
1531 '())))
1532
1533(define* (oci-configuration->oci-runtime-state config #:key verbose?)
1534 (define runtime
1535 (oci-configuration-runtime config))
1536 (define home-service?
1537 (oci-configuration-home-service? config))
1538 (define runtime-cli
1539 (if home-service?
1540 (oci-runtime-home-cli config)
1541 (oci-runtime-system-cli config)))
1542 (define user
1543 (if home-service?
1544 #f
1545 (oci-configuration-user config)))
1546 (define group
1547 (if home-service?
1548 #f
1549 (if (eq? runtime 'podman)
1550 #~(group:name
1551 (getgrgid
1552 (passwd:gid
1553 (getpwnam #$user))))
1554 (oci-runtime-group config (oci-configuration-group config)))))
1555 (define runtime-requirement
1556 (if home-service?
1557 '()
1558 (oci-runtime-system-requirement runtime)))
1559 (define runtime-environment
1560 (if home-service?
1561 #~()
1562 (oci-runtime-system-environment runtime user)))
1563 (oci-runtime-state
1564 (runtime runtime)
1565 (runtime-cli runtime-cli)
1566 (user user)
1567 (group group)
1568 (runtime-extra-arguments
1569 (oci-configuration-runtime-extra-arguments config))
1570 (runtime-environment runtime-environment)
1571 (runtime-requirement runtime-requirement)))
1572
1573(define (oci-configuration->oci-state config)
1574 (define runtime
1575 (oci-configuration-runtime config))
1576 (define home-service?
1577 (oci-configuration-home-service? config))
1578 (define networks-name
1579 (if home-service?
1580 (oci-networks-home-shepherd-name runtime)
1581 (oci-networks-shepherd-name runtime)))
1582 (define volumes-name
1583 (if home-service?
1584 (oci-volumes-home-shepherd-name runtime)
1585 (oci-volumes-shepherd-name runtime)))
1586 (define networks-requirement
1587 (if home-service?
1588 '()
1589 '(networking)))
1590 (oci-state
1591 (containers (oci-configuration-containers config))
1592 (networks (oci-configuration-networks config))
1593 (volumes (oci-configuration-volumes config))
1594 (networks-name networks-name)
1595 (volumes-name volumes-name)
1596 (networks-requirement networks-requirement)))
1597
1598(define (oci-configuration->shepherd-services config)
1599 (let* ((verbose? (oci-configuration-verbose? config))
1600 (state (oci-configuration->oci-state config))
1601 (runtime-state
1602 (oci-configuration->oci-runtime-state config #:verbose? verbose?)))
1603 (oci-state->shepherd-services state runtime-state #:verbose? verbose?)))
1604
1605(define (oci-service-subids config)
1606 "Return a subids-extension record representing subuids and subgids required by
1607the rootless Podman backend."
1608 (define (find-duplicates subids)
1609 (let loop ((names '())
1610 (subids subids))
1611 (if (null? names)
1612 names
1613 (loop
1614 (let ((name (subid-range-name (car subids))))
1615 (if (member name names)
1616 (raise
1617 (formatted-message
1618 (G_ "Duplicated subid-range: ~a. subid-ranges names should be
1619unique, please remove the duplicate.") name))
1620 (cons name names)))
1621 (cdr subids)))))
1622
1623 (define runtime
1624 (oci-configuration-runtime config))
1625 (define user
1626 (oci-configuration-user config))
1627
1628 (define subgids (oci-configuration-subgids-range config))
1629 (find-duplicates subgids)
1630
1631 (define subuids (oci-configuration-subuids-range config))
1632 (find-duplicates subgids)
1633
1634 (define container-users
1635 (filter (lambda (range)
1636 (and (maybe-value-set?
1637 (subid-range-name range))
1638 (not (string=? (subid-range-name range) user))))
1639 (map (lambda (container)
1640 (subid-range
1641 (name
1642 (oci-container-configuration-user container))))
1643 (oci-configuration-containers config))))
1644 (define subgid-ranges
1645 (cons
1646 (if (maybe-value-set? subgids)
1647 subgids
1648 (subid-range (name user)))
1649 container-users))
1650 (define subuid-ranges
1651 (cons
1652 (if (maybe-value-set? subuids)
1653 subuids
1654 (subid-range (name user)))
1655 container-users))
1656
1657 (if (eq? 'podman runtime)
1658 (subids-extension
1659 (subgids
1660 subgid-ranges)
1661 (subuids
1662 subuid-ranges))
1663 (subids-extension)))
1664
1665(define (oci-objects-merge-lst a b object get-name)
1666 (define (contains? value lst)
1667 (member value (map get-name lst)))
1668 (let loop ((merged '())
1669 (lst (append a b)))
1670 (if (null? lst)
1671 merged
1672 (loop
1673 (let ((element (car lst)))
1674 (when (contains? element merged)
1675 (raise
1676 (formatted-message
1677 (G_ "Duplicated ~a: ~a. Names of ~a should be unique, please
1678remove the duplicate.") object (get-name element) object)))
1679 (cons element merged))
1680 (cdr lst)))))
1681
1682(define (oci-extension-merge a b)
1683 (oci-extension
1684 (containers (oci-objects-merge-lst
1685 (oci-extension-containers a)
1686 (oci-extension-containers b)
1687 "container"
1688 (lambda (config)
1689 (define maybe-name
1690 (oci-container-configuration-provision config))
1691 (if (maybe-value-set? maybe-name)
1692 maybe-name
1693 (oci-image->container-name
1694 (oci-container-configuration-image config))))))
1695 (networks (oci-objects-merge-lst
1696 (oci-extension-networks a)
1697 (oci-extension-networks b)
1698 "network"
1699 oci-network-configuration-name))
1700 (volumes (oci-objects-merge-lst
1701 (oci-extension-volumes a)
1702 (oci-extension-volumes b)
1703 "volume"
1704 oci-volume-configuration-name))))
1705
1706(define (oci-service-profile runtime runtime-cli)
1707 `(,bash-minimal
1708 ,@(if (string? runtime-cli)
1709 '()
1710 (list
1711 (cond
1712 ((maybe-value-set? runtime-cli)
1713 runtime-cli)
1714 ((eq? 'podman runtime)
1715 podman)
1716 (else
1717 docker-cli))))))
1718
1719(define (oci-configuration-extend config extension)
1720 (oci-configuration
1721 (inherit config)
1722 (containers
1723 (oci-objects-merge-lst
1724 (oci-configuration-containers config)
1725 (oci-extension-containers extension)
1726 "container"
1727 (lambda (oci-config)
1728 (define runtime
1729 (oci-configuration-runtime config))
1730 (oci-container-shepherd-name runtime oci-config))))
1731 (networks (oci-objects-merge-lst
1732 (oci-configuration-networks config)
1733 (oci-extension-networks extension)
1734 "network"
1735 oci-network-configuration-name))
1736 (volumes (oci-objects-merge-lst
1737 (oci-configuration-volumes config)
1738 (oci-extension-volumes extension)
1739 "volume"
1740 oci-volume-configuration-name))))
1741
1742(define oci-service-type
1743 (service-type
1744 (name 'oci)
1745 (extensions
1746 (list
1747 (service-extension profile-service-type
1748 (lambda (config)
1749 (let ((runtime-cli
1750 (oci-configuration-runtime-cli config))
1751 (runtime
1752 (oci-configuration-runtime config)))
1753 (oci-service-profile runtime runtime-cli))))
1754 (service-extension subids-service-type
1755 oci-service-subids)
1756 (service-extension account-service-type
1757 oci-service-accounts)
1758 (service-extension shepherd-root-service-type
1759 oci-configuration->shepherd-services)))
1760 ;; Concatenate OCI object lists.
1761 (compose (lambda (args)
1762 (fold oci-extension-merge
1763 (oci-extension)
1764 args)))
1765 (extend oci-configuration-extend)
1766 (default-value (oci-configuration))
1767 (description
1768 "This service implements the provisioning of OCI objects such
1769as containers, networks and volumes.")))