services: Add oci-service-type.

This patch implements a generalization of the
oci-container-service-type, which consequently is made deprecated.  The
oci-service-type, in addition to all the features from the
oci-container-service-type, can now provision OCI networks and volumes.
It only handles OCI objects creation, the user is supposed to handle
state once the objects are provsioned.

It currently supports two different OCI runtimes: Docker and rootless
Podman.  Both runtimes are tested to make sure provisioned containers
can connect to each other through provisioned networks and can
read/write data with provisioned volumes.

At last the Scheme API is thought to facilitate the implementation of a
Guix Home service in the future.

* gnu/build/oci-containers.scm: New file containg OCI runtime business
logic used in OCI backed Shepherd services.
oci-read-lines
(oci-system*,oci-object-exists?,oci-object-service-available?
oci-image-load,oci-log-verbose,oci-container-execlp,oci-object-create):
New procedures.
* gnu/local.mk: Add it.
* gnu/services/containers.scm (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-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-accounts,oci-service-profile,oci-service-subids,
oci-configuration->shepherd-services,oci-configuration-extend): New
procedures.
(image-reference): Implement unambiguous naming convention, that paired
with the new implementation for listing caches images with docker ls or
podman ls, allows for more efficient image caching.
(oci-container-configuration)[user,group]: Change default-type to
maybe-string, since by default containers will run under the user and
group declared in oci-configuration records. When unset the
oci-service-type will derive their value from the OCI runtime state.
[runtime,host-environment,environment,shepherd-actions,ports,extra-arguments]:
define a predicate and use it as a type in the configuration.  This
way errors are reported with source location information.
(lower-manifest): Defer to caller the logic of setting up an image tag.
(lower-oci-image): Rename to load-oci-image-state.
(oci-runtime-state): Intermediate representation of the OCI runtime
details. It is supposed to be an internal API.
(oci-state): Intermediate representation of the OCI provisioning state,
such as containers and networks. It is supposed to be an internal API.
(oci-container-invocation): Intermediate representation of the OCI
runtime run command to start a container. It is supposed to be an
internal API.
(%oci-image-loader): Rename to oci-image-loader and use
oci-runtime-state and (gnu build oci-containers).
(oci-container-shepherd-service): Use oci-state and oci-runtime-state,
add command-line action.
(oci-network-configuration,oci-volume-configuration,oci-configuration,
oci-extension): New record types.
(oci-service-type): New service-type.
* doc/guix.texi: Document it.
* gnu/tests/containers.scm: Test it.
* gnu/services/docker.scm: Deprecate the oci-container-service-type.

Change-Id: I656b3db85832e42d53072fcbfb91d1226f39ef38
Modified-by: Maxim Cournoyer <maxim@guixotic.coop>
Signed-off-by: Maxim Cournoyer <maxim@guixotic.coop>

1 files changed, 210 insertions, 0 deletions

