guix-mirrors/gnu/services/containers.scm

;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2024, 2025 Giacomo Leidi <goodoldpaul@autistici.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (gnu services containers)
  #:use-module (gnu image)
  #:use-module (gnu packages admin)
  #:use-module (gnu packages bash)
  #:use-module (gnu packages containers)
  #:use-module (gnu packages docker)
  #:use-module (gnu packages file-systems)
  #:use-module (gnu services)
  #:use-module (gnu services base)
  #:use-module (gnu services configuration)
  #:use-module (gnu services shepherd)
  #:use-module (gnu system)
  #:use-module (gnu system accounts)
  #:use-module (gnu system image)
  #:use-module (gnu system shadow)
  #:use-module (gnu system pam)
  #:use-module (guix diagnostics)
  #:use-module (guix gexp)
  #:use-module (guix i18n)
  #:use-module (guix modules)
  #:use-module (guix monads)
  #:use-module (guix packages)
  #:use-module (guix profiles)
  #:use-module ((guix scripts pack) #:prefix pack:)
  #:use-module (guix records)
  #:use-module (guix store)
  #:use-module (srfi srfi-1)
  #:use-module (ice-9 format)
  #:use-module (ice-9 match)
  #:export (rootless-podman-configuration
            rootless-podman-configuration?
            rootless-podman-configuration-fields
            rootless-podman-configuration-podman
            rootless-podman-configuration-group-name
            rootless-podman-configuration-containers-registries
            rootless-podman-configuration-containers-storage
            rootless-podman-configuration-containers-policy
            rootless-podman-configuration-pam-limits
            rootless-podman-configuration-subgids
            rootless-podman-configuration-subuids

            rootless-podman-service-subids
            rootless-podman-service-accounts
            rootless-podman-service-profile
            rootless-podman-shepherd-services
            rootless-podman-service-etc

            rootless-podman-service-type

            oci-image
            oci-image?
            oci-image-fields
            oci-image-repository
            oci-image-tag
            oci-image-value
            oci-image-pack-options
            oci-image-target
            oci-image-system
            oci-image-grafts?

            oci-container-configuration
            oci-container-configuration?
            oci-container-configuration-fields
            oci-container-configuration-user
            oci-container-configuration-group
            oci-container-configuration-command
            oci-container-configuration-entrypoint
            oci-container-configuration-host-environment
            oci-container-configuration-environment
            oci-container-configuration-image
            oci-container-configuration-provision
            oci-container-configuration-requirement
            oci-container-configuration-log-file
            oci-container-configuration-auto-start?
            oci-container-configuration-respawn?
            oci-container-configuration-shepherd-actions
            oci-container-configuration-network
            oci-container-configuration-ports
            oci-container-configuration-volumes
            oci-container-configuration-container-user
            oci-container-configuration-workdir
            oci-container-configuration-extra-arguments

            list-of-oci-containers?
            list-of-oci-networks?
            list-of-oci-volumes?

            %oci-supported-runtimes
            oci-runtime?
            oci-runtime-system-environment
            oci-runtime-system-extra-arguments
            oci-runtime-system-requirement
            oci-runtime-cli
            oci-runtime-system-cli
            oci-runtime-home-cli
            oci-runtime-name
            oci-runtime-group

            oci-network-configuration
            oci-network-configuration?
            oci-network-configuration-fields
            oci-network-configuration-name
            oci-network-configuration-driver
            oci-network-configuration-gateway
            oci-network-configuration-internal?
            oci-network-configuration-ip-range
            oci-network-configuration-ipam-driver
            oci-network-configuration-ipv6?
            oci-network-configuration-subnet
            oci-network-configuration-labels
            oci-network-configuration-extra-arguments

            oci-volume-configuration
            oci-volume-configuration?
            oci-volume-configuration-fields
            oci-volume-configuration-name
            oci-volume-configuration-labels
            oci-volume-configuration-extra-arguments

            oci-configuration
            oci-configuration?
            oci-configuration-fields
            oci-configuration-runtime
            oci-configuration-runtime-cli
            oci-configuration-runtime-extra-arguments
            oci-configuration-user
            oci-configuration-group
            oci-configuration-containers
            oci-configuration-networks
            oci-configuration-volumes
            oci-configuration-verbose?
            oci-configuration-valid?

            oci-extension
            oci-extension?
            oci-extension-fields
            oci-extension-containers
            oci-extension-networks
            oci-extension-volumes

            oci-container-shepherd-name
            oci-networks-shepherd-name
            oci-networks-home-shepherd-name
            oci-volumes-shepherd-name
            oci-volumes-home-shepherd-name

            oci-container-configuration->options
            oci-network-configuration->options
            oci-volume-configuration->options

            oci-container-shepherd-service
            oci-objects-merge-lst
            oci-extension-merge
            oci-service-type
            oci-service-accounts
            oci-service-profile
            oci-service-subids
            oci-configuration->shepherd-services
            oci-configuration-extend))

(define (gexp-or-string? value)
  (or (gexp? value)
      (string? value)))

(define (lowerable? value)
  (or (file-like? value)
      (gexp-or-string? value)))

(define list-of-pam-limits-entries?
  (list-of pam-limits-entry?))

(define list-of-subid-ranges?
  (list-of subid-range?))

