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, 559 insertions, 2 deletions

diff --git a/gnu/tests/containers.scm b/gnu/tests/containers.scm
index 618da2a92ce..1a442cddc64 100644
--- a/gnu/tests/containers.scm
+++ b/gnu/tests/containers.scm
@@ -27,6 +27,9 @@
   #:use-module (gnu services)
   #:use-module (gnu services containers)
   #:use-module (gnu services desktop)
+  #:use-module ((gnu services docker)
+                #:select (containerd-service-type
+                          docker-service-type))
   #:use-module (gnu services dbus)
   #:use-module (gnu services networking)
   #:use-module (gnu system)
@@ -39,7 +42,9 @@
   #:use-module (guix profiles)
   #:use-module ((guix scripts pack) #:prefix pack:)
   #:use-module (guix store)
-  #:export (%test-rootless-podman))
+  #:export (%test-rootless-podman
+            %test-oci-service-rootless-podman
+            %test-oci-service-docker))
 
 
 (define %rootless-podman-os
@@ -133,7 +138,7 @@
                                (status (close-pipe port)))
                           output)))
                     (let* ((bash
-                            ,(string-append #$bash "/bin/bash"))
+                            (string-append #$bash "/bin/bash"))
                            (response1
                             (slurp bash "-c"
                                    (string-append "ls -la /sys/fs/cgroup | "
@@ -345,3 +350,555 @@ standard output device and then enters a new line.")
    (name "rootless-podman")
    (description "Test rootless Podman service.")
    (value (build-tarball&run-rootless-podman-test))))
+
+
+(define %oci-network
+  (oci-network-configuration (name "my-network")))
+
+(define %oci-volume
+  (oci-volume-configuration (name "my-volume")))
+
+(define %oci-wait-for-file
+  #~(define (wait-for-file file)
+      ;; Wait until FILE shows up.
+      (let loop ((i 6))
+        (cond ((file-exists? file)
+               #t)
+              ((zero? i)
+               (error "file didn't show up" file))
+              (else
+               (pk 'wait-for-file file)
+               (sleep 1)
+               (loop (- i 1)))))))
+
+(define %oci-read-lines
+  #~(define (read-lines file-or-port)
+      (define (loop-lines port)
+        (let loop ((lines '()))
+          (match (read-line port)
+            ((? eof-object?)
+             (reverse lines))
+            (line
+             (loop (cons line lines))))))
+
+      (if (port? file-or-port)
+          (loop-lines file-or-port)
+          (call-with-input-file file-or-port
+            loop-lines))))
+
+(define %oci-slurp
+  #~(define slurp
+      (lambda args
+        (let* ((port
+                (apply open-pipe* OPEN_READ
+                       (list "sh" "-l" "-c"
+                             (string-join args " "))))
+               (output (read-lines port))
+               (status (close-pipe port)))
+          output))))
+
+(define (%oci-rootless-podman-run commands)
+  #~((use-modules (srfi srfi-1)
+                  (ice-9 format)
+                  (ice-9 popen)
+                  (ice-9 match)
+                  (ice-9 rdelim)
+                  (gnu build oci-containers))
+
+     #$%oci-wait-for-file
+     #$%oci-read-lines
+     #$%oci-slurp
+
+     (define responses
+       (map
+        (lambda (index)
+          (format #f "/tmp/response_~a" index))
+        (iota (length '#$commands))))
+
+     (match (primitive-fork)
+       (0
+        (begin
+          (setgid (passwd:gid (getpwnam "oci-container")))
+          (setuid (passwd:uid (getpw "oci-container")))
+
+          (let* ((outputs
+                  (list #$@commands))
+                 (outputs-responses
+                  (zip outputs responses)))
+            (for-each
+             (match-lambda
+               ((output response)
+                (call-with-output-file response
+                  (lambda (port)
+                    (display (string-join output "\n") port)))))
+             outputs-responses))))
+       (pid
+        (cdr (waitpid pid))))
+
+     (for-each wait-for-file responses)
+     (map
+      (lambda (response)
+        (sort (slurp "cat" response) string<=?))
+      responses)))
+
+(define %oci-rootless-podman-os
+  (simple-operating-system
+   (service dhcpcd-service-type)
+   (service dbus-root-service-type)
+   (service polkit-service-type)
+   (service elogind-service-type)
+   (service iptables-service-type)
+   (service rootless-podman-service-type)
+   (extra-special-file "/shared.txt"
+                       (plain-file "shared.txt" "hello"))
+   (service oci-service-type
+            (oci-configuration
+             (runtime 'podman)
+             (verbose? #t)))
+   (simple-service 'oci-provisioning
+                   oci-service-type
+                   (oci-extension
+                    (networks
+                     (list %oci-network))
+                    (volumes
+                     (list %oci-volume))
+                    (containers
+                     (list
+                      (oci-container-configuration
+                       (provision "first")
+                       (image
+                        (oci-image
+                         (repository "guile")
+                         (value
+                          (specifications->manifest '("guile")))
+                         (pack-options
+                          '(#:symlinks (("/bin" -> "bin"))))))
+                       (entrypoint "/bin/guile")
+                       (network "my-network")
+                       (command
+                        '("-c" "(use-modules (web server))
+(define (handler request request-body)
+  (values '((content-type . (text/plain))) \"out of office\"))
+(run-server handler 'http `(#:addr ,(inet-pton AF_INET \"0.0.0.0\")))"))
+                       (host-environment
+                        '(("VARIABLE" . "value")))
+                       (volumes
+                        '(("my-volume" . "/my-volume")))
+                       (extra-arguments
+                        '("--env" "VARIABLE")))
+                      (oci-container-configuration
+                       (provision "second")
+                       (image
+                        (oci-image
+                         (repository "guile")
+                         (value
+                          (specifications->manifest '("guile")))
+                         (pack-options
+                          '(#:symlinks (("/bin" -> "bin"))))))
+                       (entrypoint "/bin/guile")
+                       (network "my-network")
+                       (command
+                        '("-c" "(let l ((c 300))
+(display c)
+(newline)
+(sleep 1)
+(when (positive? c)
+  (l (- c 1))))"))
+                       (volumes
+                        '(("my-volume" . "/my-volume")
+                          ("/shared.txt" . "/shared.txt:ro"))))))))))
+
+(define (run-rootless-podman-oci-service-test)
+  (define os
+    (marionette-operating-system
+     (operating-system-with-gc-roots
+      %oci-rootless-podman-os
+      (list))
+     #:imported-modules '((gnu build oci-containers)
+                          (gnu build dbus-service)
+                          (gnu services herd)
+                          (guix combinators))))
+
+  (define vm
+    (virtual-machine
+     (operating-system os)
+     (volatile? #f)
+     (memory-size 1024)
+     (disk-image-size (* 5000 (expt 2 20)))
+     (port-forwardings '())))
+
+  (define test
+    (with-imported-modules '((gnu build oci-containers)
+                             (gnu build dbus-service)
+                             (gnu build marionette))
+      #~(begin
+          (use-modules (srfi srfi-1) (srfi srfi-11) (srfi srfi-64)
+                       (gnu build dbus-service)
+                       (gnu build marionette))
+
+          (define marionette
+            ;; Relax timeout to accommodate older systems and
+            ;; allow for pulling the image.
+            (make-marionette (list #$vm) #:timeout 60))
+
+          (test-runner-current (system-test-runner #$output))
+          (test-begin "rootless-podman-oci-service")
+
+          (marionette-eval
+           '(begin
+              (use-modules (gnu services herd))
+              (wait-for-service 'user-processes))
+           marionette)
+
+          (test-assert "podman-volumes running"
+            (begin
+              (define (run-test)
+                (first
+                 (marionette-eval
+                  `(begin
+                     #$@(%oci-rootless-podman-run
+                         #~((oci-object-service-available?
+                             "/run/current-system/profile/bin/podman"
+                             "volume"
+                             '("my-volume")
+                             #:verbose? #t))))
+                  marionette)))
+              ;; Allow services to come up on slower machines.
+              (with-retries 80 1 (equal? '("my-volume") (run-test)))))
+
+          (test-assert "podman-networks running"
+            (begin
+              (define (run-test)
+                (first
+                 (marionette-eval
+                  `(begin
+                     #$@(%oci-rootless-podman-run
+                         #~((oci-object-service-available?
+                             "/run/current-system/profile/bin/podman"
+                             "network"
+                             '("my-network")
+                             #:verbose? #t))))
+                  marionette)))
+              ;; Allow services to come up on slower machines.
+              (with-retries 80 1 (equal? '("my-network" "podman") (run-test)))))
+
+          (test-assert "image loaded"
+            (begin
+              (define (run-test)
+                (first
+                 (marionette-eval
+                  `(begin
+                     #$@(%oci-rootless-podman-run
+                         #~((oci-object-service-available?
+                             "/run/current-system/profile/bin/podman"
+                             "image"
+                             '("localhost/guile:latest")
+                             #:format-string "{{.Repository}}:{{.Tag}}"
+                             #:verbose? #t))))
+                  marionette)))
+              ;; Allow services to come up on slower machines.
+              (with-retries 80 1
+                            (equal?
+                             '("localhost/guile:latest")
+                             (run-test)))))
+
+          (test-assert "passing host environment variables"
+            (begin
+              (define (run-test)
+                (first
+                 (marionette-eval
+                  `(begin
+                     #$@(%oci-rootless-podman-run
+                         #~((slurp
+                             "/run/current-system/profile/bin/podman"
+                             "exec" "first"
+                             "/bin/guile" "-c"
+                             "'(display (getenv \"VARIABLE\"))'"))))
+                  marionette)))
+              ;; Allow services to come up on slower machines.
+              (with-retries 80 1 (equal? '("value") (run-test)))))
+
+          (test-equal "mounting host files"
+            '("hello")
+            (first
+             (marionette-eval
+              `(begin
+                 #$@(%oci-rootless-podman-run
+                     #~((slurp
+                         "/run/current-system/profile/bin/podman"
+                         "exec" "second"
+                         "/bin/guile" "-c" "'(begin
+(use-modules (ice-9 popen) (ice-9 rdelim))
+(display (call-with-input-file \"/shared.txt\" read-line)))'"))))
+              marionette)))
+
+          (test-equal "read and write to provisioned volumes"
+            '("world")
+            (second
+             (marionette-eval
+              `(begin
+                 #$@(%oci-rootless-podman-run
+                     #~((slurp
+                         "/run/current-system/profile/bin/podman"
+                         "exec" "first"
+                         "/bin/guile" "-c" "'(begin
+(use-modules (ice-9 popen) (ice-9 rdelim))
+(call-with-output-file \"/my-volume/out.txt\"
+  (lambda (p) (display \"world\" p))))'")
+                        (slurp
+                         "/run/current-system/profile/bin/podman"
+                         "exec" "second"
+                         "/bin/guile" "-c" "'(begin
+(use-modules (ice-9 popen) (ice-9 rdelim))
+(display
+ (call-with-input-file \"/my-volume/out.txt\" read-line)))'"))))
+              marionette)))
+
+          (test-equal
+              "can read and write to ports over provisioned network"
+            '("out of office")
+            (first
+             (marionette-eval
+              `(begin
+                 #$@(%oci-rootless-podman-run
+                     #~((slurp
+                         "/run/current-system/profile/bin/podman"
+                         "exec" "second"
+                         "/bin/guile" "-c" "'(begin
+(use-modules (web client))
+(define-values (response out) (http-get \"http://first:8080\"))
+(display out))'"))))
+              marionette)))
+
+          (test-end))))
+
+  (gexp->derivation "rootless-podman-oci-service-test" test))
+
+(define %test-oci-service-rootless-podman
+  (system-test
+   (name "oci-service-rootless-podman")
+   (description "Test Rootless-Podman backed OCI provisioning service.")
+   (value (run-rootless-podman-oci-service-test))))
+
+(define (%oci-docker-run commands)
+  #~((use-modules (srfi srfi-1)
+                  (ice-9 format)
+                  (ice-9 popen)
+                  (ice-9 match)
+                  (ice-9 rdelim)
+                  (gnu build oci-containers))
+
+     #$%oci-read-lines
+     #$%oci-slurp
+
+     (let ((outputs (list #$@commands)))
+       (map
+        (lambda (output)
+          (sort output string<=?))
+        outputs))))
+
+(define %oci-docker-os
+  (simple-operating-system
+   (service dhcpcd-service-type)
+   (service dbus-root-service-type)
+   (service polkit-service-type)
+   (service elogind-service-type)
+   (service containerd-service-type)
+   (service docker-service-type)
+   (extra-special-file "/shared.txt"
+                       (plain-file "shared.txt" "hello"))
+   (service oci-service-type
+            (oci-configuration
+             (verbose? #t)))
+   (simple-service 'oci-provisioning
+                   oci-service-type
+                   (oci-extension
+                    (networks
+                     (list %oci-network))
+                    (volumes
+                     (list %oci-volume))
+                    (containers
+                     (list
+                      (oci-container-configuration
+                       (provision "first")
+                       (image
+                        (oci-image
+                         (repository "guile")
+                         (value
+                          (specifications->manifest '("guile")))
+                         (pack-options
+                          '(#:symlinks (("/bin" -> "bin"))))))
+                       (entrypoint "/bin/guile")
+                       (network "my-network")
+                       (command
+                        '("-c" "(use-modules (web server))
+(define (handler request request-body)
+  (values '((content-type . (text/plain))) \"out of office\"))
+(run-server handler 'http `(#:addr ,(inet-pton AF_INET \"0.0.0.0\")))"))
+                       (host-environment
+                        '(("VARIABLE" . "value")))
+                       (volumes
+                        '(("my-volume" . "/my-volume")))
+                       (extra-arguments
+                        '("--env" "VARIABLE")))
+                      (oci-container-configuration
+                       (provision "second")
+                       (image
+                        (oci-image
+                         (repository "guile")
+                         (value
+                          (specifications->manifest '("guile")))
+                         (pack-options
+                          '(#:symlinks (("/bin" -> "bin"))))))
+                       (entrypoint "/bin/guile")
+                       (network "my-network")
+                       (command
+                        '("-c" "(let l ((c 300))
+(display c)
+(newline)
+(sleep 1)
+(when (positive? c)
+  (l (- c 1))))"))
+                       (volumes
+                        '(("my-volume" . "/my-volume")
+                          ("/shared.txt" . "/shared.txt:ro"))))))))))
+
+(define (run-docker-oci-service-test)
+  (define os
+    (marionette-operating-system
+     (operating-system-with-gc-roots
+      %oci-docker-os
+      (list))
+     #:imported-modules '((gnu build oci-containers)
+                          (gnu build dbus-service)
+                          (gnu services herd)
+                          (guix combinators))))
+
+  (define vm
+    (virtual-machine
+     (operating-system os)
+     (volatile? #f)
+     (memory-size 1024)
+     (disk-image-size (* 5000 (expt 2 20)))
+     (port-forwardings '())))
+
+  (define test
+    (with-imported-modules '((gnu build oci-containers)
+                             (gnu build dbus-service)
+                             (gnu build marionette))
+      #~(begin
+          (use-modules (srfi srfi-1) (srfi srfi-11) (srfi srfi-64)
+                       (gnu build dbus-service)
+                       (gnu build marionette))
+
+          (define marionette
+            ;; Relax timeout to accommodate older systems and
+            ;; allow for pulling the image.
+            (make-marionette (list #$vm) #:timeout 60))
+
+          (test-runner-current (system-test-runner #$output))
+          (test-begin "docker-oci-service")
+
+          (marionette-eval
+           '(begin
+              (use-modules (gnu services herd))
+              (wait-for-service 'dockerd))
+           marionette)
+
+          (test-assert "docker-volumes running"
+            (begin
+              (define (run-test)
+                (first
+                 (marionette-eval
+                  `(begin
+                     #$@(%oci-docker-run
+                         #~((oci-object-service-available?
+                             "/run/current-system/profile/bin/docker"
+                             "volume"
+                             '("my-volume")
+                             #:verbose? #t))))
+                  marionette)))
+              ;; Allow services to come up on slower machines.
+              (with-retries 80 1 (equal? '("my-volume") (run-test)))))
+
+          (test-assert "docker-networks running"
+            (begin
+              (define (run-test)
+                (first
+                 (marionette-eval
+                  `(begin
+                     #$@(%oci-docker-run
+                         #~((oci-object-service-available?
+                             "/run/current-system/profile/bin/docker"
+                             "network"
+                             '("my-network")
+                             #:verbose? #t))))
+                  marionette)))
+              ;; Allow services to come up on slower machines.
+              (with-retries 80 1 (equal?
+                                  '("my-network" "none")
+                                  (run-test)))))
+
+          (test-assert "passing host environment variables"
+            (begin
+              (define (run-test)
+                (first
+                 (marionette-eval
+                  `(begin
+                     #$@(%oci-docker-run
+                         #~((slurp
+                             "/run/current-system/profile/bin/docker"
+                             "exec" "first"
+                             "/bin/guile" "-c"
+                             "'(display (getenv \"VARIABLE\"))'"))))
+                  marionette)))
+              ;; Allow services to come up on slower machines.
+              (with-retries 80 1 (equal? '("value") (run-test)))))
+
+          (test-equal "read and write to provisioned volumes"
+            '("world")
+            (second
+             (marionette-eval
+              `(begin
+                 #$@(%oci-docker-run
+                     #~((slurp
+                         "/run/current-system/profile/bin/docker"
+                         "exec" "first"
+                         "/bin/guile" "-c" "'(begin
+(use-modules (ice-9 popen) (ice-9 rdelim))
+(call-with-output-file \"/my-volume/out.txt\"
+  (lambda (p) (display \"world\" p))))'")
+                        (slurp
+                         "/run/current-system/profile/bin/docker"
+                         "exec" "second"
+                         "/bin/guile" "-c" "'(begin
+(use-modules (ice-9 popen) (ice-9 rdelim))
+(display
+ (call-with-input-file \"/my-volume/out.txt\" read-line)))'"))))
+              marionette)))
+
+          (test-equal
+              "can read and write to ports over provisioned network"
+            '("out of office")
+            (first
+             (marionette-eval
+              `(begin
+                 #$@(%oci-docker-run
+                     #~((slurp
+                         "/run/current-system/profile/bin/docker"
+                         "exec" "second"
+                         "/bin/guile" "-c" "'(begin (use-modules (web client))
+          (define-values (response out)
+            (http-get \"http://first:8080\"))
+          (display out))'"))))
+              marionette)))
+
+          (test-end))))
+
+  (gexp->derivation "docker-oci-service-test" test))
+
+(define %test-oci-service-docker
+  (system-test
+   (name "oci-service-docker")
+   (description "Test Docker backed OCI provisioning service.")
+   (value (run-docker-oci-service-test))))