projects/guix·blob java-team · refs

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