(define (package-or-#f? val)
  (or (not val)
      (package? val)))

(define-configuration/no-serialization rootless-podman-configuration
  (podman
   (package-or-#f podman)
   "The Podman package that will be installed in the system profile.
@code{#f} can be passed to suppress the installation.")
  (group-name
   (string "cgroup")
   "The name of the group that will own /sys/fs/cgroup resources.  Users that
want to use rootless Podman have to be in this group.")
  (containers-registries
   (lowerable
    (plain-file "registries.conf"
                (string-append "unqualified-search-registries = ['docker.io','"
                               "registry.fedora.org','registry.opensuse.org']")))
   "A string or a gexp evaluating to the path of Podman's
@code{containers/registries.conf} configuration file.")
  (containers-storage
   (lowerable
    (plain-file "storage.conf"
                "[storage]
driver = \"overlay\""))
   "A string or a gexp evaluating to the path of Podman's
@code{containers/storage.conf} configuration file.")
  (containers-policy
   (lowerable
    (plain-file "policy.json"
                "{\"default\": [{\"type\": \"insecureAcceptAnything\"}]}"))
   "A string or a gexp evaluating to the path of Podman's
@code{containers/policy.json} configuration file.")
  (pam-limits
   (list-of-pam-limits-entries
    (list (pam-limits-entry "*" 'both 'nofile 100000)))
   "The PAM limits to be set for rootless Podman.")
  (subgids
   (list-of-subid-ranges '())
   "A list of subid ranges representing the subgids that will be
available for each configured user.")
  (subuids
   (list-of-subid-ranges '())
   "A list of subid ranges representing the subuids that will be
available for each configured user."))

(define rootless-podman-service-profile
  (lambda (config)
    (or (and=> (rootless-podman-configuration-podman config) list)
        (list))))

(define rootless-podman-service-etc
  (lambda (config)
    (list `("containers/registries.conf"
            ,(rootless-podman-configuration-containers-registries config))
          `("containers/storage.conf"
            ,(rootless-podman-configuration-containers-storage config))
          `("containers/policy.json"
            ,(rootless-podman-configuration-containers-policy config)))))

(define rootless-podman-service-subids
  (lambda (config)
    (subids-extension
     (subgids (rootless-podman-configuration-subgids config))
     (subuids (rootless-podman-configuration-subuids config)))))

(define rootless-podman-service-accounts
  (lambda (config)
    (list (user-group (name (rootless-podman-configuration-group-name config))
                      (system? #t)))))

(define (cgroups-fs-owner-entrypoint config)
  (define group
    (rootless-podman-configuration-group-name config))
  (program-file "cgroups2-fs-owner-entrypoint"
                #~(system*
                   (string-append #+bash-minimal "/bin/bash") "-l" "-c"
                   (string-append "echo Setting /sys/fs/cgroup "
                                  "group ownership to " #$group " && chown -v "
                                  "root:" #$group " /sys/fs/cgroup && "
                                  "chmod -v 775 /sys/fs/cgroup && chown -v "
                                  "root:" #$group " /sys/fs/cgroup/cgroup."
                                  "{procs,subtree_control,threads} && "
                                  "chmod -v 664 /sys/fs/cgroup/cgroup."
                                  "{procs,subtree_control,threads}"))))

(define (rootless-podman-cgroups-fs-owner-service config)
  (shepherd-service (provision '(cgroups2-fs-owner))
                    (requirement
                     '(user-processes
                       dbus-system
                       elogind
                       file-system-/sys/fs/cgroup
                       networking
                       udev
                       cgroups2-limits))
                    (one-shot? #t)
                    (documentation
                     "Set ownership of /sys/fs/cgroup to the configured group.")
                    (start
                     #~(make-forkexec-constructor
                        (list
                         #$(cgroups-fs-owner-entrypoint config))))
                    (stop
                     #~(make-kill-destructor))))

(define cgroups-limits-entrypoint
  (program-file "cgroups2-limits-entrypoint"
                #~(system*
                   (string-append #+bash-minimal "/bin/bash") "-c"
                   (string-append "echo Setting cgroups v2 limits && "
                                  "echo +cpu +cpuset +io +memory +pids"
                                  " >> /sys/fs/cgroup/cgroup.subtree_control"))))

(define (rootless-podman-cgroups-limits-service config)
  (shepherd-service (provision '(cgroups2-limits))
                    (requirement
                     '(user-processes
                       dbus-system
                       elogind
                       networking
                       udev
                       file-system-/sys/fs/cgroup
                       rootless-podman-shared-root-fs))
                    (one-shot? #t)
                    (documentation
                     "Allow setting cgroups limits: cpu, cpuset, io, memory and
pids.")
                    (start
                     #~(make-forkexec-constructor
                        (list
                         #$cgroups-limits-entrypoint)))
                    (stop
                     #~(make-kill-destructor))))

(define rootless-podman-shared-root-fs-entrypoint
  (program-file "rootless-podman-shared-root-fs-entrypoint"
                #~(system*
                   "/run/privileged/bin/mount" "--make-shared" "/")))

(define (rootless-podman-shared-root-fs-service config)
  (shepherd-service (provision '(rootless-podman-shared-root-fs))
                    (requirement
                     '(user-processes))
                    (one-shot? #t)
                    (documentation
                     "Buildah/Podman running as rootless expects the bind mount
to be shared.  This service sets it so.")
                    (start
                     #~(make-forkexec-constructor
                        (list
                         #$rootless-podman-shared-root-fs-entrypoint)))
                    (stop
                     #~(make-kill-destructor))))

(define (rootless-podman-shepherd-services config)
  (list
   (rootless-podman-shared-root-fs-service config)
   (rootless-podman-cgroups-limits-service config)
   (rootless-podman-cgroups-fs-owner-service config)))

(define rootless-podman-service-type
  (service-type (name 'rootless-podman)
                (extensions
                 (list
                  (service-extension subids-service-type
                                     rootless-podman-service-subids)
                  (service-extension account-service-type
                                     rootless-podman-service-accounts)
                  (service-extension profile-service-type
                                     rootless-podman-service-profile)
                  (service-extension shepherd-root-service-type
                                     rootless-podman-shepherd-services)
                  (service-extension pam-limits-service-type
                                     rootless-podman-configuration-pam-limits)
                  (service-extension etc-service-type
                                     rootless-podman-service-etc)))
                (default-value (rootless-podman-configuration))
                (description
                 "This service configures rootless @code{podman} on the Guix System.")))


;;;
;;; OCI provisioning service.
;;;

(define %oci-supported-runtimes
  '(docker podman))

(define (oci-runtime-system-requirement runtime)
  "Return a list of Shepherd service names required by a given OCI runtime,
before it is able to run containers."
  (if (eq? 'podman runtime)
      '(cgroups2-fs-owner cgroups2-limits
        rootless-podman-shared-root-fs user-processes)
      '(dockerd user-processes)))

(define (oci-runtime-name runtime)
  "Return a human readable name for a given OCI runtime."
  (if (eq? 'podman runtime)
      "Podman" "Docker"))

(define (oci-runtime-group runtime maybe-group)
  "Implement the logic behind selection of the group that is to be used by
Shepherd to execute OCI commands."
  (if (maybe-value-set? maybe-group)
      maybe-group
      (if (eq? 'podman runtime)
          "cgroup"
          "docker")))

(define (oci-runtime? value)
  (unless (member value %oci-supported-runtimes)
    (raise
     (formatted-message
      (G_ "OCI runtime must be a symbol and one of ~a,
but ~a was found") %oci-supported-runtimes value)))
  (symbol? value))

(define (oci-sanitize-pair pair delimiter)
  (define (valid? member)
    (or (string? member)
        (gexp? member)
        (file-like? member)))
  (match pair
    (((? valid? key) . (? valid? value))
     #~(string-append #$key #$delimiter #$value))
    (_
     (raise
      (formatted-message
       (G_ "pair members must contain only strings, gexps or file-like objects
but ~a was found")
       pair)))))

(define (oci-sanitize-mixed-list name value delimiter)
  (map
   (lambda (el)
     (cond ((string? el) el)
           ((pair? el) (oci-sanitize-pair el delimiter))
           (else
            (raise
             (formatted-message
              (G_ "~a members must be either a string or a pair but ~a was
found!")
              name el)))))
   value))

(define (oci-sanitize-host-environment value)
  ;; Expected spec format:
  ;; '(("HOME" . "/home/nobody") "JAVA_HOME=/java")
  (oci-sanitize-mixed-list "host-environment" value "="))

(define (oci-container-host-environment? value)
  (list? (oci-sanitize-host-environment value)))

(define (oci-sanitize-environment value)
  ;; Expected spec format:
  ;; '(("HOME" . "/home/nobody") "JAVA_HOME=/java")
  (oci-sanitize-mixed-list "environment" value "="))

(define (oci-container-environment? value)
  (list? (oci-sanitize-environment value)))

(define (oci-sanitize-ports value)
  ;; Expected spec format:
  ;; '(("8088" . "80") "2022:22")
  (oci-sanitize-mixed-list "ports" value ":"))

(define (oci-container-ports? value)
  (list? (oci-sanitize-ports value)))

(define (oci-sanitize-volumes value)
  ;; Expected spec format:
  ;; '(("/mnt/dir" . "/dir") "/run/current-system/profile:/java")
  (oci-sanitize-mixed-list "volumes" value ":"))

(define (oci-container-volumes? value)
  (list? (oci-sanitize-volumes value)))

(define (oci-sanitize-labels value)
  ;; Expected spec format:
  ;; '(("foo" . "bar") "foo=bar")
  (oci-sanitize-mixed-list "labels" value "="))

(define (oci-object-labels? value)
  (list? (oci-sanitize-labels value)))

(define (oci-sanitize-shepherd-actions value)
  (map
   (lambda (el)
     (if (shepherd-action? el)
         el
         (raise
          (formatted-message
           (G_ "shepherd-actions may only be shepherd-action records
but ~a was found") el))))
   value))

(define (oci-container-shepherd-actions? value)
  (list? (oci-sanitize-shepherd-actions value)))

(define (oci-sanitize-extra-arguments value)
  (define (valid? member)
    (or (string? member)
        (gexp? member)
        (file-like? member)))
  (map
   (lambda (el)
     (if (valid? el)
         el
         (raise
          (formatted-message
           (G_ "extra arguments may only be strings, gexps or file-like objects
but ~a was found") el))))
   value))

(define (oci-object-extra-arguments? value)
  (list? (oci-sanitize-extra-arguments value)))

(define (oci-image-reference image)
  "Return a string OCI image reference representing IMAGE."
  (define reference
    (if (string? image)
        image
        (string-append (oci-image-repository image)
                       ":" (oci-image-tag image))))
  (if (> (length (string-split reference #\/)) 1)
        reference
        (string-append "localhost/" reference)))

(define (oci-lowerable-image? image)
  (or (manifest? image)
      (operating-system? image)
      (gexp? image)
      (file-like? image)))

(define (string-or-oci-image? image)
  (or (string? image)
      (oci-image? image)))

(define list-of-symbols?
  (list-of symbol?))

(define (list-of-oci-records? name predicate value)
  (map
   (lambda (el)
     (if (predicate el)
         el
         (raise
          (formatted-message
           (G_ "~a contains an illegal value: ~a") name el))))
   value))

(define-maybe/no-serialization string)
(define-maybe/no-serialization package)
(define-maybe/no-serialization subid-range)

(define-configuration/no-serialization oci-image
  (repository
   (string)
   "A string like @code{myregistry.local:5000/testing/test-image} that names
the OCI image.")
  (tag
   (string "latest")
   "A string representing the OCI image tag. Defaults to @code{latest}.")
  (value
   (oci-lowerable-image)
   "A @code{manifest} or @code{operating-system} record that will be lowered
into an OCI compatible tarball.  Otherwise this field's value can be a gexp
or a file-like object that evaluates to an OCI compatible tarball.")
  (pack-options
   (list '())
   "An optional set of keyword arguments that will be passed to the
@code{docker-image} procedure from @code{guix scripts pack}.  They can be used
to replicate @command{guix pack} behavior:

@lisp
(oci-image
  (repository \"guile\")
  (tag \"3\")
  (manifest (specifications->manifest '(\"guile\")))
  (pack-options
    '(#:symlinks ((\"/bin/guile\" -> \"bin/guile\"))
      #:max-layers 2)))
@end lisp

If the @code{value} field is an @code{operating-system} record, this field's
value will be ignored.")
  (system
   (maybe-string)
   "Attempt to build for a given system, e.g. \"i686-linux\"")
  (target
   (maybe-string)
   "Attempt to cross-build for a given triple, e.g. \"aarch64-linux-gnu\"")
  (grafts?
   (boolean #f)
   "Whether to allow grafting or not in the pack build."))

(define-configuration/no-serialization oci-container-configuration
  (user
   (maybe-string)
   "The user name under whose authority OCI commands will be run.  This field will
override the @code{user} field of @code{oci-configuration}.")
  (group
   (maybe-string)
   "The group name under whose authority OCI commands will be run.  When
using the @code{'podman} OCI runtime, this field will be ignored and the
default group of the user configured in the @code{user} field will be used.
This field will override the @code{group} field of @code{oci-configuration}.")
  (command
   (list-of-strings '())
   "Overwrite the default command (@code{CMD}) of the image.")
  (entrypoint
   (maybe-string)
   "Overwrite the default entrypoint (@code{ENTRYPOINT}) of the image.")
  (host-environment
   (oci-container-host-environment '())
   "Set environment variables in the host environment where @command{docker run}
or @command{podman run} are invoked.  This is especially useful to pass secrets
from the host to the container without having them on the OCI runtime command line,
for example: by setting the @code{MYSQL_PASSWORD} on the host and by passing
@code{--env MYSQL_PASSWORD} through the @code{extra-arguments} field, it is
possible to securely set values in the container environment.  This field's
value can be a list of pairs or strings, even mixed:

@lisp
(list '(\"LANGUAGE\" . \"eo:ca:eu\")
      \"JAVA_HOME=/opt/java\")
@end lisp

Pair members can be strings, gexps or file-like objects. Strings are passed
directly to @code{make-forkexec-constructor}."
   (sanitizer oci-sanitize-host-environment))
  (environment
   (oci-container-environment '())
   "Set environment variables inside the container.  This can be a list of pairs
or strings, even mixed:

@lisp
(list '(\"LANGUAGE\" . \"eo:ca:eu\")
      \"JAVA_HOME=/opt/java\")
@end lisp

Pair members can be strings, gexps or file-like objects. Strings are passed
directly to the OCI runtime CLI.  You can refer to the
@url{https://docs.docker.com/engine/reference/commandline/run/#env,Docker}
or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#env-e-env,Podman}
upstream documentation for semantics."
   (sanitizer oci-sanitize-environment))
  (image
   (string-or-oci-image)
   "The image used to build the container.  It can be a string or an
@code{oci-image} record.  Strings are resolved by the OCI runtime,
and follow the usual format
@code{myregistry.local:5000/testing/test-image:tag}.")
  (provision
   (maybe-string)
   "Set the name of the provisioned Shepherd service.")
  (requirement
   (list-of-symbols '())
   "Set additional Shepherd services dependencies to the provisioned Shepherd
service.")
  (log-file
   (maybe-string)
   "When @code{log-file} is set, it names the file to which the service’s
standard output and standard error are redirected.  @code{log-file} is created
if it does not exist, otherwise it is appended to.")
  (auto-start?
   (boolean #t)
   "Whether this service should be started automatically by the Shepherd.  If it
is @code{#f} the service has to be started manually with @command{herd start}.")
  (respawn?
   (boolean #f)
   "Whether to restart the service when it stops, for instance when the
underlying process dies.")
  (shepherd-actions
   (oci-container-shepherd-actions '())
   "This is a list of @code{shepherd-action} records defining actions supported
by the service."
   (sanitizer oci-sanitize-shepherd-actions))
  (network
   (maybe-string)
   "Set an OCI network for the spawned container.")
  (ports
   (oci-container-ports '())
   "Set the port or port ranges to expose from the spawned container.  This can
be a list of pairs or strings, even mixed:

@lisp
(list '(\"8080\" . \"80\")
      \"10443:443\")
@end lisp

Pair members can be strings, gexps or file-like objects. Strings are passed
directly to the OCI runtime CLI.  You can refer to the
@url{https://docs.docker.com/engine/reference/commandline/run/#publish,Docker}
or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#publish-p-ip-hostport-containerport-protocol,Podman}
upstream documentation for semantics."
   (sanitizer oci-sanitize-ports))
  (volumes
   (oci-container-volumes '())
   "Set volume mappings for the spawned container.  This can be a
list of pairs or strings, even mixed:

@lisp
(list '(\"/root/data/grafana\" . \"/var/lib/grafana\")
      \"/gnu/store:/gnu/store\")
@end lisp

Pair members can be strings, gexps or file-like objects. Strings are passed
directly to the OCI runtime CLI.  You can refer to the
@url{https://docs.docker.com/engine/reference/commandline/run/#volume,Docker}
or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#volume-v-source-volume-host-dir-container-dir-options,Podman}
upstream documentation for semantics."
   (sanitizer oci-sanitize-volumes))
  (container-user
   (maybe-string)
   "Set the current user inside the spawned container.  You can refer to the
@url{https://docs.docker.com/engine/reference/run/#user,Docker}
or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#user-u-user-group,Podman}
upstream documentation for semantics.")
  (workdir
   (maybe-string)
   "Set the current working directory for the spawned Shepherd service.
You can refer to the
@url{https://docs.docker.com/engine/reference/run/#workdir,Docker}
or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#workdir-w-dir,Podman}
upstream documentation for semantics.")
  (extra-arguments
   (oci-object-extra-arguments '())
   "A list of strings, gexps or file-like objects that will be directly passed
to the @command{docker run} or @command{podman run} invocation."
   (sanitizer oci-sanitize-extra-arguments)))

(define (list-of-oci-containers? value)
  (list-of-oci-records? "containers" oci-container-configuration? value))

(define-configuration/no-serialization oci-volume-configuration
  (name
   (string)
   "The name of the OCI volume to provision.")
  (labels
   (oci-object-labels '())
   "The list of labels that will be used to tag the current volume."
   (sanitizer oci-sanitize-labels))
  (extra-arguments
   (oci-object-extra-arguments '())
   "A list of strings, gexps or file-like objects that will be directly passed
to the @command{docker volume create} or @command{podman volume create}
invocation."
   (sanitizer oci-sanitize-extra-arguments)))

(define (list-of-oci-volumes? value)
  (list-of-oci-records? "volumes" oci-volume-configuration? value))

(define-configuration/no-serialization oci-network-configuration
  (name
   (string)
   "The name of the OCI network to provision.")
  (driver
   (maybe-string)
   "The driver to manage the network.")
  (gateway
   (maybe-string)
   "IPv4 or IPv6 gateway for the subnet.")
  (internal?
   (boolean #f)
   "Restrict external access to the network")
  (ip-range
   (maybe-string)
   "Allocate container ip from a sub-range in CIDR format.")
  (ipam-driver
   (maybe-string)
   "IP Address Management Driver.")
  (ipv6?
   (boolean #f)
   "Enable IPv6 networking.")
  (subnet
   (maybe-string)
   "Subnet in CIDR format that represents a network segment.")
  (labels
   (oci-object-labels '())
   "The list of labels that will be used to tag the current volume."
   (sanitizer oci-sanitize-labels))
  (extra-arguments
   (oci-object-extra-arguments '())
   "A list of strings, gexps or file-like objects that will be directly passed
to the @command{docker network create} or @command{podman network create}
invocation."
   (sanitizer oci-sanitize-extra-arguments)))

(define (list-of-oci-networks? value)
  (list-of-oci-records? "networks" oci-network-configuration? value))

(define (package-or-string? value)
  (or (package? value) (string? value)))

(define-maybe/no-serialization package-or-string)

(define-configuration/no-serialization oci-configuration
  (runtime
   (oci-runtime 'docker)
   "The OCI runtime to use to run commands.  It can be either @code{'docker} or
@code{'podman}.")
  (runtime-cli
   (maybe-package-or-string)
   "The OCI runtime command line to be installed in the system profile and used
to provision OCI resources, it can be either a package or a string representing
an absolute file name to the runtime binary entrypoint.  When unset it will default
to @code{docker-cli} package for the @code{'docker} runtime or to @code{podman}
package for the @code{'podman} runtime.")
  (runtime-extra-arguments
   (list '())
   "A list of strings, gexps or file-like objects that will be placed
after each @command{docker} or @command{podman} invokation.")
  (user
   (string "oci-container")
   "The user name under whose authority OCI runtime commands will be run.")
  (group
   (maybe-string)
   "The group name under whose authority OCI commands will be run.  When
using the @code{'podman} OCI runtime, this field will be ignored and the
default group of the user configured in the @code{user} field will be used.")
  (subuids-range
   (maybe-subid-range)
   "An optional @code{subid-range} record allocating subuids for the user from
the @code{user} field.  When unset, with the rootless Podman OCI runtime, it
defaults to @code{(subid-range (name \"oci-container\"))}.")
  (subgids-range
   (maybe-subid-range)
   "An optional @code{subid-range} record allocating subgids for the user from
the @code{user} field.  When unset, with the rootless Podman OCI runtime, it
defaults to @code{(subid-range (name \"oci-container\"))}.")
  (containers
   (list-of-oci-containers '())
   "The list of @code{oci-container-configuration} records representing the
containers to provision.  The use of the @code{oci-extension} record should
be preferred for most cases.")
  (networks
   (list-of-oci-networks '())
   "The list of @code{oci-network-configuration} records representing the
networks to provision.  The use of the @code{oci-extension} record should
be preferred for most cases.")
  (volumes
   (list-of-oci-volumes '())
   "The list of @code{oci-volume-configuration} records representing the
volumes to provision.  The use of the @code{oci-extension} record should
be preferred for most cases.")
  (verbose?
   (boolean #f)
   "When true, additional output will be printed, allowing to better follow the
flow of execution.")
  (home-service?
   (boolean for-home?)
   "This is an internal field denoting whether this configuration is used in a
Guix Home context, as opposed to the default Guix System context."))

(define (oci-runtime-system-environment runtime user)
  (if (eq? runtime 'podman)
      (list
       #~(string-append
          "HOME=" (passwd:dir (getpwnam #$user))))
      #~()))

(define (oci-runtime-cli runtime runtime-cli profile-directory)
  "Return a gexp that, when lowered, evaluates to the  of the OCI
runtime command requested by the user."
  (if (string? runtime-cli)
      ;; It is a user defined absolute file name.
      runtime-cli
      #~(string-append
         #$(if (maybe-value-set? runtime-cli)
               runtime-cli
               profile-directory)
         #$(if (eq? 'podman runtime)
               "/bin/podman"
               "/bin/docker"))))

(define* (oci-runtime-system-cli config #:key (profile-directory "/run/current-system/profile"))
  (let ((runtime-cli
         (oci-configuration-runtime-cli config))
        (runtime
         (oci-configuration-runtime config)))
    (oci-runtime-cli runtime runtime-cli profile-directory)))

(define (oci-runtime-home-cli config)
  (let ((runtime-cli
         (oci-configuration-runtime-cli config))
        (runtime
         (oci-configuration-runtime config)))
    (oci-runtime-cli runtime runtime-cli
                     (string-append (getenv "HOME")
                                    "/.guix-home/profile"))))

(define-configuration/no-serialization oci-extension
  (containers
   (list-of-oci-containers '())
   "The list of @code{oci-container-configuration} records representing the
containers to add.")
  (networks
   (list-of-oci-networks '())
   "The list of @code{oci-network-configuration} records representing the
networks to add.")
  (volumes
   (list-of-oci-volumes '())
   "The list of @code{oci-volume-configuration} records representing the
volumes to add."))

(define (oci-image->container-name image)
  "Infer the name of an OCI backed Shepherd service from its OCI image."
  (basename
   (if (string? image)
       (first (string-split image #\:))
       (oci-image-repository image))))

(define (oci-command-line-shepherd-action object-name invocation entrypoint)
  "Return a Shepherd action printing a given INVOCATION of an OCI command for the
given OBJECT-NAME."
  (shepherd-action
   (name 'command-line)
   (documentation
    (format #f "Prints ~a's OCI runtime command line invocation."
            object-name))
   (procedure
    #~(lambda _
        (format #t "Entrypoint:~%~a~%" #$entrypoint)
        (format #t "Invocation:~%~a~%" #$invocation)))))

(define (oci-container-shepherd-name runtime config)
  "Return the name of an OCI backed Shepherd service based on CONFIG.
The name configured in the configuration record is returned when
CONFIG's name field has a value, otherwise a name is inferred from CONFIG's
image field."
  (define name (oci-container-configuration-provision config))
  (define image (oci-container-configuration-image config))

  (if (maybe-value-set? name)
      name
      (string-append (symbol->string runtime) "-"
                     (oci-image->container-name image))))

(define (oci-networks-shepherd-name runtime)
  "Return the name of the OCI networks provisioning Shepherd service based on
RUNTIME."
  (string-append (symbol->string runtime) "-networks"))

(define (oci-volumes-shepherd-name runtime)
  "Return the name of the OCI volumes provisioning Shepherd service based on
RUNTIME."
  (string-append (symbol->string runtime) "-volumes"))

(define (oci-networks-home-shepherd-name runtime)
  "Return the name of the OCI volumes provisioning Home Shepherd service based on
RUNTIME."
  (string-append "home-" (oci-networks-shepherd-name runtime)))

(define (oci-volumes-home-shepherd-name runtime)
  "Return the name of the OCI volumes provisioning Home Shepherd service based on
RUNTIME."
  (string-append "home-" (oci-volumes-shepherd-name runtime)))

(define (oci-container-configuration->options config)
  "Map CONFIG, an oci-container-configuration record, to a gexp that, upon
lowering, will be evaluated to a list of strings containing command line options
for the OCI runtime run command."
  (let ((entrypoint (oci-container-configuration-entrypoint config))
        (network (oci-container-configuration-network config))
        (user (oci-container-configuration-container-user config))
        (workdir (oci-container-configuration-workdir config)))
    (apply append
           (filter (compose not unspecified?)
                   (list (if (maybe-value-set? entrypoint)
                             `("--entrypoint" ,entrypoint)
                             '())
                         (append-map
                          (lambda (spec)
                            (list "--env" spec))
                          (oci-container-configuration-environment config))
                         (if (maybe-value-set? network)
                             `("--network" ,network)
                             '())
                         (if (maybe-value-set? user)
                             `("--user" ,user)
                             '())
                         (if (maybe-value-set? workdir)
                             `("--workdir" ,workdir)
                             '())
                         (append-map
                          (lambda (spec)
                            (list "-p" spec))
                          (oci-container-configuration-ports config))
                         (append-map
                          (lambda (spec)
                            (list "-v" spec))
                          (oci-container-configuration-volumes config)))))))

(define (oci-network-configuration->options config)
  "Map CONFIG, an oci-network-configuration record, to a gexp that, upon
lowering, will be evaluated to a list of strings containing command line options
for the OCI runtime network create command."
  (let ((driver (oci-network-configuration-driver config))
        (gateway (oci-network-configuration-gateway config))
        (internal? (oci-network-configuration-internal? config))
        (ip-range (oci-network-configuration-ip-range config))
        (ipam-driver (oci-network-configuration-ipam-driver config))
        (ipv6? (oci-network-configuration-ipv6? config))
        (subnet (oci-network-configuration-subnet config)))
    (apply append
           (filter (compose not unspecified?)
                   (list (if (maybe-value-set? driver)
                             `("--driver" ,driver)
                             '())
                         (if (maybe-value-set? gateway)
                             `("--gateway" ,gateway)
                             '())
                         (if internal?
                             `("--internal")
                             '())
                         (if (maybe-value-set? ip-range)
                             `("--ip-range" ,ip-range)
                             '())
                         (if (maybe-value-set? ipam-driver)
                             `("--ipam-driver" ,ipam-driver)
                             '())
                         (if ipv6?
                             `("--ipv6")
                             '())
                         (if (maybe-value-set? subnet)
                             `("--subnet" ,subnet)
                             '())
                         (append-map
                          (lambda (spec)
                            (list "--label" spec))
                          (oci-network-configuration-labels config)))))))

(define (oci-volume-configuration->options config)
  "Map CONFIG, an oci-volume-configuration record, to a gexp that, upon
lowering, will be evaluated to a list of strings containing command line options
for the OCI runtime volume create command."
  (append-map
   (lambda (spec)
     (list "--label" spec))
   (oci-volume-configuration-labels config)))

(define (lower-operating-system os target system)
  "Lower OS, an operating-system record, into a tarball containing an OCI image."
  (mlet* %store-monad
      ((tarball
        (lower-object
         (system-image (os->image os #:type docker-image-type))
         system
         #:target target)))
    (return tarball)))

(define (lower-manifest name value options image-reference
                        target system grafts?)
  "Lower VALUE, a manifest record, into a tarball containing an OCI image."
  (mlet* %store-monad
      ((_ (set-grafting grafts?))
       (guile (set-guile-for-build (default-guile)))
       (profile
        (profile-derivation value
                            #:target target
                            #:system system
                            #:hooks '()
                            #:locales? #f))
       (tarball (apply pack:docker-image
                       `(,name ,profile
                         ,@options
                         #:localstatedir? #t))))
    (return tarball)))

(define (lower-oci-image-state name value options reference
                               image-target image-system grafts?)
  (define target
    (if (maybe-value-set? image-target)
        image-target
        (%current-target-system)))
  (define system
    (if (maybe-value-set? image-system)
        image-system
        (%current-system)))
  (with-store store
   (run-with-store store
     (match value
       ((? manifest? value)
        (lower-manifest name value options reference
                        target system grafts?))
       ((? operating-system? value)
        (lower-operating-system value target system))
       ((or (? gexp? value)
            (? file-like? value))
        value)
       (_
        (raise
         (formatted-message
          (G_ "oci-image value must contain only manifest,
operating-system, gexp or file-like records but ~a was found")
          value))))
     #:target target
     #:system system)))

(define (lower-oci-image name image)
  "Lower IMAGE, a oci-image record, into a tarball containing an OCI image."
  (lower-oci-image-state
   name
   (oci-image-value image)
   (oci-image-pack-options image)
   (oci-image-reference image)
   (oci-image-target image)
   (oci-image-system image)
   (oci-image-grafts? image)))

(define-record-type* <oci-runtime-state>
  oci-runtime-state
  make-oci-runtime-state
  oci-runtime-state?
  this-oci-runtime-state

  (runtime                  oci-runtime-state-runtime
                            (default 'docker))
  (runtime-cli              oci-runtime-state-runtime-cli)
  (user                     oci-runtime-state-user)
  (group                    oci-runtime-state-group)
  (runtime-environment      oci-runtime-state-runtime-environment
                            (default #~()))
  (runtime-requirement      oci-runtime-state-runtime-requirement
                            (default '()))
  (runtime-extra-arguments  oci-runtime-state-runtime-extra-arguments
                            (default '())))

(define-record-type* <oci-state>
  oci-state
  make-oci-state
  oci-state?
  this-oci-state

  (networks                 oci-state-networks)
  (volumes                  oci-state-volumes)
  (containers               oci-state-containers)
  (networks-name            oci-state-networks-name
                            (default #f))
  (volumes-name             oci-state-volumes-name
                            (default #f))
  (networks-requirement     oci-state-networks-requirement
                            (default '()))
  (volumes-requirement      oci-state-volumes-requirement
                            (default '()))
  (containers-requirement   oci-state-containers-requirement
                            (default '())))

(define-record-type* <oci-container-invocation>
  oci-container-invocation
  make-oci-container-invocation
  oci-container-invocation?
  this-oci-container-invocation

  (runtime                  oci-container-invocation-runtime
                            (default 'docker))
  (runtime-cli              oci-container-invocation-runtime-cli)
  (name                     oci-container-invocation-name)
  (command                  oci-container-invocation-command
                            (default '()))
  (image-reference          oci-container-invocation-image-reference)
  (options                  oci-container-invocation-options
                            (default '()))
  (run-extra-arguments      oci-container-invocation-run-extra-arguments
                            (default '()))
  (runtime-extra-arguments  oci-container-invocation-runtime-extra-arguments
                            (default '())))

(define (oci-container-configuration->oci-container-invocation runtime-state
                                                               config)
  (oci-container-invocation
   (runtime (oci-runtime-state-runtime runtime-state))
   (runtime-cli (oci-runtime-state-runtime-cli runtime-state))
   (name
    (oci-container-shepherd-name runtime config))
   (command
    (oci-container-configuration-command config))
   (image-reference
    (oci-image-reference (oci-container-configuration-image config)))
   (options
    (oci-container-configuration->options config))
   (run-extra-arguments
    (oci-container-configuration-extra-arguments config))
   (runtime-extra-arguments
    (oci-runtime-state-runtime-extra-arguments runtime-state))))

(define* (oci-image-loader runtime-state name image tag #:key verbose?)
  "Return a file-like object that, once lowered, will evaluate to a program able
to load IMAGE through RUNTIME-CLI and to tag it with TAG afterwards."
  (let ((tarball (lower-oci-image name image)))
    (with-imported-modules (source-module-closure '((gnu build oci-containers)))
      (program-file
       (format #f "~a-image-loader" name)
       #~(begin
           (use-modules (gnu build oci-containers))
           (oci-image-load '#$(oci-runtime-state-runtime runtime-state)
                           #$(oci-runtime-state-runtime-cli runtime-state)
                           #$tarball #$name #$tag
                           #:verbose? #$verbose?))))))

(define (oci-container-run-invocation container-invocation)
  "Return a list representing the OCI runtime
invocation for running containers."
  ;; run [OPTIONS] IMAGE [COMMAND] [ARG...]
  `(,(oci-container-invocation-runtime-cli container-invocation)
    ,@(oci-container-invocation-runtime-extra-arguments container-invocation)
    "run" "--rm"
    ,@(if (eq? (oci-container-invocation-runtime container-invocation)
               'podman)
          ;; This is because podman takes some time to
          ;; release container names.  --replace seems
          ;; to be required to be able to restart services.
          '("--replace")
          '())
    "--name" ,(oci-container-invocation-name container-invocation)
    ,@(oci-container-invocation-options container-invocation)
    ,@(oci-container-invocation-run-extra-arguments container-invocation)
    ,(oci-container-invocation-image-reference container-invocation)
    ,@(oci-container-invocation-command container-invocation)))

(define* (oci-container-entrypoint name invocation
                                   #:key verbose?
                                   (pre-script #~()))
  "Return a file-like object that, once lowered, will evaluate to the entrypoint
for the Shepherd service that will run INVOCATION."
  (program-file
   (string-append "oci-entrypoint-" name)
   (with-imported-modules (source-module-closure
                           '((gnu build oci-containers)))
     #~(begin
         (use-modules (gnu build oci-containers)
                      (srfi srfi-1))
         (oci-container-execlp
          (list #$@invocation)
          #:verbose? #$verbose?
          #:pre-script
          (lambda _
            (when (and #$verbose?
                       (zero? (length '(#$@pre-script))))
              (format #t "No pre script to run..."))
            #$@pre-script))))))

(define* (oci-container-shepherd-service state runtime-state config
                                         #:key verbose?
                                         networks?
                                         volumes?)
  "Return a Shepherd service object that will run the OCI container represented
by CONFIG through RUNTIME-CLI."
  (match-record config <oci-container-configuration>
                (shepherd-actions auto-start? user group host-environment
                 log-file requirement respawn? image)
    (define runtime (oci-runtime-state-runtime runtime-state))
    (define runtime-cli (oci-runtime-state-runtime-cli runtime-state))
    (define image-reference (oci-image-reference image))
    (define shepherd-name (oci-container-shepherd-name runtime config))
    (define oci-container-user
      (if (maybe-value-set? user)
          user
          (oci-runtime-state-user runtime-state)))
    (define oci-container-group
      (if (maybe-value-set? group)
          group
          (oci-runtime-state-group runtime-state)))
    (define networks-service
      (if networks?
          (list
           (string->symbol
            (oci-state-networks-name state)))
          '()))
    (define volumes-service
     (if volumes?
         (list
          (string->symbol
           (oci-state-volumes-name state)))
         '()))
    (define oci-container-requirement
      (append requirement
              (oci-state-containers-requirement state)
              (oci-runtime-state-runtime-requirement runtime-state)
              networks-service
              volumes-service))
    (define environment-variables
      #~(append
         (list #$@host-environment)
         (list #$@(oci-runtime-state-runtime-environment runtime-state))))
    (define invocation
      (oci-container-run-invocation
       (oci-container-configuration->oci-container-invocation
        runtime-state config)))
    (define* (container-action command)
      #~(lambda _
          (fork+exec-command
           (list #$@command)
           #$@(if oci-container-user
                  (list #:user oci-container-user)
                  '())
           #$@(if oci-container-group
                  (list #:group oci-container-group)
                  '())
           #$@(if (maybe-value-set? log-file)
                  (list #:log-file log-file)
                  '())
           #$@(if (and oci-container-user (eq? runtime 'podman))
                  (list #:directory
                        #~(passwd:dir
                           (getpwnam #$oci-container-user)))
                  '())
           #:environment-variables
           #$environment-variables)))
    (define start-entrypoint
      (oci-container-entrypoint
       shepherd-name invocation
       #:verbose? verbose?
       #:pre-script
       (if (oci-image? image)
           #~((system*
               #$(oci-image-loader
                  runtime-state shepherd-name image
                  image-reference
                  #:verbose? verbose?)))
           #~())))

    (shepherd-service (provision `(,(string->symbol shepherd-name)))
                      (requirement oci-container-requirement)
                      (respawn? respawn?)
                      (auto-start? auto-start?)
                      (documentation
                       (string-append
                        (oci-runtime-name runtime)
                        " backed Shepherd service for "
                        (if (oci-image? image) shepherd-name image) "."))
                      (start
                       (container-action
                        (list start-entrypoint)))
                      (stop
                       (container-action
                        (list
                         (oci-container-entrypoint
                          shepherd-name (list runtime-cli "rm" "-f" shepherd-name)
                          #:verbose? verbose?))))
                      (actions
                       (append
                        (list
                         (oci-command-line-shepherd-action
                          shepherd-name #~(string-join (list #$@invocation) " ")
                          start-entrypoint))
                        (if (oci-image? image)
                            '()
                            (list
                             (shepherd-action
                              (name 'pull)
                              (documentation
                               (format #f "Pull ~a's image (~a)."
                                       shepherd-name image))
                              (procedure
                               (container-action
                                (list
                                 (oci-container-entrypoint
                                  shepherd-name (list runtime-cli "pull" image)
                                  #:verbose? verbose?)))))))
                        shepherd-actions)))))

(define (oci-object-create-invocation object runtime-cli name options
                                      runtime-extra-arguments
                                      create-extra-arguments)
  "Return a gexp that, upon lowering, will evaluate to the OCI runtime
invocation for creating networks and volumes."
  ;; network|volume create [options] [NAME]
  #~(list #$runtime-cli #$@runtime-extra-arguments #$object "create"
          #$@options #$@create-extra-arguments #$name))

(define (format-oci-invocations invocations)
  "Return a gexp that, upon lowering, will evaluate to a formatted message
containing the INVOCATIONS that the OCI runtime will execute to provision
networks or volumes."
  #~(string-join (map (lambda (i) (string-join i " "))
                      (list #$@invocations))
                 "\n"))

(define* (oci-object-create-script object runtime runtime-cli invocations
                                   #:key verbose?)
  "Return a file-like object that, once lowered, will evaluate to a program able
to create OCI networks and volumes through RUNTIME-CLI."
  (define runtime-string (symbol->string runtime))
  (define runtime-name (oci-runtime-name runtime))
  (with-imported-modules (source-module-closure
                          '((gnu build oci-containers)))

    (program-file
     (string-append runtime-string "-" object "s-create.scm")
     #~(begin
         (use-modules (gnu build oci-containers))
         (oci-object-create '#$runtime #$runtime-cli #$runtime-name
                            #$object (list #$@invocations)
                            #:verbose? #$verbose?)))))

(define* (oci-object-shepherd-service object runtime-state name
                                      oci-state-requirement invocations
                                      #:key verbose?)
  "Return a Shepherd service object that will provision the OBJECTs represented
by INVOCATIONS through RUNTIME-STATE."
  (match-record runtime-state <oci-runtime-state>
                (runtime runtime-cli runtime-requirement user group
                 runtime-environment)
    (define entrypoint
      (oci-object-create-script
       object runtime runtime-cli invocations #:verbose? verbose?))
    (define requirement
      (append runtime-requirement oci-state-requirement))

    (shepherd-service (provision (list (string->symbol name)))
                      (requirement requirement)
                      (one-shot? #t)
                      (documentation
                       (string-append
                        (oci-runtime-name runtime) " " object
                        " provisioning service"))
                      (start
                       #~(lambda _
                           (fork+exec-command
                            (list #$entrypoint)
                            #$@(if user (list #:user user) '())
                            #$@(if group (list #:group group) '())
                            #:environment-variables
                            (list #$@runtime-environment))))
                      (actions
                       (list
                        (oci-command-line-shepherd-action
                         name (format-oci-invocations invocations)
                         entrypoint))))))

(define* (oci-networks-shepherd-service state runtime-state
                                        #:key verbose?)
  "Return a Shepherd service object that will create the networks represented
in STATE."
  (define runtime-cli
    (oci-runtime-state-runtime-cli runtime-state))
  (define invocations
    (map
     (lambda (network)
       (oci-object-create-invocation
        "network" runtime-cli
        (oci-network-configuration-name network)
        (oci-network-configuration->options network)
        (oci-runtime-state-runtime-extra-arguments runtime-state)
        (oci-network-configuration-extra-arguments network)))
     (oci-state-networks state)))

  (oci-object-shepherd-service
   "network" runtime-state (oci-state-networks-name state)
   (oci-state-networks-requirement state)
   invocations #:verbose? verbose?))

(define* (oci-volumes-shepherd-service state runtime-state
                                       #:key verbose?)
  "Return a Shepherd service object that will create the volumes represented
in STATE."
  (define runtime-cli
    (oci-runtime-state-runtime-cli runtime-state))
  (define invocations
    (map
     (lambda (volume)
       (oci-object-create-invocation
        "volume" runtime-cli
        (oci-volume-configuration-name volume)
        (oci-volume-configuration->options volume)
        (oci-runtime-state-runtime-extra-arguments runtime-state)
        (oci-volume-configuration-extra-arguments volume)))
     (oci-state-volumes state)))

  (oci-object-shepherd-service
   "volume" runtime-state (oci-state-volumes-name state)
   (oci-state-volumes-requirement state)
   invocations #:verbose? verbose?))

(define (oci-service-accounts config)
  (define user (oci-configuration-user config))
  (define maybe-group (oci-configuration-group config))
  (define runtime (oci-configuration-runtime config))
  (list (user-account
         (name user)
         (comment "OCI services account")
         (group "users")
         (supplementary-groups
          (list (oci-runtime-group runtime maybe-group)))
         (system? (eq? 'docker runtime))
         (home-directory (if (eq? 'podman runtime)
                             (string-append "/home/" user)
                             "/var/empty"))
         (create-home-directory? (eq? 'podman runtime))
         (shell (file-append shadow "/sbin/nologin")))))

(define* (oci-state->shepherd-services state runtime-state #:key verbose?)
  "Returns a list of Shepherd services based on the input OCI state."
  (define networks?
    (> (length (oci-state-networks state)) 0))
  (define volumes?
    (> (length (oci-state-volumes state)) 0))
  (append
   (map
    (lambda (c)
      (oci-container-shepherd-service
       state runtime-state c
       #:verbose? verbose?
       #:volumes? volumes?
       #:networks? networks?))
    (oci-state-containers state))
   (if networks?
       (list
        (oci-networks-shepherd-service
         state runtime-state
         #:verbose? verbose?))
       '())
   (if volumes?
       (list
        (oci-volumes-shepherd-service
         state runtime-state
         #:verbose? verbose?))
       '())))

(define* (oci-configuration->oci-runtime-state config #:key verbose?)
  (define runtime
    (oci-configuration-runtime config))
  (define home-service?
    (oci-configuration-home-service? config))
  (define runtime-cli
    (if home-service?
        (oci-runtime-home-cli config)
        (oci-runtime-system-cli config)))
  (define user
    (if home-service?
        #f
        (oci-configuration-user config)))
  (define group
    (if home-service?
        #f
        (if (eq? runtime 'podman)
            #~(group:name
               (getgrgid
                (passwd:gid
                 (getpwnam #$user))))
            (oci-runtime-group config (oci-configuration-group config)))))
  (define runtime-requirement
    (if home-service?
        '()
        (oci-runtime-system-requirement runtime)))
  (define runtime-environment
    (if home-service?
        #~()
        (oci-runtime-system-environment runtime user)))
  (oci-runtime-state
   (runtime runtime)
   (runtime-cli runtime-cli)
   (user user)
   (group group)
   (runtime-extra-arguments
    (oci-configuration-runtime-extra-arguments config))
   (runtime-environment runtime-environment)
   (runtime-requirement runtime-requirement)))

(define (oci-configuration->oci-state config)
  (define runtime
    (oci-configuration-runtime config))
  (define home-service?
    (oci-configuration-home-service? config))
  (define networks-name
    (if home-service?
        (oci-networks-home-shepherd-name runtime)
        (oci-networks-shepherd-name runtime)))
  (define volumes-name
    (if home-service?
        (oci-volumes-home-shepherd-name runtime)
        (oci-volumes-shepherd-name runtime)))
  (define networks-requirement
    (if home-service?
        '()
        '(networking)))
  (oci-state
   (containers (oci-configuration-containers config))
   (networks (oci-configuration-networks config))
   (volumes (oci-configuration-volumes config))
   (networks-name networks-name)
   (volumes-name volumes-name)
   (networks-requirement networks-requirement)))

(define (oci-configuration->shepherd-services config)
  (let* ((verbose? (oci-configuration-verbose? config))
         (state (oci-configuration->oci-state config))
         (runtime-state
          (oci-configuration->oci-runtime-state config #:verbose? verbose?)))
    (oci-state->shepherd-services state runtime-state #:verbose? verbose?)))

(define (oci-service-subids config)
  "Return a subids-extension record representing subuids and subgids required by
the rootless Podman backend."
  (define (find-duplicates subids)
    (let loop ((names '())
               (subids subids))
      (if (null? names)
          names
          (loop
           (let ((name (subid-range-name (car subids))))
             (if (member name names)
                 (raise
                  (formatted-message
                   (G_ "Duplicated subid-range: ~a. subid-ranges names should be
unique, please remove the duplicate.") name))
                 (cons name names)))
           (cdr subids)))))

  (define runtime
    (oci-configuration-runtime config))
  (define user
    (oci-configuration-user config))

  (define subgids (oci-configuration-subgids-range config))
  (find-duplicates subgids)

  (define subuids (oci-configuration-subuids-range config))
  (find-duplicates subgids)

  (define container-users
    (filter (lambda (range)
              (and (maybe-value-set?
                    (subid-range-name range))
                   (not (string=? (subid-range-name range) user))))
            (map (lambda (container)
                   (subid-range
                    (name
                     (oci-container-configuration-user container))))
                 (oci-configuration-containers config))))
  (define subgid-ranges
    (cons
     (if (maybe-value-set? subgids)
         subgids
         (subid-range (name user)))
     container-users))
  (define subuid-ranges
    (cons
     (if (maybe-value-set? subuids)
         subuids
         (subid-range (name user)))
     container-users))

  (if (eq? 'podman runtime)
      (subids-extension
       (subgids
        subgid-ranges)
       (subuids
        subuid-ranges))
      (subids-extension)))

(define (oci-objects-merge-lst a b object get-name)
  (define (contains? value lst)
    (member value (map get-name lst)))
  (let loop ((merged '())
             (lst (append a b)))
    (if (null? lst)
        merged
        (loop
         (let ((element (car lst)))
           (when (contains? element merged)
             (raise
              (formatted-message
               (G_ "Duplicated ~a: ~a. Names of ~a should be unique, please
remove the duplicate.") object (get-name element) object)))
           (cons element merged))
         (cdr lst)))))

(define (oci-extension-merge a b)
  (oci-extension
   (containers (oci-objects-merge-lst
                (oci-extension-containers a)
                (oci-extension-containers b)
                "container"
                (lambda (config)
                  (define maybe-name
                    (oci-container-configuration-provision config))
                  (if (maybe-value-set? maybe-name)
                      maybe-name
                      (oci-image->container-name
                       (oci-container-configuration-image config))))))
   (networks (oci-objects-merge-lst
              (oci-extension-networks a)
              (oci-extension-networks b)
              "network"
              oci-network-configuration-name))
   (volumes (oci-objects-merge-lst
             (oci-extension-volumes a)
             (oci-extension-volumes b)
             "volume"
             oci-volume-configuration-name))))

(define (oci-service-profile runtime runtime-cli)
  `(,bash-minimal
    ,@(if (string? runtime-cli)
          '()
          (list
           (cond
            ((maybe-value-set? runtime-cli)
             runtime-cli)
            ((eq? 'podman runtime)
             podman)
            (else
             docker-cli))))))

(define (oci-configuration-extend config extension)
  (oci-configuration
   (inherit config)
   (containers
    (oci-objects-merge-lst
     (oci-configuration-containers config)
     (oci-extension-containers extension)
     "container"
     (lambda (oci-config)
       (define runtime
         (oci-configuration-runtime config))
       (oci-container-shepherd-name runtime oci-config))))
   (networks (oci-objects-merge-lst
              (oci-configuration-networks config)
              (oci-extension-networks extension)
              "network"
              oci-network-configuration-name))
   (volumes (oci-objects-merge-lst
             (oci-configuration-volumes config)
             (oci-extension-volumes extension)
             "volume"
             oci-volume-configuration-name))))

(define oci-service-type
  (service-type
   (name 'oci)
   (extensions
    (list
     (service-extension profile-service-type
                        (lambda (config)
                          (let ((runtime-cli
                                 (oci-configuration-runtime-cli config))
                                (runtime
                                 (oci-configuration-runtime config)))
                            (oci-service-profile runtime runtime-cli))))
     (service-extension subids-service-type
                        oci-service-subids)
     (service-extension account-service-type
                        oci-service-accounts)
     (service-extension shepherd-root-service-type
                        oci-configuration->shepherd-services)))
   ;; Concatenate OCI object lists.
   (compose (lambda (args)
              (fold oci-extension-merge
                    (oci-extension)
                    args)))
   (extend oci-configuration-extend)
   (default-value (oci-configuration))
   (description
    "This service implements the provisioning of OCI objects such
as containers, networks and volumes.")))