diff --git a/gnu/build/oci-containers.scm b/gnu/build/oci-containers.scm
new file mode 100644
index 00000000000..38704e9e4a4
--- /dev/null
+++ b/gnu/build/oci-containers.scm
@@ -0,0 +1,210 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 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/>.
+
+;;; Commentary:
+;;;
+;;; This module contains helpers used as part of the oci-service-type
+;;; definition.
+;;;
+;;; Code:
+
+(define-module (gnu build oci-containers)
+  #:use-module (ice-9 format)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 popen)
+  #:use-module (ice-9 rdelim)
+  #:use-module (ice-9 textual-ports)
+  #:use-module (srfi srfi-1)
+  #:export (oci-read-lines
+            oci-system*
+            oci-object-exists?
+            oci-object-service-available?
+            oci-image-load
+            oci-log-verbose
+            oci-container-execlp
+            oci-object-create))
+
+(define* (oci-read-lines invocation #:key verbose?)
+  (define (get-lines port)
+    (let ((lines-string (get-string-all port)))
+      (string-split lines-string #\newline)))
+
+  (define command
+   (string-join invocation " "))
+
+  (when verbose? (format #t "Running ~a~%" command))
+
+  (with-input-from-port (open-input-pipe command)
+    (lambda _
+      (get-lines (current-input-port)))))
+
+(define* (oci-log-verbose invocation)
+  (format #t "Running in verbose mode...
+Current user: ~a ~a
+Current group: ~a ~a
+Current directory: ~a~%"
+          (getuid) (passwd:name (getpwuid (getuid)))
+          (getgid) (group:name (getgrgid (getgid)))
+          (getcwd))
+
+  (format #t "Running~{ ~a~}~%" invocation))
+
+(define* (oci-system* invocation #:key verbose?)
+  (when verbose?
+    (format #t "Running~{ ~a~}~%" invocation))
+
+  (let* ((status (apply system* invocation))
+         (exit-code (status:exit-val status)))
+    (when verbose?
+      (format #t "Exit code: ~a~%" exit-code))
+    status))
+
+(define* (oci-object-member name objects
+                            #:key verbose?)
+
+  (define member? (member name objects))
+
+  (when (and verbose? (> (length objects) 0))
+    (format #t "~a is ~apart of:~{ ~a~}~%"
+            name
+            (if member? "" "not ")
+            objects))
+  member?)
+
+(define* (oci-object-list runtime-cli object
+                          #:key verbose?
+                          (format-string "{{.Name}}"))
+
+  (define invocation
+    (list runtime-cli object "ls" "--format"
+          (string-append "\"" format-string "\"")))
+
+  (filter
+   (lambda (name)
+     (not (string=? (string-trim name) "")))
+   (oci-read-lines invocation #:verbose? verbose?)))
+
+(define* (docker-object-exist? runtime-cli object name
+                               #:key verbose?
+                               (format-string "{{.Name}}"))
+
+  (define objects
+    (oci-object-list runtime-cli object
+                     #:verbose? verbose?
+                     #:format-string format-string))
+
+  (oci-object-member name objects #:verbose? verbose?))
+
+(define* (podman-object-exist? runtime-cli object name #:key verbose?)
+  (let ((invocation (list runtime-cli object "exists" name)))
+    (define exit-code
+      (status:exit-val (oci-system* invocation #:verbose? verbose?)))
+    (equal? EXIT_SUCCESS exit-code)))
+
+(define* (oci-object-exists? runtime runtime-cli object name
+                             #:key verbose?
+                             (format-string "{{.Name}}"))
+  (if (eq? runtime 'podman)
+      (podman-object-exist? runtime-cli object name
+                            #:verbose? verbose?)
+      (docker-object-exist? runtime-cli object name
+                            #:verbose? verbose?
+                            #:format-string format-string)))
+
+(define* (oci-object-service-available? runtime-cli object names
+                                        #:key verbose?
+                                        (format-string "{{.Name}}"))
+  "Whether NAMES are provisioned in the current OBJECT environment."
+  (define environment
+    (oci-object-list runtime-cli object
+                     #:verbose? verbose?
+                     #:format-string format-string))
+  (when verbose?
+    (format #t "~a environment:~{ ~a~}~%" object environment))
+
+  (define available?
+    (every
+     (lambda (name)
+       (oci-object-member name environment #:verbose? verbose?))
+     names))
+
+  (when verbose?
+   (format #t "~a service is~a available~%" object (if available? "" " not")))
+
+  available?)
+
+(define* (oci-image-load runtime runtime-cli tarball name tag
+                         #:key verbose?
+                         (format-string "{{.Repository}}:{{.Tag}}"))
+  (define load-invocation
+    (list runtime-cli "load" "-i" tarball))
+
+  (if (oci-object-exists? runtime runtime-cli "image" tag
+                          #:verbose? verbose?
+                          #:format-string format-string)
+      (format #t "~a image already exists, skipping.~%" tag)
+      (begin
+        (format #t "Loading image for ~a from ~a...~%" name tarball)
+
+        (let ((line (first
+                     (oci-read-lines load-invocation #:verbose? verbose?))))
+          (unless (or (eof-object? line)
+                      (string-null? line))
+
+            (format #t "~a~%" line)
+
+            (let* ((repository&tag
+                    (string-drop line
+                                 (string-length
+                                  "Loaded image: ")))
+                   (tag-invocation
+                    (list runtime-cli "tag" repository&tag tag))
+                   (drop-old-tag-invocation
+                    (list runtime-cli "image" "rm" "-f" repository&tag)))
+
+              (unless (string=? repository&tag tag)
+                (let ((exit-code
+                       (status:exit-val
+                        (oci-system* tag-invocation #:verbose? verbose?))))
+                  (format #t "Tagged ~a with ~a...~%" tarball tag)
+
+                  (when (equal? EXIT_SUCCESS exit-code)
+                    (oci-system* drop-old-tag-invocation #:verbose? verbose?))))))))))
+
+(define* (oci-container-execlp invocation #:key verbose? pre-script)
+  (when pre-script
+    (pre-script))
+  (when verbose?
+    (oci-log-verbose invocation))
+  (apply execlp (first invocation) invocation))
+
+(define* (oci-object-create runtime runtime-cli runtime-name
+                            object
+                            invocations
+                            #:key verbose?
+                            (format-string "{{.Name}}"))
+  (for-each
+   (lambda (invocation)
+     (define name (last invocation))
+     (if (oci-object-exists? runtime runtime-cli object name
+                             #:format-string format-string
+                             #:verbose? verbose?)
+         (format #t "~a ~a ~a already exists, skipping creation.~%"
+                 runtime-name name object)
+         (oci-system* invocation #:verbose? verbose?)))
+   invocations))