Subject: [bug#76081] [PATCH v8 2/5] services: oci-container-configuration: Move to (gnu services containers).

From: Giacomo Leidi <[email-masked]>
Date: Sun, 9 Mar 2025 02:06:12 +0100

This patch moves the oci-container-configuration and related
configuration records to (gnu services containers).
Public symbols are still exported for backwards
compatibility but since the oci-container-service-type will be
deprecated in favor of the more general oci-service-type, everything is
moved outside of the docker related module.

* gnu/services/docker.scm: Move everything related to oci-container-configuration
to...
* gnu/services/containers.scm: ...here.scm.
* gnu/tests/docker.scm: Simplify %test-oci-container test case.

Change-Id: Iae599dd5cc7442eb632f0c1b3b12f6b928397ae7
---
 gnu/services/containers.scm | 549 +++++++++++++++++++++++++++++++++-
 gnu/services/docker.scm     | 577 +++---------------------------------
 gnu/tests/docker.scm        |  99 +++----
 3 files changed, 625 insertions(+), 600 deletions(-)

diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm
index d5a211765a6..24f31c756b8 100644
--- a/gnu/services/containers.scm
+++ b/gnu/services/containers.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2024 Giacomo Leidi <[email-masked]>
+;;; Copyright © 2024, 2025 Giacomo Leidi <[email-masked]>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -17,19 +17,31 @@
 ;;; 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 monads)
   #:use-module (guix packages)
+  #:use-module (guix profiles)
+  #:use-module ((guix scripts pack) #:prefix pack:)
+  #:use-module (guix store)
   #:use-module (srfi srfi-1)
+  #:use-module (ice-9 match)
   #:export (rootless-podman-configuration
             rootless-podman-configuration?
             rootless-podman-configuration-fields
