[bug#66160] [PATCH] gnu: Add oci-container-service-type.

[Giacomo Leidi]

* gnu/services/docker.scm (oci-container-configuration): New variable;
(oci-container-shepherd-service): new variable;
(oci-container-service-type): new variable.
* doc/guix.texi: Document it.
---
 doc/guix.texi           |  78 +++++++++++++++++++
 gnu/services/docker.scm | 163 +++++++++++++++++++++++++++++++++++++++-
 2 files changed, 240 insertions(+), 1 deletion(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 617b8463e3..988ab64773 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -39349,6 +39349,84 @@ Miscellaneous Services
 @command{singularity run} and similar commands.
 @end defvar
 
+@cindex OCI-backed, Shepherd services
+@subsubheading OCI backed services
+
+Should you wish to manage your Docker containers with the same consistent
+interface you use for your other Shepherd services,
+@var{oci-container-service-type} is the tool to use.
+
+@defvar oci-container-service-type
+
+This is a thin wrapper around Docker's CLI that wraps OCI images backed
+processes as Shepherd Services.
+
+@lisp
+(simple-service 'oci-grafana-service
+                (list
+                 (oci-container-configuration
+                  (image "prom/prometheus")
+                  (network "host")
+                  (ports
+                    '(("9000" . "9000")
+                      ("9090" . "9090"))))))
+                 (oci-container-configuration
+                  (image "grafana/grafana:10.0.1")
+                  (network "host")
+                  (volumes
+                    '("/var/lib/grafana:/var/lib/grafana"))))))
+@end lisp
+
+@end defvar
+
+@deftp {Data Type} oci-container-configuration
+Available @code{oci-container-configuration} fields are:
+
+@table @asis
+@item @code{command} (default: @code{()}) (type: list-of-strings)
+Overwrite the default CMD of the image.
+
+@item @code{entrypoint} (default: @code{""}) (type: string)
+Overwrite the default ENTRYPOINT of the image.
+
+@item @code{environment} (default: @code{()}) (type: list)
+Set environment variables. This can be a list of pairs or strings, even mixed:
+
+@lisp
+(list '("LANGUAGE" . "eo:ca:eu")
+      "JAVA_HOME=/opt/java")
+@end lisp
+
+@item @code{image} (type: string)
+The image used to build the container.
+
+@item @code{name} (default: @code{""}) (type: string)
+Set a name for the spawned container.
+
+@item @code{network} (default: @code{""}) (type: string)
+Set a Docker network for the spawned container.
+
+@item @code{ports} (default: @code{()}) (type: 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
+
+@item @code{volumes} (default: @code{()}) (type: 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
+
+@end table
+@end deftp
+
 @cindex Audit
 @subsubheading Auditd Service
 
diff --git a/gnu/services/docker.scm b/gnu/services/docker.scm
index c2023d618c..8a4fa2107e 100644
--- a/gnu/services/docker.scm
+++ b/gnu/services/docker.scm
@@ -5,6 +5,7 @@
 ;;; Copyright © 2020 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2020 Jesse Dowell <jessedowell@gmail.com>
 ;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
+;;; Copyright © 2023 Giacomo Leidi <goodoldpaul@autistici.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -34,10 +35,25 @@ (define-module (gnu services docker)
   #:use-module (guix records)
   #:use-module (guix gexp)
   #:use-module (guix packages)
+  #:use-module (srfi srfi-1)
+  #:use-module (ice-9 format)
 
   #:export (docker-configuration
             docker-service-type
-            singularity-service-type))
+            singularity-service-type
+            oci-container-configuration
+            oci-container-configuration?
+            oci-container-configuration-fields
+            oci-container-configuration-command
+            oci-container-configuration-entrypoint
+            oci-container-configuration-environment
+            oci-container-configuration-image
+            oci-container-configuration-name
+            oci-container-configuration-network
+            oci-container-configuration-ports
+            oci-container-configuration-volumes
+            oci-container-service-type
+            oci-container-shepherd-service))
 
 (define-configuration docker-configuration
   (docker
@@ -216,3 +232,148 @@ (define singularity-service-type
                        (service-extension activation-service-type
                                           (const %singularity-activation))))
                 (default-value singularity)))
+
+
+;;;
+;;; OCI container.
+;;;
+
+(define (oci-sanitize-pair pair delimiter)
+  (cond ((file-like? (car pair))
+         (file-append (car pair) delimiter (cdr pair)))
+        ((gexp? (car pair))
+         (file-append (car pair) delimiter (cdr pair)))
+        ((string? (car pair))
+         (string-append (car pair) delimiter (cdr pair)))
+        (else
+         (error
+          (format #f "pair members must only contain gexps, file-like objects 
and strings but ~a was found" (car pair))))))
+
+(define (oci-sanitize-mixed-list name value delimiter)
+  (map
+   (lambda (el)
+     (cond ((string? el) el)
+           ((pair? el) (oci-sanitize-pair el delimiter))
+           (else
+            (error
+             (format #f "~a members must be either a string or a pair but ~a 
was found!" name el)))))
+   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-configuration/no-serialization oci-container-configuration
+  (command
+   (list-of-strings '())
+   "Overwrite the default CMD of the image.")
+  (entrypoint
+   (string "")
+   "Overwrite the default ENTRYPOINT of the image.")
+  (environment
+   (list '())
+   "Set environment variables."
+   (sanitizer oci-sanitize-environment))
+  (image
+   (string)
+   "The image used to build the container.")
+  (name
+   (string "")
+   "Set a name for the spawned container.")
+  (network
+   (string "")
+   "Set a Docker network for the spawned container.")
+  (ports
+   (list '())
+   "Set the port or port ranges to expose from the spawned container."
+   (sanitizer oci-sanitize-ports))
+  (volumes
+   (list '())
+   "Set volume mappings for the spawned container."
+   (sanitizer oci-sanitize-volumes)))
+
+(define oci-container-configuration->options
+  (lambda (config)
+    (let ((entrypoint
+           (oci-container-configuration-entrypoint config))
+          (network
+           (oci-container-configuration-network config)))
+      (apply append
+             (filter (compose not unspecified?)
+                     `(,(when (not (string-null? entrypoint))
+                          (list "--entrypoint" entrypoint))
+                       ,(append-map
+                         (lambda (spec)
+                           (list "--env" spec))
+                         (oci-container-configuration-environment config))
+                       ,(when (not (string-null? network))
+                          (list "--network" network))
+                       ,(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-container-shepherd-service config)
+  (define (guess-name name image)
+    (if (not (string-null? name))
+        name
+        (string-append "docker-"
+                       (basename (car (string-split image #\:))))))
+
+  (let* ((docker-command (file-append docker-cli "/bin/docker"))
+         (config-name (oci-container-configuration-name config))
+         (image (oci-container-configuration-image config))
+         (name (guess-name config-name image)))
+
+    (shepherd-service (provision `(,(string->symbol name)))
+                      (requirement '(dockerd))
+                      (respawn? #f)
+                      (documentation
+                       (string-append
+                        "Docker backed Shepherd service for image: " image))
+                      (start
+                       #~(make-forkexec-constructor
+                          ;; docker run [OPTIONS] IMAGE [COMMAND] [ARG...]
+                          (list #$docker-command
+                                "run"
+                                "--rm"
+                                "--name" #$name
+                                #$@(oci-container-configuration->options 
config)
+                                #$(oci-container-configuration-image config)
+                                #$@(oci-container-configuration-command 
config))
+                          #:user "root"
+                          #:group "root"))
+                      (stop
+                       #~(lambda _
+                           (invoke #$docker-command "stop" #$name))))))
+
+(define (configs->shepherd-services configs)
+  (map oci-container-shepherd-service configs))
+
+(define oci-container-service-type
+  (service-type (name 'oci-container)
+                (extensions (list (service-extension profile-service-type
+                                                     (lambda _ (list 
docker-cli)))
+                                  (service-extension shepherd-root-service-type
+                                                     
configs->shepherd-services)))
+                (default-value '())
+                (extend append)
+                (compose concatenate)
+                (description
+                 "This service provides allows the management of Docker
+containers as Shepherd services.")))

base-commit: f45c0c82289d409b4fac00464ea8b323839ba53f
-- 
2.41.0