@@ -48,7 +60,44 @@ (define-module (gnu services containers)
             rootless-podman-shepherd-services
             rootless-podman-service-etc
 
-            rootless-podman-service-type))
+            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
+
+            oci-container-shepherd-service
+            %oci-container-accounts))
 
 (define (gexp-or-string? value)
   (or (gexp? value)
@@ -190,7 +239,7 @@ (define (rootless-podman-cgroups-limits-service config)
                        rootless-podman-shared-root-fs))
                     (one-shot? #t)
                     (documentation
-                     "Allow setting cgroups limits: cpu, cpuset, memory and
+                     "Allow setting cgroups limits: cpu, cpuset, io, memory and
 pids.")
                     (start
                      #~(make-forkexec-constructor
@@ -244,3 +293,497 @@ (define rootless-podman-service-type
                 (default-value (rootless-podman-configuration))
                 (description
                  "This service configures rootless @code{podman} on the Guix System.")))
+
+
+;;;
+;;; OCI container.
+;;;
+
+(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-sanitize-environment value)
+  ;; Expected spec format:
+  ;; '(("HOME" . "/home/nobody") "JAVA_HOME=/java")
+  (oci-sanitize-mixed-list "environment" value "="))
+
+(define (oci-sanitize-ports value)
+  ;; Expected spec format:
+  ;; '(("8088" . "80") "2022:22")
+  (oci-sanitize-mixed-list "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-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-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-image-reference image)
+  (if (string? image)
+      image
+      (string-append (oci-image-repository image)
+                     ":" (oci-image-tag image))))
+
+(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-maybe/no-serialization string)
+
+(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
+   (string "oci-container")
+   "The user under whose authority docker commands will be run.")
+  (group
+   (string "docker")
+   "The group under whose authority docker commands will be run.")
+  (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
+   (list '())
+   "Set environment variables in the host environment where @command{docker run}
+is invoked.  This is especially useful to pass secrets from the host to the
+container without having them on the @command{docker run}'s command line: 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
+   (list '())
+   "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 Docker CLI.  You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#env,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 Docker
+Engine, 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
+   (list '())
+   "This is a list of @code{shepherd-action} records defining actions supported
+by the service."
+   (sanitizer oci-sanitize-shepherd-actions))
+  (network
+   (maybe-string)
+   "Set a Docker network for the spawned container.")
+  (ports
+   (list '())
+   "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 Docker CLI.  You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#publish,upstream}
+documentation for semantics."
+   (sanitizer oci-sanitize-ports))
+  (volumes
+   (list '())
+   "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 Docker CLI.  You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#volume,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,upstream}
+documentation for semantics.")
+  (workdir
+   (maybe-string)
+   "Set the current working for the spawned Shepherd service.
+You can refer to the
+@url{https://docs.docker.com/engine/reference/run/#workdir,upstream}
+documentation for semantics.")
+  (extra-arguments
+   (list '())
+   "A list of strings, gexps or file-like objects that will be directly passed
+to the @command{docker run} invokation."
+   (sanitizer oci-sanitize-extra-arguments)))
+
+(define oci-container-configuration->options
+  (lambda (config)
+    (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?)
+                     `(,(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* (get-keyword-value args keyword #:key (default #f))
+  (let ((kv (memq keyword args)))
+    (if (and kv (>= (length kv) 2))
+        (cadr kv)
+        default)))
+
+(define (lower-operating-system os target system)
+  (mlet* %store-monad
+      ((tarball
+        (lower-object
+         (system-image (os->image os #:type docker-image-type))
+         system
+         #:target target)))
+    (return tarball)))
+
+(define (lower-manifest name image target system)
+  (define value (oci-image-value image))
+  (define options (oci-image-pack-options image))
+  (define image-reference
+    (oci-image-reference image))
+  (define image-tag
+    (let* ((extra-options
+            (get-keyword-value options #:extra-options))
+           (image-tag-option
+            (and extra-options
+                 (get-keyword-value extra-options #:image-tag))))
+      (if image-tag-option
+          '()
+          `(#:extra-options (#:image-tag ,image-reference)))))
+
+  (mlet* %store-monad
+      ((_ (set-grafting
+           (oci-image-grafts? image)))
+       (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
+                         ,@image-tag
+                         #:localstatedir? #t))))
+    (return tarball)))
+
+(define (lower-oci-image name image)
+  (define value (oci-image-value image))
+  (define image-target (oci-image-target image))
+  (define image-system (oci-image-system image))
+  (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 image target system))
+       ((? 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 (%oci-image-loader name image tag)
+  (let ((docker (file-append docker-cli "/bin/docker"))
+        (tarball (lower-oci-image name image)))
+    (with-imported-modules '((guix build utils))
+      (program-file (format #f "~a-image-loader" name)
+       #~(begin
+           (use-modules (guix build utils)
+                        (ice-9 popen)
+                        (ice-9 rdelim))
+
+           (format #t "Loading image for ~a from ~a...~%" #$name #$tarball)
+           (define line
+             (read-line
+              (open-input-pipe
+               (string-append #$docker " load -i " #$tarball))))
+
+           (unless (or (eof-object? line)
+                       (string-null? line))
+             (format #t "~a~%" line)
+             (let ((repository&tag
+                    (string-drop line
+                                 (string-length
+                                   "Loaded image: "))))
+
+               (invoke #$docker "tag" repository&tag #$tag)
+               (format #t "Tagged ~a with ~a...~%" #$tarball #$tag))))))))
+
+(define (oci-container-shepherd-service config)
+  (define (guess-name name image)
+    (if (maybe-value-set? name)
+        name
+        (string-append "docker-"
+                       (basename
+                        (if (string? image)
+                            (first (string-split image #\:))
+                            (oci-image-repository image))))))
+
+  (let* ((docker (file-append docker-cli "/bin/docker"))
+         (actions (oci-container-configuration-shepherd-actions config))
+         (auto-start?
+          (oci-container-configuration-auto-start? config))
+         (user (oci-container-configuration-user config))
+         (group (oci-container-configuration-group config))
+         (host-environment
+          (oci-container-configuration-host-environment config))
+         (command (oci-container-configuration-command config))
+         (log-file (oci-container-configuration-log-file config))
+         (provision (oci-container-configuration-provision config))
+         (requirement (oci-container-configuration-requirement config))
+         (respawn?
+          (oci-container-configuration-respawn? config))
+         (image (oci-container-configuration-image config))
+         (image-reference (oci-image-reference image))
+         (options (oci-container-configuration->options config))
+         (name (guess-name provision image))
+         (extra-arguments
+          (oci-container-configuration-extra-arguments config)))
+
+    (shepherd-service (provision `(,(string->symbol name)))
+                      (requirement `(dockerd user-processes ,@requirement))
+                      (respawn? respawn?)
+                      (auto-start? auto-start?)
+                      (documentation
+                       (string-append
+                        "Docker backed Shepherd service for "
+                        (if (oci-image? image) name image) "."))
+                      (start
+                       #~(lambda ()
+                           #$@(if (oci-image? image)
+                                  #~((invoke #$(%oci-image-loader
+                                                name image image-reference)))
+                                  #~())
+                           (fork+exec-command
+                            ;; docker run [OPTIONS] IMAGE [COMMAND] [ARG...]
+                            (list #$docker "run" "--rm" "--name" #$name
+                                  #$@options #$@extra-arguments
+                                  #$image-reference #$@command)
+                            #:user #$user
+                            #:group #$group
+                            #$@(if (maybe-value-set? log-file)
+                                   (list #:log-file log-file)
+                                   '())
+                            #:environment-variables
+                            (list #$@host-environment))))
+                      (stop
+                       #~(lambda _
+                           (invoke #$docker "rm" "-f" #$name)))
+                      (actions
+                       (if (oci-image? image)
+                           '()
+                           (append
+                            (list
+                             (shepherd-action
+                              (name 'pull)
+                              (documentation
+                               (format #f "Pull ~a's image (~a)."
+                                       name image))
+                              (procedure
+                               #~(lambda _
+                                   (invoke #$docker "pull" #$image)))))
+                            actions))))))
+
+(define %oci-container-accounts
+  (list (user-account
+         (name "oci-container")
+         (comment "OCI services account")
+         (group "docker")
+         (system? #t)
+         (home-directory "/var/empty")
+         (shell (file-append shadow "/sbin/nologin")))))
diff --git a/gnu/services/docker.scm b/gnu/services/docker.scm
index 9ab3e583345..828ceea313a 100644
--- a/gnu/services/docker.scm
+++ b/gnu/services/docker.scm
@@ -5,7 +5,7 @@
 ;;; Copyright © 2020 Efraim Flashner <[email-masked]>
 ;;; Copyright © 2020 Jesse Dowell <[email-masked]>
 ;;; Copyright © 2021 Brice Waegeneire <[email-masked]>
-;;; Copyright © 2023, 2024 Giacomo Leidi <[email-masked]>
+;;; Copyright © 2023, 2024, 2025 Giacomo Leidi <[email-masked]>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -23,72 +23,60 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (gnu services docker)
-  #:use-module (gnu image)
   #:use-module (gnu services)
   #:use-module (gnu services configuration)
-  #:use-module (gnu services base)
-  #:use-module (gnu services dbus)
+  #:use-module (gnu services containers)
   #:use-module (gnu services shepherd)
-  #:use-module (gnu system)
-  #:use-module (gnu system image)
   #:use-module (gnu system privilege)
   #:use-module (gnu system shadow)
-  #:use-module (gnu packages admin)               ;shadow
   #:use-module (gnu packages docker)
   #:use-module (gnu packages linux)               ;singularity
-  #:use-module (guix records)
-  #:use-module (guix diagnostics)
   #:use-module (guix gexp)
-  #:use-module (guix i18n)
-  #:use-module (guix monads)
-  #:use-module (guix packages)
-  #:use-module (guix profiles)
-  #:use-module ((guix scripts pack) #:prefix pack:)
-  #:use-module (guix store)
+  #:use-module (guix records)
   #:use-module (srfi srfi-1)
   #:use-module (ice-9 format)
   #:use-module (ice-9 match)
+  #:re-export (oci-image                          ;for backwards compatibility, until the
+               oci-image?                         ;oci-container-service-type is fully deprecated
+               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
+               oci-container-shepherd-service
+               %oci-container-accounts)
 
   #:export (containerd-configuration
             containerd-service-type
             docker-configuration
             docker-service-type
             singularity-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
-            oci-container-service-type
-            oci-container-shepherd-service
-            %oci-container-accounts))
+            oci-container-service-type))
 
 (define-maybe file-like)
 
@@ -309,495 +297,6 @@ (define singularity-service-type
 ;;; OCI container.
 ;;;
 
-(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-sanitize-environment value)
-  ;; Expected spec format:
-  ;; '(("HOME" . "/home/nobody") "JAVA_HOME=/java")
-  (oci-sanitize-mixed-list "environment" value "="))
-
-(define (oci-sanitize-ports value)
-  ;; Expected spec format:
-  ;; '(("8088" . "80") "2022:22")
-  (oci-sanitize-mixed-list "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-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-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-image-reference image)
-  (if (string? image)
-      image
-      (string-append (oci-image-repository image)
-                     ":" (oci-image-tag image))))
-
-(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-maybe/no-serialization string)
-
-(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
-   (string "oci-container")
-   "The user under whose authority docker commands will be run.")
-  (group
-   (string "docker")
-   "The group under whose authority docker commands will be run.")
-  (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
-   (list '())
-   "Set environment variables in the host environment where @command{docker run}
-is invoked.  This is especially useful to pass secrets from the host to the
-container without having them on the @command{docker run}'s command line: 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
-   (list '())
-   "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 Docker CLI.  You can refer to the
-@url{https://docs.docker.com/engine/reference/commandline/run/#env,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 Docker
-Engine, 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
-   (list '())
-   "This is a list of @code{shepherd-action} records defining actions supported
-by the service."
-   (sanitizer oci-sanitize-shepherd-actions))
-  (network
-   (maybe-string)
-   "Set a Docker network for the spawned container.")
-  (ports
-   (list '())
-   "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 Docker CLI.  You can refer to the
-@url{https://docs.docker.com/engine/reference/commandline/run/#publish,upstream}
-documentation for semantics."
-   (sanitizer oci-sanitize-ports))
-  (volumes
-   (list '())
-   "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 Docker CLI.  You can refer to the
-@url{https://docs.docker.com/engine/reference/commandline/run/#volume,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,upstream}
-documentation for semantics.")
-  (workdir
-   (maybe-string)
-   "Set the current working for the spawned Shepherd service.
-You can refer to the
-@url{https://docs.docker.com/engine/reference/run/#workdir,upstream}
-documentation for semantics.")
-  (extra-arguments
-   (list '())
-   "A list of strings, gexps or file-like objects that will be directly passed
-to the @command{docker run} invocation."
-   (sanitizer oci-sanitize-extra-arguments)))
-
-(define oci-container-configuration->options
-  (lambda (config)
-    (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?)
-                     `(,(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* (get-keyword-value args keyword #:key (default #f))
-  (let ((kv (memq keyword args)))
-    (if (and kv (>= (length kv) 2))
-        (cadr kv)
-        default)))
-
-(define (lower-operating-system os target system)
-  (mlet* %store-monad
-      ((tarball
-        (lower-object
-         (system-image (os->image os #:type docker-image-type))
-         system
-         #:target target)))
-    (return tarball)))
-
-(define (lower-manifest name image target system)
-  (define value (oci-image-value image))
-  (define options (oci-image-pack-options image))
-  (define image-reference
-    (oci-image-reference image))
-  (define image-tag
-    (let* ((extra-options
-            (get-keyword-value options #:extra-options))
-           (image-tag-option
-            (and extra-options
-                 (get-keyword-value extra-options #:image-tag))))
-      (if image-tag-option
-          '()
-          `(#:extra-options (#:image-tag ,image-reference)))))
-
-  (mlet* %store-monad
-      ((_ (set-grafting
-           (oci-image-grafts? image)))
-       (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
-                         ,@image-tag
-                         #:localstatedir? #t))))
-    (return tarball)))
-
-(define (lower-oci-image name image)
-  (define value (oci-image-value image))
-  (define image-target (oci-image-target image))
-  (define image-system (oci-image-system image))
-  (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 image target system))
-       ((? 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 (%oci-image-loader name image tag)
-  (let ((docker (file-append docker-cli "/bin/docker"))
-        (tarball (lower-oci-image name image)))
-    (with-imported-modules '((guix build utils))
-      (program-file (format #f "~a-image-loader" name)
-       #~(begin
-           (use-modules (guix build utils)
-                        (ice-9 popen)
-                        (ice-9 rdelim))
-
-           (format #t "Loading image for ~a from ~a...~%" #$name #$tarball)
-           (define line
-             (read-line
-              (open-input-pipe
-               (string-append #$docker " load -i " #$tarball))))
-
-           (unless (or (eof-object? line)
-                       (string-null? line))
-             (format #t "~a~%" line)
-             (let ((repository&tag
-                    (string-drop line
-                                 (string-length
-                                   "Loaded image: "))))
-
-               (invoke #$docker "tag" repository&tag #$tag)
-               (format #t "Tagged ~a with ~a...~%" #$tarball #$tag))))))))
-
-(define (oci-container-shepherd-service config)
-  (define (guess-name name image)
-    (if (maybe-value-set? name)
-        name
-        (string-append "docker-"
-                       (basename
-                        (if (string? image)
-                            (first (string-split image #\:))
-                            (oci-image-repository image))))))
-
-  (let* ((docker (file-append docker-cli "/bin/docker"))
-         (actions (oci-container-configuration-shepherd-actions config))
-         (auto-start?
-          (oci-container-configuration-auto-start? config))
-         (user (oci-container-configuration-user config))
-         (group (oci-container-configuration-group config))
-         (host-environment
-          (oci-container-configuration-host-environment config))
-         (command (oci-container-configuration-command config))
-         (log-file (oci-container-configuration-log-file config))
-         (provision (oci-container-configuration-provision config))
-         (requirement (oci-container-configuration-requirement config))
-         (respawn?
-          (oci-container-configuration-respawn? config))
-         (image (oci-container-configuration-image config))
-         (image-reference (oci-image-reference image))
-         (options (oci-container-configuration->options config))
-         (name (guess-name provision image))
-         (extra-arguments
-          (oci-container-configuration-extra-arguments config)))
-
-    (shepherd-service (provision `(,(string->symbol name)))
-                      (requirement `(dockerd user-processes ,@requirement))
-                      (respawn? respawn?)
-                      (auto-start? auto-start?)
-                      (documentation
-                       (string-append
-                        "Docker backed Shepherd service for "
-                        (if (oci-image? image) name image) "."))
-                      (start
-                       #~(lambda ()
-                           #$@(if (oci-image? image)
-                                  #~((invoke #$(%oci-image-loader
-                                                name image image-reference)))
-                                  #~())
-                           (fork+exec-command
-                            ;; docker run [OPTIONS] IMAGE [COMMAND] [ARG...]
-                            (list #$docker "run" "--rm" "--name" #$name
-                                  #$@options #$@extra-arguments
-                                  #$image-reference #$@command)
-                            #:user #$user
-                            #:group #$group
-                            #$@(if (maybe-value-set? log-file)
-                                   (list #:log-file log-file)
-                                   '())
-                            #:environment-variables
-                            (list #$@host-environment))))
-                      (stop
-                       #~(lambda _
-                           (invoke #$docker "rm" "-f" #$name)))
-                      (actions
-                       (if (oci-image? image)
-                           '()
-                           (append
-                            (list
-                             (shepherd-action
-                              (name 'pull)
-                              (documentation
-                               (format #f "Pull ~a's image (~a)."
-                                       name image))
-                              (procedure
-                               #~(lambda _
-                                   (invoke #$docker "pull" #$image)))))
-                            actions))))))
-
-(define %oci-container-accounts
-  (list (user-account
-         (name "oci-container")
-         (comment "OCI services account")
-         (group "docker")
-         (system? #t)
-         (home-directory "/var/empty")
-         (shell (file-append shadow "/sbin/nologin")))))
-
 (define (configs->shepherd-services configs)
   (map oci-container-shepherd-service configs))
 
diff --git a/gnu/tests/docker.scm b/gnu/tests/docker.scm
index 90c8d0f8508..5dcf05a17e3 100644
--- a/gnu/tests/docker.scm
+++ b/gnu/tests/docker.scm
@@ -1,7 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2019 Danny Milosavljevic <[email-masked]>
 ;;; Copyright © 2019-2023 Ludovic Courtès <[email-masked]>
-;;; Copyright © 2024 Giacomo Leidi <[email-masked]>
+;;; Copyright © 2024, 2025 Giacomo Leidi <[email-masked]>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -414,71 +414,54 @@ (define (run-oci-container-test)
           (test-runner-current (system-test-runner #$output))
           (test-begin "oci-container")
 
-          (test-assert "containerd service running"
-            (marionette-eval
-             '(begin
-                (use-modules (gnu services herd))
-                (match (start-service 'containerd)
-                  (#f #f)
-                  (('service response-parts ...)
-                   (match (assq-ref response-parts 'running)
-                     ((pid) pid)))))
-             marionette))
-
-          (test-assert "containerd PID file present"
-            (wait-for-file "/run/containerd/containerd.pid" marionette))
-
-          (test-assert "dockerd running"
-            (marionette-eval
-             '(begin
-                (use-modules (gnu services herd))
-                (match (start-service 'dockerd)
-                  (#f #f)
-                  (('service response-parts ...)
-                   (match (assq-ref response-parts 'running)
-                     ((pid) pid)))))
-             marionette))
-
-          (sleep 10) ; let service start
+          (wait-for-file "/run/containerd/containerd.pid" marionette)
 
           (test-assert "docker-guile running"
             (marionette-eval
              '(begin
                 (use-modules (gnu services herd))
-                (match (start-service 'docker-guile)
-                  (#f #f)
-                  (('service response-parts ...)
-                   (match (assq-ref response-parts 'running)
-                     ((pid) pid)))))
+                (wait-for-service 'docker-guile #:timeout 120)
+                #t)
              marionette))
 
-          (test-equal "passing host environment variables and volumes"
-            '("value" "hello")
-            (marionette-eval
-             `(begin
-                (use-modules (ice-9 popen)
-                             (ice-9 rdelim))
-
-                (define slurp
-                  (lambda args
-                    (let* ((port (apply open-pipe* OPEN_READ args))
-                           (output (let ((line (read-line port)))
-                                     (if (eof-object? line)
-                                         ""
-                                         line)))
-                           (status (close-pipe port)))
-                      output)))
-                (let* ((response1 (slurp
-                                   ,(string-append #$docker-cli "/bin/docker")
-                                   "exec" "docker-guile"
-                                   "/bin/guile" "-c" "(display (getenv \"VARIABLE\"))"))
-                       (response2 (slurp
-                                   ,(string-append #$docker-cli "/bin/docker")
-                                   "exec" "docker-guile"
-                                   "/bin/guile" "-c" "(begin (use-modules (ice-9 popen) (ice-9 rdelim))
+          (test-assert "passing host environment variables and volumes"
+            (begin
+              (define (run-test)
+                (marionette-eval
+                 `(begin
+                    (use-modules (ice-9 popen)
+                                 (ice-9 rdelim))
+
+                    (define slurp
+                      (lambda args
+                        (let* ((port (apply open-pipe* OPEN_READ args))
+                               (output (let ((line (read-line port)))
+                                         (if (eof-object? line)
+                                             ""
+                                             line)))
+                               (status (close-pipe port)))
+                          output)))
+                    (let* ((response1 (slurp
+                                       ,(string-append #$docker-cli "/bin/docker")
+                                       "exec" "docker-guile"
+                                       "/bin/guile" "-c" "(display (getenv \"VARIABLE\"))"))
+                           (response2 (slurp
+                                       ,(string-append #$docker-cli "/bin/docker")
+                                       "exec" "docker-guile"
+                                       "/bin/guile" "-c" "(begin (use-modules (ice-9 popen) (ice-9 rdelim))
 (display (call-with-input-file \"/shared.txt\" read-line)))")))
-                  (list response1 response2)))
-             marionette))
+                      (list response1 response2)))
+                 marionette))
+              ;; Allow services to come up on slower machines
+              (let loop ((attempts 0))
+                (if (= attempts 60)
+                    (error "Service didn't come up after more than 60 seconds")
+                    (if (equal? '("value" "hello")
+                                (run-test))
+                        #t
+                        (begin
+                          (sleep 1)
+                          (loop (+ 1 attempts))))))))
 
           (test-end))))
 
-- 
2.48.1