From unknown Fri Jun 13 11:55:10 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#76081] OCI provisioning service Resent-From: paul Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Wed, 05 Feb 2025 22:01:03 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: report 76081 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 76081@debbugs.gnu.org X-Debbugs-Original-To: guix-patches@gnu.org Received: via spool by submit@debbugs.gnu.org id=B.17387928185825 (code B ref -1); Wed, 05 Feb 2025 22:01:03 +0000 Received: (at submit) by debbugs.gnu.org; 5 Feb 2025 22:00:18 +0000 Received: from localhost ([127.0.0.1]:53009 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tfnRR-0001Tn-Jx for submit@debbugs.gnu.org; Wed, 05 Feb 2025 17:00:18 -0500 Received: from lists.gnu.org ([2001:470:142::17]:38626) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1tfnRP-000125-L0 for submit@debbugs.gnu.org; Wed, 05 Feb 2025 17:00:16 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1tfnRK-0001OT-08 for guix-patches@gnu.org; Wed, 05 Feb 2025 17:00:10 -0500 Received: from confino.investici.org ([93.190.126.19]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1tfnRG-0006SU-SG for guix-patches@gnu.org; Wed, 05 Feb 2025 17:00:09 -0500 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org; s=stigmate; t=1738792799; bh=UdxGZwt9f9DsHSe0cmS/2qQmmmaepGOJrFyU385OYAo=; h=Date:To:From:Subject:From; b=B/7u169gGjlOq8z/hPEUOrhxukKpO5RjOe12gFHr1b2H7HTJX1dRYdo6t+Q+928tZ YdPuwV3doGK8qjzq14XEe2IpAUAwoX+Qdb4wf8Es4kjWemefOo47UZUfkIaKDbDQLa xBapHEpDypWDzEmXkOOqMlwCRiFYqSdTphXurYrc= Received: from mx1.investici.org (unknown [127.0.0.1]) by confino.investici.org (Postfix) with ESMTP id 4YpDg3045Pz114y for ; Wed, 5 Feb 2025 21:59:59 +0000 (UTC) Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19]) (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with ESMTPSA id 4YpDg26XYDz10yW for ; Wed, 5 Feb 2025 21:59:58 +0000 (UTC) Content-Type: multipart/alternative; boundary="------------4oR3n2evZzpt5qDyvI400v3d" Message-ID: <2f43e635-508c-407a-8309-06e75d492d89@autistici.org> Date: Wed, 5 Feb 2025 22:59:57 +0100 MIME-Version: 1.0 User-Agent: Icedove Daily Content-Language: en-US From: paul Received-SPF: pass client-ip=93.190.126.19; envelope-from=goodoldpaul@autistici.org; helo=confino.investici.org X-Spam_score_int: -27 X-Spam_score: -2.8 X-Spam_bar: -- X-Spam_report: (-2.8 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, HTML_MESSAGE=0.001, RCVD_IN_DNSWL_LOW=-0.7, RCVD_IN_VALIDITY_RPBL_BLOCKED=0.001, RCVD_IN_VALIDITY_SAFE_BLOCKED=0.001, SPF_HELO_PASS=-0.001, SPF_PASS=-0.001 autolearn=ham autolearn_force=no X-Spam_action: no action X-Spam-Score: 0.9 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -0.1 (/) This is a multi-part message in MIME format. --------------4oR3n2evZzpt5qDyvI400v3d Content-Type: text/plain; charset=UTF-8; format=flowed Content-Transfer-Encoding: 8bit Hi Guix, for a while now, we have been able to run Docker/OCI images as Shepherd services with the oci-container-service-type. This was useful especially to run software that is not packaged yet (or sometimes not packageable at all, due to JS and other bootstrapping issues). It allows to declare a list of oci-container-configuration records which would map to Docker backed Shepherd services: (service oci-container-service-type (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"))))) This allows us to have containerized but apparently native services running on the Guix System. The downside is that unless some isolation mechanism are disabled, or unless the running services are very simple and don't have to interact with the world outside them, we lose some of the nice virtualization features of containers. Above all is the need to have all containers connected to the host network to be able to interact with other containers. This is effectively the default behavior of most if not all Guix native services but with the downside that usually OCI images lack all the provenance information that is typical of Guix packages, hence are less trustable than a native Guix package so in some cases users do prefer to have them running in an isolated environment. Another shortcoming of the oci-container-service-type is that it only supports Docker as an OCI runtime which must have a running daemon with full root privileges to be able to execute containers. Since some weeks now, with the help of subids/subgids and unprivileged namespaces, we are able to run completely rootless containers with the rootless-podman-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: (service iptables-service-type) (service rootless-podman-service-type) (service oci-service-type (oci-configuration (runtime 'podman))) (simple-service 'oci-provisioning oci-service-type (oci-extension (volumes (list (oci-network-configuration (name "grafana")))) (networks (list (oci-network-configuration (name "monitoring")))) (containers (list (oci-container-configuration (image "docker.io/grafana/grafana:10.1.5") (network "host") (volumes `(,( . "/opt/bitnami/grafana/conf/grafana.ini") ("grafana" . "/var/lib/grafana")))))))) Please mind that this is only an example and it probably won't work on your system without some more thought. The oci-service-type currently 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. Compared to the oci-container-service-type I added some utility Shepherd actions that are supposed to help with debugging. The above configuration would yield the following $ sudo herd command-line podman-networks /run/current-system/profile/bin/podman network create monitoring $ sudo herd command-line podman-volumes /run/current-system/profile/bin/podman volume create grafana $ sudo herd doc podman-grafana list-actions command-line: Prints podman-grafana's OCI runtime command line invokation. pull: Pull podman-grafana's image (docker.io/grafana/grafana:10.1.5). $ sudo herd command-line podman-grafana /run/current-system/profile/bin/podman run --rm --name podman-grafana --network host -v grafana:/var/lib/grafana -v /gnu/store/yqfvhvf8j4008ykr52zh2dmc1d2mjxih-grafana.ini:/opt/bitnami/grafana/conf/grafana.ini docker.io/bitnami/grafana:10.1.5 At last the Scheme API is thought to facilitate the implementation of a Guix Home service in the future (you can find an untested version of that at [0]). I tested my changes with: guix shell -D guix -CPW -- make check-system TESTS="oci-service-docker oci-container oci-service-rootless-podman docker docker-system rootless-podman" Please let me know your thoughts about this! Thank you for all your work, giacomo [0]: https://github.com/fishinthecalculator/gocix/blob/main/modules/oci/home/services/containers.scm --------------4oR3n2evZzpt5qDyvI400v3d Content-Type: text/html; charset=UTF-8 Content-Transfer-Encoding: 8bit

Hi Guix,

for a while now, we have been able to run Docker/OCI images as Shepherd services with the oci-container-service-type. This was useful especially to run software that is not packaged yet (or sometimes not packageable at all, due to JS and other bootstrapping issues). It allows to declare a list of oci-container-configuration records which would map to Docker backed Shepherd services:

(service oci-container-service-type
         (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")))))

This allows us to have containerized but apparently native services running on the Guix System. The downside is that unless some isolation mechanism are disabled, or unless the running services are very simple and don't have to interact with the world outside them, we lose some of the nice virtualization features of containers. Above all is the need to have all containers connected to the host network to be able to interact with other containers. This is effectively the default behavior of most if not all Guix native services but with the downside that usually OCI images lack all the provenance information that is typical of Guix packages, hence are less trustable than a native Guix package so in some cases users do prefer to have them running in an isolated environment.

Another shortcoming of the oci-container-service-type is that it only supports Docker as an OCI runtime which must have a running daemon with full root privileges to be able to execute containers. Since some weeks now, with the help of subids/subgids and unprivileged namespaces, we are able to run completely rootless containers with the rootless-podman-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:

(service iptables-service-type)
(service rootless-podman-service-type)
(service oci-service-type
         (oci-configuration
          (runtime 'podman)))
(simple-service 'oci-provisioning
                oci-service-type
                (oci-extension
                  (volumes
                    (list
                      (oci-network-configuration (name "grafana"))))
                  (networks
                    (list
                      (oci-network-configuration (name "monitoring"))))
                  (containers
                   (list
                    (oci-container-configuration
                      (image "docker.io/grafana/grafana:10.1.5")
                      (network "host")
                      (volumes
                       `(,( . "/opt/bitnami/grafana/conf/grafana.ini")
                         ("grafana" . "/var/lib/grafana"))))))))

Please mind that this is only an example and it probably won't work on your system without some more thought. The oci-service-type currently 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. Compared to the oci-container-service-type I added some utility Shepherd actions that are supposed to help with debugging. The above configuration would yield the following

$ sudo herd command-line podman-networks
/run/current-system/profile/bin/podman network create monitoring

$ sudo herd command-line podman-volumes
/run/current-system/profile/bin/podman volume create grafana

$ sudo herd doc podman-grafana list-actions

command-line:
  Prints podman-grafana's OCI runtime command line invokation.

pull:
  Pull podman-grafana's image (docker.io/grafana/grafana:10.1.5).

$ sudo herd command-line podman-grafana
/run/current-system/profile/bin/podman run --rm --name podman-grafana --network host -v grafana:/var/lib/grafana -v /gnu/store/yqfvhvf8j4008ykr52zh2dmc1d2mjxih-grafana.ini:/opt/bitnami/grafana/conf/grafana.ini docker.io/bitnami/grafana:10.1.5


At last the Scheme API is thought to facilitate the implementation of a Guix Home service in the future (you can find an untested version of that at [0]). I tested my changes with:

guix shell -D guix -CPW -- make check-system TESTS="oci-service-docker oci-container oci-service-rootless-podman docker docker-system rootless-podman"


Please let me know your thoughts about this!

Thank you for all your work,

giacomo


[0]: https://github.com/fishinthecalculator/gocix/blob/main/modules/oci/home/services/containers.scm

--------------4oR3n2evZzpt5qDyvI400v3d-- From unknown Fri Jun 13 11:55:10 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#76081] [PATCH 1/4] services: rootless-podman: Use login shell. References: <2f43e635-508c-407a-8309-06e75d492d89@autistici.org> In-Reply-To: <2f43e635-508c-407a-8309-06e75d492d89@autistici.org> Resent-From: Giacomo Leidi Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Wed, 05 Feb 2025 22:04:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 76081 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 76081@debbugs.gnu.org Cc: Giacomo Leidi Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.173879299414833 (code B ref 76081); Wed, 05 Feb 2025 22:04:02 +0000 Received: (at 76081) by debbugs.gnu.org; 5 Feb 2025 22:03:14 +0000 Received: from localhost ([127.0.0.1]:53025 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tfnUH-0003r2-IG for submit@debbugs.gnu.org; Wed, 05 Feb 2025 17:03:13 -0500 Received: from confino.investici.org ([93.190.126.19]:28453) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1tfnUE-0003qn-8G for 76081@debbugs.gnu.org; Wed, 05 Feb 2025 17:03:11 -0500 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org; s=stigmate; t=1738792988; bh=IdX9voWndJaRYrFOGe4a/X2LYvkwV0vTWt7K16N+Iog=; h=From:To:Cc:Subject:Date:From; b=btTSXS/GW9W68kDUMq4wVYIaDJmVURzpxd/SkEfRPhiVIwJDaJ/NrQTnEwUlNPW4f iECFdomAaz970EmiIP1OfA6Z6567TOswpDKBTFWXBYtLnErwh6Irxom4AsoFCwY7el m+Jksc5u5U2Xe76z1lXeKH0Ry5KhQc4hNMShCbEE= Received: from mx1.investici.org (unknown [127.0.0.1]) by confino.investici.org (Postfix) with ESMTP id 4YpDkh6CFFz113C; Wed, 5 Feb 2025 22:03:08 +0000 (UTC) Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19]) (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with ESMTPSA id 4YpDkh5BVMz114x; Wed, 5 Feb 2025 22:03:08 +0000 (UTC) From: Giacomo Leidi Date: Wed, 5 Feb 2025 23:02:28 +0100 Message-ID: <89778533f32ad1388f03414e884fff10f74ef379.1738792951.git.goodoldpaul@autistici.org> X-Mailer: git-send-email 2.48.1 MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Spam-Score: -0.7 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.7 (-) This commit allows for having PATH set when changing the owner of /sys/fs/group. * gnu/services/containers.scm (crgroups-fs-owner): Use login shell. Change-Id: I9510c637a5332325e05ca5ebc9dfd4de32685c50 --- gnu/services/containers.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm index 19d35ccbcb6..dc66ac4f967 100644 --- a/gnu/services/containers.scm +++ b/gnu/services/containers.scm @@ -140,7 +140,7 @@ (define (cgroups-fs-owner-entrypoint config) (rootless-podman-configuration-group-name config)) (program-file "cgroups2-fs-owner-entrypoint" #~(system* - (string-append #+bash-minimal "/bin/bash") "-c" + (string-append #+bash-minimal "/bin/bash") "-l" "-c" (string-append "echo Setting /sys/fs/cgroup " "group ownership to " #$group " && chown -v " "root:" #$group " /sys/fs/cgroup && " base-commit: 5a897c5c95a81278b044c18d962d3bd83131ba06 -- 2.48.1 From unknown Fri Jun 13 11:55:10 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#76081] [PATCH 4/4] tests: Use oci-image in container tests. Resent-From: Giacomo Leidi Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Wed, 05 Feb 2025 22:04:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 76081 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 76081@debbugs.gnu.org Cc: Giacomo Leidi Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.173879299714850 (code B ref 76081); Wed, 05 Feb 2025 22:04:02 +0000 Received: (at 76081) by debbugs.gnu.org; 5 Feb 2025 22:03:17 +0000 Received: from localhost ([127.0.0.1]:53027 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tfnUL-0003rR-1o for submit@debbugs.gnu.org; Wed, 05 Feb 2025 17:03:17 -0500 Received: from confino.investici.org ([2a11:7980:1::2:0]:27877) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1tfnUG-0003qs-Ld for 76081@debbugs.gnu.org; Wed, 05 Feb 2025 17:03:13 -0500 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org; s=stigmate; t=1738792990; bh=BhogBkcGveXGHkIi6ZMITQsZOgJcBwBmFiZeVz0FOd0=; h=From:To:Cc:Subject:Date:In-Reply-To:References:From; b=aXYYkGxXdWukx8AiwYCY2h6RdZzCzpj9hGbE5/XnYlxZUDrUctUXFr+12KjWiKqL1 bjKHLVSQdk+8qxibiurPXru+2mhG8s6xnpPNkTnrjwoaRaV//I7Po+5ZYIn3Nuhn8c K5fQnskX26JtPq7zlZFxM1G/85BOHLd9eJb4unIs= Received: from mx1.investici.org (unknown [127.0.0.1]) by confino.investici.org (Postfix) with ESMTP id 4YpDkk6r0Vz115D; Wed, 5 Feb 2025 22:03:10 +0000 (UTC) Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19]) (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with ESMTPSA id 4YpDkk5syxz114x; Wed, 5 Feb 2025 22:03:10 +0000 (UTC) From: Giacomo Leidi Date: Wed, 5 Feb 2025 23:02:31 +0100 Message-ID: X-Mailer: git-send-email 2.48.1 In-Reply-To: <89778533f32ad1388f03414e884fff10f74ef379.1738792951.git.goodoldpaul@autistici.org> References: <89778533f32ad1388f03414e884fff10f74ef379.1738792951.git.goodoldpaul@autistici.org> MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Spam-Score: -0.0 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) This patch replaces boilerplate in container related tests with oci-image plumbing from (gnu services containers). * gnu/services/containers.scm: Export lower-oci-image. * gnu/tests/containers.scm (%oci-tarball): New variable; (run-rootless-podman-test): use %oci-tarball; (build-tarball&run-rootless-podman-test): drop procedure. * gnu/tests/docker.scm (%docker-tarball): New variable; (build-tarball&run-docker-test): use %docker-tarball; (%docker-system-tarball): New variable; (build-tarball&run-docker-system-test): new procedure. Change-Id: Iad6f0704aee188d89464c83722dea0bb7adb084a --- gnu/services/containers.scm | 2 + gnu/tests/containers.scm | 80 ++++++++++++++---------------- gnu/tests/docker.scm | 98 ++++++++++++++++++++----------------- 3 files changed, 93 insertions(+), 87 deletions(-) diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm index c45f79c4ed1..e15dbc6a21c 100644 --- a/gnu/services/containers.scm +++ b/gnu/services/containers.scm @@ -74,6 +74,8 @@ (define-module (gnu services containers) oci-image-system oci-image-grafts? + lower-oci-image + oci-container-configuration oci-container-configuration? oci-container-configuration-fields diff --git a/gnu/tests/containers.scm b/gnu/tests/containers.scm index 719647c298e..024000bca14 100644 --- a/gnu/tests/containers.scm +++ b/gnu/tests/containers.scm @@ -69,13 +69,47 @@ (define %rootless-podman-os (supplementary-groups '("wheel" "netdev" "cgroup" "audio" "video"))))))) -(define (run-rootless-podman-test oci-tarball) +(define %oci-tarball + (lower-oci-image + "guile-guest" + (oci-image + (repository "guile-guest") + (value + (packages->manifest + (list + guile-3.0 guile-json-3 + (package + (name "guest-script") + (version "0") + (source #f) + (build-system trivial-build-system) + (arguments `(#:guile ,guile-3.0 + #:builder + (let ((out (assoc-ref %outputs "out"))) + (mkdir out) + (call-with-output-file (string-append out "/a.scm") + (lambda (port) + (display "(display \"hello world\n\")" port))) + #t))) + (synopsis "Display hello world using Guile") + (description "This package displays the text \"hello world\" on the +standard output device and then enters a new line.") + (home-page #f) + (license license:public-domain))))) + (pack-options + '(#:entry-point "bin/guile" + #:localstatedir? #t + #:extra-options (#:image-tag "guile-guest") + #:symlinks (("/bin/Guile" -> "bin/guile") + ("aa.scm" -> "a.scm"))))))) + +(define (run-rootless-podman-test) (define os (marionette-operating-system (operating-system-with-gc-roots %rootless-podman-os - (list oci-tarball)) + (list %oci-tarball)) #:imported-modules '((gnu services herd) (guix combinators)))) @@ -254,7 +288,7 @@ (define (run-rootless-podman-test oci-tarball) (let* ((loaded (slurp ,(string-append #$podman "/bin/podman") "load" "-i" - ,#$oci-tarball)) + ,#$%oci-tarball)) (repository&tag "localhost/guile-guest:latest") (response1 (slurp ,(string-append #$podman "/bin/podman") @@ -307,49 +341,11 @@ (define (run-rootless-podman-test oci-tarball) (gexp->derivation "rootless-podman-test" test)) -(define (build-tarball&run-rootless-podman-test) - (mlet* %store-monad - ((_ (set-grafting #f)) - (guile (set-guile-for-build (default-guile))) - (guest-script-package -> - (package - (name "guest-script") - (version "0") - (source #f) - (build-system trivial-build-system) - (arguments `(#:guile ,guile-3.0 - #:builder - (let ((out (assoc-ref %outputs "out"))) - (mkdir out) - (call-with-output-file (string-append out "/a.scm") - (lambda (port) - (display "(display \"hello world\n\")" port))) - #t))) - (synopsis "Display hello world using Guile") - (description "This package displays the text \"hello world\" on the -standard output device and then enters a new line.") - (home-page #f) - (license license:public-domain))) - (profile (profile-derivation (packages->manifest - (list guile-3.0 guile-json-3 - guest-script-package)) - #:hooks '() - #:locales? #f)) - (tarball (pack:docker-image - "docker-pack" profile - #:symlinks '(("/bin/Guile" -> "bin/guile") - ("aa.scm" -> "a.scm")) - #:extra-options - '(#:image-tag "guile-guest") - #:entry-point "bin/guile" - #:localstatedir? #t))) - (run-rootless-podman-test tarball))) - (define %test-rootless-podman (system-test (name "rootless-podman") (description "Test rootless Podman service.") - (value (build-tarball&run-rootless-podman-test)))) + (value (run-rootless-podman-test)))) (define %guile-oci-image diff --git a/gnu/tests/docker.scm b/gnu/tests/docker.scm index 5dcf05a17e3..d969b28a68f 100644 --- a/gnu/tests/docker.scm +++ b/gnu/tests/docker.scm @@ -26,6 +26,7 @@ (define-module (gnu tests docker) #:use-module (gnu system image) #:use-module (gnu system vm) #:use-module (gnu services) + #:use-module (gnu services containers) #:use-module (gnu services dbus) #:use-module (gnu services networking) #:use-module (gnu services docker) @@ -57,6 +58,40 @@ (define %docker-os (service containerd-service-type) (service docker-service-type))) +(define %docker-tarball + (lower-oci-image + "guile-guest" + (oci-image + (repository "guile-guest") + (value + (packages->manifest + (list + guile-3.0 guile-json-3 + (package + (name "guest-script") + (version "0") + (source #f) + (build-system trivial-build-system) + (arguments `(#:guile ,guile-3.0 + #:builder + (let ((out (assoc-ref %outputs "out"))) + (mkdir out) + (call-with-output-file (string-append out "/a.scm") + (lambda (port) + (display "(display \"hello world\n\")" port))) + #t))) + (synopsis "Display hello world using Guile") + (description "This package displays the text \"hello world\" on the +standard output device and then enters a new line.") + (home-page #f) + (license license:public-domain))))) + (pack-options + '(#:entry-point "bin/guile" + #:localstatedir? #t + #:extra-options (#:image-tag "guile-guest") + #:symlinks (("/bin/Guile" -> "bin/guile") + ("aa.scm" -> "a.scm"))))))) + (define (run-docker-test docker-tarball) "Load DOCKER-TARBALL as Docker image and run it in a Docker container, inside %DOCKER-OS." @@ -173,40 +208,7 @@ (define (run-docker-test docker-tarball) (gexp->derivation "docker-test" test)) (define (build-tarball&run-docker-test) - (mlet* %store-monad - ((_ (set-grafting #f)) - (guile (set-guile-for-build (default-guile))) - (guest-script-package -> - (package - (name "guest-script") - (version "0") - (source #f) - (build-system trivial-build-system) - (arguments `(#:guile ,guile-3.0 - #:builder - (let ((out (assoc-ref %outputs "out"))) - (mkdir out) - (call-with-output-file (string-append out "/a.scm") - (lambda (port) - (display "(display \"hello world\n\")" port))) - #t))) - (synopsis "Display hello world using Guile") - (description "This package displays the text \"hello world\" on the -standard output device and then enters a new line.") - (home-page #f) - (license license:public-domain))) - (profile (profile-derivation (packages->manifest - (list guile-3.0 guile-json-3 - guest-script-package)) - #:hooks '() - #:locales? #f)) - (tarball (pack:docker-image - "docker-pack" profile - #:symlinks '(("/bin/Guile" -> "bin/guile") - ("aa.scm" -> "a.scm")) - #:entry-point "bin/guile" - #:localstatedir? #t))) - (run-docker-test tarball))) + (run-docker-test %docker-tarball)) (define %test-docker (system-test @@ -215,8 +217,20 @@ (define %test-docker (value (build-tarball&run-docker-test)))) +(define %docker-system-tarball + (lower-oci-image + "guix-system-guest" + (oci-image + (repository "guix-system-guest") + (value + (operating-system + (inherit (simple-operating-system)) + ;; Use locales for a single libc to + ;; reduce space requirements. + (locale-libcs (list glibc))))))) + (define (run-docker-system-test tarball) - "Load DOCKER-TARBALL as Docker image and run it in a Docker container, + "Load TARBALL as Docker image and run it in a Docker container, inside %DOCKER-OS." (define os (marionette-operating-system @@ -333,21 +347,15 @@ (define (run-docker-system-test tarball) (gexp->derivation "docker-system-test" test)) +(define (build-tarball&run-docker-system-test) + (run-docker-system-test %docker-system-tarball)) + (define %test-docker-system (system-test (name "docker-system") (description "Run a system image as produced by @command{guix system docker-image} inside Docker.") - (value (with-monad %store-monad - (>>= (lower-object - (system-image (os->image - (operating-system - (inherit (simple-operating-system)) - ;; Use locales for a single libc to - ;; reduce space requirements. - (locale-libcs (list glibc))) - #:type docker-image-type))) - run-docker-system-test))))) + (value (build-tarball&run-docker-system-test)))) (define %oci-os -- 2.48.1 From unknown Fri Jun 13 11:55:10 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#76081] [PATCH 3/4] services: Add oci-service-type. Resent-From: Giacomo Leidi Original-Sender: "Debbugs-submit" Resent-CC: ludo@gnu.org, maxim.cournoyer@gmail.com, guix-patches@gnu.org Resent-Date: Wed, 05 Feb 2025 22:04:03 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 76081 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 76081@debbugs.gnu.org Cc: Giacomo Leidi , Ludovic =?UTF-8?Q?Court=C3=A8s?= , Maxim Cournoyer X-Debbugs-Original-Xcc: Ludovic =?UTF-8?Q?Court=C3=A8s?= , Maxim Cournoyer Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.173879299714856 (code B ref 76081); Wed, 05 Feb 2025 22:04:03 +0000 Received: (at 76081) by debbugs.gnu.org; 5 Feb 2025 22:03:17 +0000 Received: from localhost ([127.0.0.1]:53029 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tfnUL-0003rT-OV for submit@debbugs.gnu.org; Wed, 05 Feb 2025 17:03:17 -0500 Received: from confino.investici.org ([2a11:7980:1::2:0]:22827) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1tfnUH-0003qq-DV for 76081@debbugs.gnu.org; Wed, 05 Feb 2025 17:03:13 -0500 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org; s=stigmate; t=1738792990; bh=ped8LKNxfBzK4wMnAaS/wU3XSRkLpK01Vt4clHpTnNw=; h=From:To:Cc:Subject:Date:In-Reply-To:References:From; b=l0FIhf9NUYPjmBQPPSgLzbzuiJJjB0UuO+dxFIsduOcRdPPwtuUVAiRarF98YSM+l 1bAs6CoLOhKyVkRcrJitDhSB3XO/s9CfkLYKbbk2xRlvF2qBvBJnhQ/0kvsSjGR91W P+74wmbN5V78PsxyEurroOGsekSupkqwwGhylHDg= Received: from mx1.investici.org (unknown [127.0.0.1]) by confino.investici.org (Postfix) with ESMTP id 4YpDkk4PD9z115B; Wed, 5 Feb 2025 22:03:10 +0000 (UTC) Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19]) (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with ESMTPSA id 4YpDkk38WWz114x; Wed, 5 Feb 2025 22:03:10 +0000 (UTC) From: Giacomo Leidi Date: Wed, 5 Feb 2025 23:02:30 +0100 Message-ID: X-Mailer: git-send-email 2.48.1 In-Reply-To: <89778533f32ad1388f03414e884fff10f74ef379.1738792951.git.goodoldpaul@autistici.org> References: <89778533f32ad1388f03414e884fff10f74ef379.1738792951.git.goodoldpaul@autistici.org> MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" 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/services/containers.scm (%oci-supported-runtimes): New variable; (oci-runtime-cli): new variable; (oci-runtime-name): new variable; (oci-network-configuration): new variable; (oci-volume-configuration): new variable; (oci-configuration): new variable; (oci-extension): new variable; (oci-networks-shepherd-name): new variable; (oci-service-type): new variable; (oci-state->shepherd-services): new variable. * doc/guix.texi: Document it. * gnu/tests/containers.scm: Test it. * gnu/services/docker.scm: Deprecate the oci-container-service-type. Change-Id: I656b3db85832e42d53072fcbfb91d1226f39ef38 --- doc/guix.texi | 295 +++++++--- gnu/services/containers.scm | 1038 +++++++++++++++++++++++++++++++---- gnu/services/docker.scm | 37 +- gnu/tests/containers.scm | 956 +++++++++++++++++++++++++++++++- 4 files changed, 2130 insertions(+), 196 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index bb5f29277fb..ff3e77a1d00 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -41778,59 +41778,155 @@ Miscellaneous Services @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: given an -@acronym{Open Container Initiative, OCI} container image, it will run it in a +Should you wish to manage your @acronym{Open Container Initiative, OCI} containers +with the same consistent interface you use for your other Shepherd services, +@var{oci-service-type} is the tool to use: given an +OCI container image, it will run it in a Shepherd service. One example where this is useful: it lets you run services -that are available as Docker/OCI images but not yet packaged for Guix. +that are available as OCI images but not yet packaged for Guix. -@defvar oci-container-service-type +@defvar oci-service-type -This is a thin wrapper around Docker's CLI that executes OCI images backed +This is a thin wrapper around Docker's or Podman's CLI that executes OCI images backed processes as Shepherd Services. @lisp -(service oci-container-service-type - (list - (oci-container-configuration - (network "host") - (image - (oci-image - (repository "guile") - (tag "3") - (value (specifications->manifest '("guile"))) - (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile")) - #:max-layers 2)))) - (entrypoint "/bin/guile") - (command - '("-c" "(display \"hello!\n\")"))) - (oci-container-configuration - (image "prom/prometheus") - (ports - '(("9000" . "9000") - ("9090" . "9090")))) - (oci-container-configuration - (image "grafana/grafana:10.0.1") - (network "host") - (volumes - '("/var/lib/grafana:/var/lib/grafana"))))) +(simple-service 'oci-provisioning + oci-service-type + (oci-extension + (networks + (list + (oci-network-configuration (name "monitoring")))) + (containers + (list + (oci-container-configuration + (network "monitoring") + (image + (oci-image + (repository "guile") + (tag "3") + (value (specifications->manifest '("guile"))) + (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile")) + #:max-layers 2)))) + (entrypoint "/bin/guile") + (command + '("-c" "(display \"hello!\n\")"))) + (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 In this example three different Shepherd services are going to be added to the system. Each @code{oci-container-configuration} record translates to a -@code{docker run} invocation and its fields directly map to options. You can -refer to the -@url{https://docs.docker.com/engine/reference/commandline/run,upstream} -documentation for the semantics of each value. If the images are not found, -they will be -@url{https://docs.docker.com/engine/reference/commandline/pull/,pulled}. The +@command{docker run} or @command{podman run} invocation and its fields directly +map to options. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html,Podman} +upstream documentation for semantics of each value. If the images are not found, +they will be pulled. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/pull/,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-pull.1.html,Podman} +upstream documentation for semantics. The services with @code{(network "host")} are going to be attached to the host network and are supposed to behave like native processes with regard to networking. @end defvar +@c %start of fragment + +@deftp {Data Type} oci-configuration +Available @code{oci-configuration} fields are: + +@table @asis +@item @code{runtime} (default: @code{'docker}) (type: symbol) +The OCI runtime to use to run commands. It can be either @code{'docker} or +@code{'podman}. + +@item @code{runtime-cli} (type: maybe-package) +The OCI runtime command line to be installed in the system profile and used +to provision OCI resources. When unset it will default to @code{docker-cli} +package for the @code{'docker} runtime or to @code{podman} package for the +@code{'podman} runtime. + +@item @code{user} (default: @code{"oci-container"}) (type: string) +The user name under whose authority OCI commands will be run. + +@item @code{group} (default: @code{"docker"}) (type: string) +The group name under whose authority OCI commands will be run. When +using the @code{'podman} OCI runtime, this field will be ignored and the +default group of the user configured in the @code{user} field will be used. + +@item @code{subuids-range} (type: maybe-subid-range) +An optional @code{subid-range} record allocating subuids for the user from +the @code{user} field. When unset, with the rootless Podman OCI runtime, it +defaults to @code{(subid-range (name "oci-container"))}. + +@item @code{subgids-range} (type: maybe-subid-range) +An optional @code{subid-range} record allocating subgids for the user from +the @code{user} field. When unset, with the rootless Podman OCI runtime, it +defaults to @code{(subid-range (name "oci-container"))}. + +@item @code{containers} (default: @code{'()}) (type: list-of-oci-containers) +The list of @code{oci-container-configuration} records representing the +containers to provision. Most users are supposed not to use this field and use +the @code{oci-extension} record instead. + +@item @code{networks} (default: @code{'()}) (type: list-of-oci-networks) +The list of @code{oci-network-configuration} records representing the +containers to provision. Most users are supposed not to use this field and use +the @code{oci-extension} record instead. + +@item @code{volumes} (default: @code{'()}) (type: list-of-oci-volumes) +The list of @code{oci-volumes-configuration} records representing the +containers to provision. Most users are supposed not to use this field and use +the @code{oci-extension} record instead. + +@item @code{verbose?} (default: @code{#f}) (type: boolean) +When true, additional output will be printed, allowing to better follow the +flow of execution. + +@end table + +@end deftp + + +@c %end of fragment + +@c %start of fragment + +@deftp {Data Type} oci-extension +Available @code{oci-extension} fields are: + +@table @asis +@item @code{containers} (default: @code{'()}) (type: list-of-oci-containers) +The list of @code{oci-container-configuration} records representing the +containers to provision. + +@item @code{networks} (default: @code{'()}) (type: list-of-oci-networks) +The list of @code{oci-network-configuration} records representing the +containers to provision. + +@item @code{volumes} (default: @code{'()}) (type: list-of-oci-volumes) +The list of @code{oci-volumes-configuration} records representing the +containers to provision. + +@end table + +@end deftp + + +@c %end of fragment + + @c %start of fragment @deftp {Data Type} oci-container-configuration @@ -41850,16 +41946,16 @@ Miscellaneous Services Overwrite the default entrypoint (@code{ENTRYPOINT}) of the image. @item @code{host-environment} (default: @code{'()}) (type: 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 +Set environment variables in the host environment where @command{docker run} +or @command{podman run} are invoked. This is especially useful to pass secrets +from the host to the container without having them on the OCI runtime command line, +for example: by setting the @code{MYSQL_PASSWORD} on the host and by passing @code{--env MYSQL_PASSWORD} through the @code{extra-arguments} field, it is possible to securely set values in the container environment. This field's value can be a list of pairs or strings, even mixed: @lisp -(list '("LANGUAGE\" . "eo:ca:eu") +(list '("LANGUAGE" . "eo:ca:eu") "JAVA_HOME=/opt/java") @end lisp @@ -41867,22 +41963,24 @@ Miscellaneous Services directly to @code{make-forkexec-constructor}. @item @code{environment} (default: @code{'()}) (type: list) -Set environment variables. This can be a list of pairs or strings, even mixed: +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 -@uref{https://docs.docker.com/engine/reference/commandline/run/#env,upstream} -documentation for semantics. +Pair members can be strings, gexps or file-like objects. Strings are passed +directly to the OCI runtime CLI. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run/#env,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#env-e-env,Podman} +upstream documentation for semantics. @item @code{image} (type: 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{oci-image} record. Strings are resolved by the OCI runtime, +and follow the usual format @code{myregistry.local:5000/testing/test-image:tag}. @item @code{provision} (default: @code{""}) (type: string) @@ -41910,7 +42008,7 @@ Miscellaneous Services by the service. @item @code{network} (default: @code{""}) (type: string) -Set a Docker network for the spawned container. +Set an OCI 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 @@ -41921,10 +42019,11 @@ Miscellaneous Services "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 -@uref{https://docs.docker.com/engine/reference/commandline/run/#publish,upstream} -documentation for semantics. +Pair members can be strings, gexps or file-like objects. Strings are passed +directly to the OCI runtime CLI. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run/#publish,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#publish-p-ip-hostport-containerport-protocol,Podman} +upstream documentation for semantics. @item @code{volumes} (default: @code{'()}) (type: list) Set volume mappings for the spawned container. This can be a @@ -41935,25 +42034,95 @@ Miscellaneous Services "/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 -@uref{https://docs.docker.com/engine/reference/commandline/run/#volume,upstream} -documentation for semantics. +Pair members can be strings, gexps or file-like objects. Strings are passed +directly to the OCI runtime CLI. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run/#volume,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#volume-v-source-volume-host-dir-container-dir-options,Podman} +upstream documentation for semantics. @item @code{container-user} (default: @code{""}) (type: 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. +@url{https://docs.docker.com/engine/reference/run/#user,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#user-u-user-group,Podman} +upstream documentation for semantics. @item @code{workdir} (default: @code{""}) (type: string) Set the current working directory for the spawned Shepherd service. You can refer to the -@url{https://docs.docker.com/engine/reference/run/#workdir,upstream} -documentation for semantics. +@url{https://docs.docker.com/engine/reference/run/#workdir,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#workdir-w-dir,Podman} +upstream documentation for semantics. + +@item @code{extra-arguments} (default: @code{'()}) (type: list) +A list of strings, gexps or file-like objects that will be directly passed +to the @command{docker run} or @command{podman run} invokation. + +@end table + +@end deftp + + +@c %end of fragment + +@c %start of fragment + +@deftp {Data Type} oci-network-configuration +Available @code{oci-network-configuration} fields are: + +@table @asis +@item @code{name} (type: string) +The name of the OCI network to provision. + +@item @code{driver} (type: maybe-string) +The driver to manage the network. + +@item @code{gateway} (type: maybe-string) +IPv4 or IPv6 gateway for the subnet. + +@item @code{internal?} (default: @code{#f}) (type: boolean) +Restrict external access to the network + +@item @code{ip-range} (type: maybe-string) +Allocate container ip from a sub-range in CIDR format. + +@item @code{ipam-driver} (type: maybe-string) +IP Address Management Driver. + +@item @code{ipv6?} (default: @code{#f}) (type: boolean) +Enable IPv6 networking. + +@item @code{subnet} (type: maybe-string) +Subnet in CIDR format that represents a network segment. + +@item @code{labels} (default: @code{'()}) (type: list) +The list of labels that will be used to tag the current volume. + +@item @code{extra-arguments} (default: @code{'()}) (type: list) +A list of strings, gexps or file-like objects that will be directly +passed to the runtime invokation. + +@end table + +@end deftp + + +@c %end of fragment + +@c %start of fragment + +@deftp {Data Type} oci-volume-configuration +Available @code{oci-volume-configuration} fields are: + +@table @asis +@item @code{name} (type: string) +The name of the OCI volume to provision. + +@item @code{labels} (default: @code{'()}) (type: list) +The list of labels that will be used to tag the current volume. @item @code{extra-arguments} (default: @code{'()}) (type: list) A list of strings, gexps or file-like objects that will be directly -passed to the @command{docker run} invocation. +passed to the runtime invokation. @end table diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm index 50bf6c05549..c45f79c4ed1 100644 --- a/gnu/services/containers.scm +++ b/gnu/services/containers.scm @@ -41,6 +41,7 @@ (define-module (gnu services containers) #:use-module ((guix scripts pack) #:prefix pack:) #:use-module (guix store) #:use-module (srfi srfi-1) + #:use-module (ice-9 format) #:use-module (ice-9 match) #:export (rootless-podman-configuration rootless-podman-configuration? @@ -96,8 +97,68 @@ (define-module (gnu services containers) oci-container-configuration-workdir oci-container-configuration-extra-arguments + list-of-oci-containers? + list-of-oci-networks? + list-of-oci-volumes? + + %oci-supported-runtimes + oci-sanitize-runtime + oci-runtime-system-requirement + oci-runtime-cli + oci-runtime-system-cli + oci-runtime-name + oci-runtime-group + + oci-network-configuration + oci-network-configuration? + oci-network-configuration-fields + oci-network-configuration-name + oci-network-configuration-driver + oci-network-configuration-gateway + oci-network-configuration-internal? + oci-network-configuration-ip-range + oci-network-configuration-ipam-driver + oci-network-configuration-ipv6? + oci-network-configuration-subnet + oci-network-configuration-labels + oci-network-configuration-extra-arguments + + oci-volume-configuration + oci-volume-configuration? + oci-volume-configuration-fields + oci-volume-configuration-name + oci-volume-configuration-labels + oci-volume-configuration-extra-arguments + + oci-configuration + oci-configuration? + oci-configuration-fields + oci-configuration-runtime + oci-configuration-runtime-cli + oci-configuration-user + oci-configuration-group + oci-configuration-containers + oci-configuration-networks + oci-configuration-volumes + oci-configuration-verbose? + + oci-extension + oci-extension? + oci-extension-fields + oci-extension-containers + oci-extension-networks + oci-extension-volumes + + oci-networks-shepherd-name + oci-volumes-shepherd-name + oci-container-shepherd-service - %oci-container-accounts)) + oci-service-type + oci-service-accounts + oci-service-profile + oci-service-subids + oci-state->shepherd-services + oci-configuration->shepherd-services)) (define (gexp-or-string? value) (or (gexp? value) @@ -294,9 +355,42 @@ (define rootless-podman-service-type ;;; -;;; OCI container. +;;; OCI provisioning service. ;;; +(define %oci-supported-runtimes + '(docker podman)) + +(define (oci-runtime-system-requirement runtime) + "Return a list of Shepherd service names required by a given OCI runtime, +before it is able to run containers." + (if (eq? 'podman runtime) + '(cgroups2-fs-owner cgroups2-limits + rootless-podman-shared-root-fs) + '(dockerd))) + +(define (oci-runtime-name runtime) + "Return a human readable name for a given OCI runtime." + (if (eq? 'podman runtime) + "Podman" "Docker")) + +(define (oci-runtime-group runtime maybe-group) + "Implement the logic behind selection of the group that is to be used by +Shepherd to execute OCI commands." + (if (maybe-value-set? maybe-group) + maybe-group + (if (eq? 'podman runtime) + "cgroup" + "docker"))) + +(define (oci-sanitize-runtime value) + (unless (member value %oci-supported-runtimes) + (raise + (formatted-message + (G_ "OCI runtime must be a symbol and one of ~a, +but ~a was found") %oci-supported-runtimes value))) + value) + (define (oci-sanitize-pair pair delimiter) (define (valid? member) (or (string? member) @@ -345,6 +439,11 @@ (define (oci-sanitize-volumes value) ;; '(("/mnt/dir" . "/dir") "/run/current-system/profile:/java") (oci-sanitize-mixed-list "volumes" value ":")) +(define (oci-sanitize-labels value) + ;; Expected spec format: + ;; '(("foo" . "bar") "foo=bar") + (oci-sanitize-mixed-list "labels" value "=")) + (define (oci-sanitize-shepherd-actions value) (map (lambda (el) @@ -372,6 +471,7 @@ (define (oci-sanitize-extra-arguments value) value)) (define (oci-image-reference image) + "Return a string OCI image reference representing IMAGE." (if (string? image) image (string-append (oci-image-repository image) @@ -390,7 +490,19 @@ (define (string-or-oci-image? image) (define list-of-symbols? (list-of symbol?)) +(define (list-of-oci-records? name predicate value) + (map + (lambda (el) + (if (predicate el) + el + (raise + (formatted-message + (G_ "~a contains an illegal value: ~a") name el)))) + value)) + (define-maybe/no-serialization string) +(define-maybe/no-serialization package) +(define-maybe/no-serialization subid-range) (define-configuration/no-serialization oci-image (repository @@ -436,10 +548,12 @@ (define-configuration/no-serialization oci-image (define-configuration/no-serialization oci-container-configuration (user (string "oci-container") - "The user under whose authority docker commands will be run.") + "The user name under whose authority OCI commands will be run.") (group (string "docker") - "The group under whose authority docker commands will be run.") + "The group name under whose authority OCI commands will be run. When +using the @code{'podman} OCI runtime, this field will be ignored and the +default group of the user configured in the @code{user} field will be used.") (command (list-of-strings '()) "Overwrite the default command (@code{CMD}) of the image.") @@ -449,9 +563,9 @@ (define-configuration/no-serialization oci-container-configuration (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 +or @command{podman run} are invoked. This is especially useful to pass secrets +from the host to the container without having them on the OCI runtime command line, +for example: by setting the @code{MYSQL_PASSWORD} on the host and by passing @code{--env MYSQL_PASSWORD} through the @code{extra-arguments} field, it is possible to securely set values in the container environment. This field's value can be a list of pairs or strings, even mixed: @@ -475,15 +589,16 @@ (define-configuration/no-serialization oci-container-configuration @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." +directly to the OCI runtime CLI. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run/#env,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#env-e-env,Podman} +upstream documentation for semantics." (sanitizer oci-sanitize-environment)) (image (string-or-oci-image) "The image used to build the container. It can be a string or an -@code{oci-image} record. Strings are resolved by the Docker -Engine, and follow the usual format +@code{oci-image} record. Strings are resolved by the OCI runtime, +and follow the usual format @code{myregistry.local:5000/testing/test-image:tag}.") (provision (maybe-string) @@ -512,7 +627,7 @@ (define-configuration/no-serialization oci-container-configuration (sanitizer oci-sanitize-shepherd-actions)) (network (maybe-string) - "Set a Docker network for the spawned container.") + "Set an OCI network for the spawned container.") (ports (list '()) "Set the port or port ranges to expose from the spawned container. This can @@ -524,9 +639,10 @@ (define-configuration/no-serialization oci-container-configuration @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." +directly to the OCI runtime CLI. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run/#publish,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#publish-p-ip-hostport-containerport-protocol,Podman} +upstream documentation for semantics." (sanitizer oci-sanitize-ports)) (volumes (list '()) @@ -539,63 +655,307 @@ (define-configuration/no-serialization oci-container-configuration @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." +directly to the OCI runtime CLI. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run/#volume,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#volume-v-source-volume-host-dir-container-dir-options,Podman} +upstream documentation for semantics." (sanitizer oci-sanitize-volumes)) (container-user (maybe-string) "Set the current user inside the spawned container. You can refer to the -@url{https://docs.docker.com/engine/reference/run/#user,upstream} -documentation for semantics.") +@url{https://docs.docker.com/engine/reference/run/#user,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#user-u-user-group,Podman} +upstream documentation for semantics.") (workdir (maybe-string) - "Set the current working for the spawned Shepherd service. + "Set the current working directory for the spawned Shepherd service. You can refer to the -@url{https://docs.docker.com/engine/reference/run/#workdir,upstream} -documentation for semantics.") +@url{https://docs.docker.com/engine/reference/run/#workdir,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#workdir-w-dir,Podman} +upstream documentation for semantics.") (extra-arguments (list '()) "A list of strings, gexps or file-like objects that will be directly passed -to the @command{docker run} invokation." +to the @command{docker run} or @command{podman 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 (list-of-oci-containers? value) + (list-of-oci-records? "containers" oci-container-configuration? value)) + +(define-configuration/no-serialization oci-volume-configuration + (name + (string) + "The name of the OCI volume to provision.") + (labels + (list '()) + "The list of labels that will be used to tag the current volume." + (sanitizer oci-sanitize-labels)) + (extra-arguments + (list '()) + "A list of strings, gexps or file-like objects that will be directly passed +to the runtime invokation." + (sanitizer oci-sanitize-extra-arguments))) + +(define (list-of-oci-volumes? value) + (list-of-oci-records? "volumes" oci-volume-configuration? value)) + +(define-configuration/no-serialization oci-network-configuration + (name + (string) + "The name of the OCI network to provision.") + (driver + (maybe-string) + "The driver to manage the network.") + (gateway + (maybe-string) + "IPv4 or IPv6 gateway for the subnet.") + (internal? + (boolean #f) + "Restrict external access to the network") + (ip-range + (maybe-string) + "Allocate container ip from a sub-range in CIDR format.") + (ipam-driver + (maybe-string) + "IP Address Management Driver.") + (ipv6? + (boolean #f) + "Enable IPv6 networking.") + (subnet + (maybe-string) + "Subnet in CIDR format that represents a network segment.") + (labels + (list '()) + "The list of labels that will be used to tag the current volume." + (sanitizer oci-sanitize-labels)) + (extra-arguments + (list '()) + "A list of strings, gexps or file-like objects that will be directly passed +to the runtime invokation." + (sanitizer oci-sanitize-extra-arguments))) + +(define (list-of-oci-networks? value) + (list-of-oci-records? "networks" oci-network-configuration? value)) + +(define-configuration/no-serialization oci-configuration + (runtime + (symbol 'docker) + "The OCI runtime to use to run commands. It can be either @code{'docker} or +@code{'podman}." + (sanitizer oci-sanitize-runtime)) + (runtime-cli + (maybe-package) + "The OCI runtime command line to be installed in the system profile and used +to provision OCI resources. When unset it will default to @code{docker-cli} +package for the @code{'docker} runtime or to @code{podman} package for the +@code{'podman} runtime.") + (user + (string "oci-container") + "The user name under whose authority OCI runtime commands will be run.") + (group + (maybe-string) + "The group name under whose authority OCI commands will be run. When +using the @code{'podman} OCI runtime, this field will be ignored and the +default group of the user configured in the @code{user} field will be used.") + (subuids-range + (maybe-subid-range) + "An optional @code{subid-range} record allocating subuids for the user from +the @code{user} field. When unset, with the rootless Podman OCI runtime, it +defaults to @code{(subid-range (name \"oci-container\"))}.") + (subgids-range + (maybe-subid-range) + "An optional @code{subid-range} record allocating subgids for the user from +the @code{user} field. When unset, with the rootless Podman OCI runtime, it +defaults to @code{(subid-range (name \"oci-container\"))}.") + (containers + (list-of-oci-containers '()) + "The list of @code{oci-container-configuration} records representing the +containers to provision. Most users are supposed not to use this field and use +the @code{oci-extension} record instead.") + (networks + (list-of-oci-networks '()) + "The list of @code{oci-network-configuration} records representing the +networks to provision. Most users are supposed not to use this field and use +the @code{oci-extension} record instead.") + (volumes + (list-of-oci-volumes '()) + "The list of @code{oci-volume-configuration} records representing the +volumes to provision. Most users are supposed not to use this field and use +the @code{oci-extension} record instead.") + (verbose? + (boolean #f) + "When true, additional output will be printed, allowing to better follow the +flow of execution.")) + +(define (oci-runtime-cli runtime runtime-cli path) + "Return a gexp that, when lowered, evaluates to the file system path of the OCI +runtime command requested by the user." + (if (string? runtime-cli) + ;; It is a user defined absolute path + runtime-cli + #~(string-append + (if #$(maybe-value-set? runtime-cli) + #$runtime-cli + #$path) + (if #$(eq? 'podman runtime) + "/bin/podman" + "/bin/docker")))) + +(define* (oci-runtime-system-cli config #:key (path "/run/current-system/profile")) + (let ((runtime-cli + (oci-configuration-runtime-cli config)) + (runtime + (oci-configuration-runtime config))) + (oci-runtime-cli runtime runtime-cli path))) + +(define-configuration/no-serialization oci-extension + (containers + (list-of-oci-containers '()) + "The list of @code{oci-container-configuration} records representing the +containers to add.") + (networks + (list-of-oci-networks '()) + "The list of @code{oci-network-configuration} records representing the +networks to add.") + (volumes + (list-of-oci-volumes '()) + "The list of @code{oci-volume-configuration} records representing the +volumes to add.")) + +(define (oci-image->container-name image) + "Infer the name of an OCI backed Shepherd service from its OCI image." + (basename + (if (string? image) + (first (string-split image #\:)) + (oci-image-repository image)))) + +(define (oci-object-command-shepherd-action object-name invokation) + "Return a Shepherd action printing a given INVOKATION of an OCI command for the +given OBJECT-NAME." + (shepherd-action + (name 'command-line) + (documentation + (format #f "Prints ~a's OCI runtime command line invokation." + object-name)) + (procedure + #~(lambda _ + (format #t "~a~%" #$invokation))))) + +(define (oci-container-shepherd-name runtime config) + "Return the name of an OCI backed Shepherd service based on CONFIG. +The name configured in the configuration record is returned when +CONFIG's name field has a value, otherwise a name is inferred from CONFIG's +image field." + (define name (oci-container-configuration-provision config)) + (define image (oci-container-configuration-image config)) + + (if (maybe-value-set? name) + name + (string-append (symbol->string runtime) "-" + (oci-image->container-name image)))) + +(define (oci-networks-shepherd-name runtime) + "Return the name of the OCI networks provisioning Shepherd service based on +RUNTIME." + (string-append (symbol->string runtime) "-networks")) + +(define (oci-volumes-shepherd-name runtime) + "Return the name of the OCI volumes provisioning Shepherd service based on +RUNTIME." + (string-append (symbol->string runtime) "-volumes")) + +(define (oci-container-configuration->options config) + "Map CONFIG, an oci-container-configuration record, to a gexp that, upon +lowering, will be evaluated to a list of strings containing command line options +for the OCI runtime run command." + (let ((entrypoint + (oci-container-configuration-entrypoint config)) + (network + (oci-container-configuration-network config)) + (user + (oci-container-configuration-container-user config)) + (workdir + (oci-container-configuration-workdir config))) + (apply append + (filter (compose not unspecified?) + `(,(if (maybe-value-set? entrypoint) + `("--entrypoint" ,entrypoint) + '()) + ,(append-map + (lambda (spec) + (list "--env" spec)) + (oci-container-configuration-environment config)) + ,(if (maybe-value-set? network) + `("--network" ,network) + '()) + ,(if (maybe-value-set? user) + `("--user" ,user) + '()) + ,(if (maybe-value-set? workdir) + `("--workdir" ,workdir) + '()) + ,(append-map + (lambda (spec) + (list "-p" spec)) + (oci-container-configuration-ports config)) + ,(append-map + (lambda (spec) + (list "-v" spec)) + (oci-container-configuration-volumes config))))))) + +(define (oci-network-configuration->options config) + "Map CONFIG, an oci-network-configuration record, to a gexp that, upon +lowering, will be evaluated to a list of strings containing command line options +for the OCI runtime network create command." + (let ((driver (oci-network-configuration-driver config)) + (gateway + (oci-network-configuration-gateway config)) + (internal? + (oci-network-configuration-internal? config)) + (ip-range + (oci-network-configuration-ip-range config)) + (ipam-driver + (oci-network-configuration-ipam-driver config)) + (ipv6? + (oci-network-configuration-ipv6? config)) + (subnet + (oci-network-configuration-subnet config))) + (apply append + (filter (compose not unspecified?) + `(,(if (maybe-value-set? driver) + `("--driver" ,driver) + '()) + ,(if (maybe-value-set? gateway) + `("--gateway" ,gateway) + '()) + ,(if internal? + `("--internal") + '()) + ,(if (maybe-value-set? ip-range) + `("--ip-range" ,ip-range) + '()) + ,(if (maybe-value-set? ipam-driver) + `("--ipam-driver" ,ipam-driver) + '()) + ,(if ipv6? + `("--ipv6") + '()) + ,(if (maybe-value-set? subnet) + `("--subnet" ,subnet) + '()) + ,(append-map + (lambda (spec) + (list "--label" spec)) + (oci-network-configuration-labels config))))))) + +(define (oci-volume-configuration->options config) + "Map CONFIG, an oci-volume-configuration record, to a gexp that, upon +lowering, will be evaluated to a list of strings containing command line options +for the OCI runtime volume create command." + (append-map + (lambda (spec) + (list "--label" spec)) + (oci-volume-configuration-labels config))) (define* (get-keyword-value args keyword #:key (default #f)) (let ((kv (memq keyword args))) @@ -604,6 +964,7 @@ (define* (get-keyword-value args keyword #:key (default #f)) default))) (define (lower-operating-system os target system) + "Lower OS, an operating-system record, into a tarball containing an OCI image." (mlet* %store-monad ((tarball (lower-object @@ -613,6 +974,7 @@ (define (lower-operating-system os target system) (return tarball))) (define (lower-manifest name image target system) + "Lower IMAGE, a manifest record, into a tarball containing an OCI image." (define value (oci-image-value image)) (define options (oci-image-pack-options image)) (define image-reference @@ -645,6 +1007,7 @@ (define (lower-manifest name image target system) (return tarball))) (define (lower-oci-image name image) + "Lower IMAGE, a oci-image record, into a tarball containing an OCI image." (define value (oci-image-value image)) (define image-target (oci-image-target image)) (define image-system (oci-image-system image)) @@ -675,9 +1038,10 @@ (define (lower-oci-image name image) #: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))) +(define* (oci-image-loader runtime-cli name image tag #:key (verbose? #f)) + "Return a file-like object that, once lowered, will evaluate to a program able +to load IMAGE through RUNTIME-CLI and to tag it with TAG afterwards." + (let ((tarball (lower-oci-image name image))) (with-imported-modules '((guix build utils)) (program-file (format #f "~a-image-loader" name) #~(begin @@ -686,102 +1050,536 @@ (define (%oci-image-loader name image tag) (ice-9 rdelim)) (format #t "Loading image for ~a from ~a...~%" #$name #$tarball) + (define load-command + (string-append #$runtime-cli + " load -i " #$tarball)) + (when #$verbose? + (format #t "Running ~a~%" load-command)) (define line (read-line - (open-input-pipe - (string-append #$docker " load -i " #$tarball)))) + (open-input-pipe load-command))) (unless (or (eof-object? line) (string-null? line)) (format #t "~a~%" line) - (let ((repository&tag - (string-drop line - (string-length - "Loaded image: ")))) + (let* ((repository&tag + (string-drop line + (string-length + "Loaded image: "))) + (tag-command + (list #$runtime-cli "tag" repository&tag #$tag))) + + (when #$verbose? + (format #t "Running~{ ~a~}~%" tag-command)) - (invoke #$docker "tag" repository&tag #$tag) + (apply invoke tag-command) (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)) +(define* (oci-container-entrypoint runtime-cli name image image-reference + invokation #:key (verbose? #f)) + "Return a file-like object that, once lowered, will evaluate to the entrypoint +for the Shepherd service that will run IMAGE through RUNTIME-CLI." + (program-file + (string-append "oci-entrypoint-" name) + #~(begin + (use-modules (ice-9 format)) + (when #$verbose? + (format #t "Running in verbose mode...")) + (define invokation (list #$@invokation)) + #$@(if (oci-image? image) + #~((system* + #$(oci-image-loader + runtime-cli name image + image-reference #:verbose? verbose?))) + #~()) + (when #$verbose? + (format #t "Running~{ ~a~}~%" invokation)) + (apply execlp invokation)))) + +(define* (oci-container-shepherd-service runtime runtime-cli config + #:key + (oci-requirement '()) + (user #f) + (group #f) + (verbose? #f)) + "Return a Shepherd service object that will run the OCI container represented +by CONFIG through RUNTIME-CLI." + (let* ((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)) + (user (or user (oci-container-configuration-user config))) + (group (if (and group (maybe-value-set? group)) + 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)) + (name + (oci-container-shepherd-name runtime config)) (extra-arguments - (oci-container-configuration-extra-arguments config))) + (oci-container-configuration-extra-arguments config)) + (invokation + ;; run [OPTIONS] IMAGE [COMMAND] [ARG...] + `(,runtime-cli ,runtime-cli "run" + "--rm" "--name" ,name + ,@options ,@extra-arguments + ,image-reference ,@command))) (shepherd-service (provision `(,(string->symbol name))) - (requirement `(dockerd user-processes ,@requirement)) + (requirement `(,@(oci-runtime-system-requirement runtime) + user-processes + ,@oci-requirement + ,@requirement)) (respawn? respawn?) (auto-start? auto-start?) (documentation (string-append - "Docker backed Shepherd service for " + (oci-runtime-name runtime) " backed Shepherd service for " (if (oci-image? image) name image) ".")) (start - #~(lambda () - #$@(if (oci-image? image) - #~((invoke #$(%oci-image-loader - name image image-reference))) - #~()) + #~(lambda _ (fork+exec-command - ;; docker run [OPTIONS] IMAGE [COMMAND] [ARG...] - (list #$docker "run" "--rm" "--name" #$name - #$@options #$@extra-arguments - #$image-reference #$@command) + (list + #$(oci-container-entrypoint + runtime-cli name image image-reference + invokation #:verbose? verbose?)) #:user #$user - #:group #$group + #:group + (if #$(eq? runtime 'podman) + (group:name + (getgrgid + (passwd:gid (getpwnam #$user)))) + #$group) #$@(if (maybe-value-set? log-file) (list #:log-file log-file) '()) #:environment-variables - (list #$@host-environment)))) + (append + (list #$@host-environment) + (if #$(eq? runtime 'podman) + (list + (string-append + "HOME=" (passwd:dir (getpwnam #$user)))) + '()))))) (stop #~(lambda _ - (invoke #$docker "rm" "-f" #$name))) + (invoke #$runtime-cli "rm" "-f" #$name))) (actions - (if (oci-image? image) - '() - (append + (append + (list + (oci-object-command-shepherd-action + name #~(string-join (cdr (list #$@invokation)) " "))) + (if (oci-image? image) + '() (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 + (let ((service-name name)) + (shepherd-action + (name 'pull) + (documentation + (format #f "Pull ~a's image (~a)." + service-name image)) + (procedure + #~(lambda _ + (invoke #$runtime-cli "pull" #$image))))))) + actions))))) + +(define (oci-object-create-invokation object runtime-cli name options + extra-arguments) + "Return a gexp that, upon lowering, will evaluate to the OCI runtime +invokation for creating networks and volumes." + ;; network|volume create [options] [NAME] + #~(list #$runtime-cli #$object "create" + #$@options #$@extra-arguments #$name)) + +(define (format-oci-invokations invokations) + "Return a gexp that, upon lowering, will evaluate to a formatted message +containing the INVOKATIONS that the OCI runtime will execute to provision +networks or volumes." + #~(string-join (map (lambda (i) (string-join i " ")) + (list #$@invokations)) + "\n")) + +(define* (oci-object-create-script object runtime runtime-cli invokations + #:key (verbose? #f)) + "Return a file-like object that, once lowered, will evaluate to a program able +to create OCI networks and volumes through RUNTIME-CLI." + (define runtime-string (symbol->string runtime)) + (program-file + (string-append runtime-string "-" object "s-create.scm") + #~(begin + (use-modules (ice-9 format) + (ice-9 match) + (ice-9 popen) + (ice-9 rdelim) + (srfi srfi-1)) + + (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 (object-exists? name) + (if (string=? #$runtime-string "podman") + (let ((command + (list #$runtime-cli + #$object "exists" name))) + (when #$verbose? + (format #t "Running~{ ~a~}~%" command)) + (define exit-code (status:exit-val (apply system* command))) + (when #$verbose? + (format #t "Exit code: ~a~%" exit-code)) + (equal? EXIT_SUCCESS exit-code)) + (let ((command + (string-append #$runtime-cli + " " #$object " ls --format " + "\"{{.Name}}\""))) + (when #$verbose? + (format #t "Running ~a~%" command)) + (member name (read-lines (open-input-pipe command)))))) + + (for-each + (lambda (invokation) + (define name (last invokation)) + (if (object-exists? name) + (format #t "~a ~a ~a already exists, skipping creation.~%" + #$(oci-runtime-name runtime) name #$object) + (begin + (when #$verbose? + (format #t "Running~{ ~a~}~%" invokation)) + (let ((exit-code (status:exit-val (apply system* invokation)))) + (when #$verbose? + (format #t "Exit code: ~a~%" exit-code)))))) + (list #$@invokations))))) + +(define* (oci-object-shepherd-service object runtime runtime-cli name requirement invokations + #:key + (user #f) + (group #f) + (verbose? #f)) + "Return a Shepherd service object that will create the OBJECTs represented +by INVOKATIONS through RUNTIME-CLI." + (shepherd-service (provision `(,(string->symbol name))) + (requirement `(user-processes ,@requirement)) + (one-shot? #t) + (documentation + (string-append + (oci-runtime-name runtime) " " object + " provisioning service")) + (start + #~(lambda _ + (fork+exec-command + (list + #$(oci-object-create-script + object runtime runtime-cli + invokations + #:verbose? verbose?)) + #:user #$user + #:group + (if #$(eq? runtime 'podman) + (group:name + (getgrgid + (passwd:gid (getpwnam #$user)))) + #$group) + #$@(if (eq? runtime 'podman) + (list + #:environment-variables + #~(list + (string-append + "HOME=" (passwd:dir (getpwnam #$user))))) + '())))) + (actions + (list + (oci-object-command-shepherd-action + name (format-oci-invokations invokations)))))) + +(define* (oci-networks-shepherd-service runtime runtime-cli name networks + #:key + (user #f) + (group #f) + (runtime-requirement '()) + (default-requirement '(networking)) + (verbose? #f)) + "Return a Shepherd service object that will create the networks represented +in CONFIG." + (let ((invokations + (map + (lambda (network) + (oci-object-create-invokation + "network" runtime-cli + (oci-network-configuration-name network) + (oci-network-configuration->options network) + (oci-network-configuration-extra-arguments network))) + networks))) + + (oci-object-shepherd-service + "network" runtime runtime-cli name + (append default-requirement runtime-requirement) invokations + #:user user #:group group #:verbose? verbose?))) + +(define* (oci-volumes-shepherd-service runtime runtime-cli name volumes + #:key (user #f) (group #f) (verbose? #f) + (runtime-requirement '())) + "Return a Shepherd service object that will create the volumes represented +in CONFIG." + (let ((invokations + (map + (lambda (volume) + (oci-object-create-invokation + "volume" runtime-cli + (oci-volume-configuration-name volume) + (oci-volume-configuration->options volume) + (oci-volume-configuration-extra-arguments volume))) + volumes))) + + (oci-object-shepherd-service + "volume" runtime runtime-cli name runtime-requirement invokations + #:user user #:group group #:verbose? verbose?))) + +(define (oci-service-accounts config) + (define user (oci-configuration-user config)) + (define maybe-group (oci-configuration-group config)) + (define runtime (oci-configuration-runtime config)) (list (user-account - (name "oci-container") + (name user) (comment "OCI services account") - (group "docker") - (system? #t) - (home-directory "/var/empty") + (group "users") + (supplementary-groups + (list (oci-runtime-group runtime maybe-group))) + (system? (eq? 'docker runtime)) + (home-directory (if (eq? 'podman runtime) + (string-append "/home/" user) + "/var/empty")) + (create-home-directory? (eq? 'podman runtime)) (shell (file-append shadow "/sbin/nologin"))))) + +(define* (oci-state->shepherd-services runtime runtime-cli containers networks volumes + #:key (user #f) (group #f) (verbose? #f) + (networks-name #f) (volumes-name #f) + (runtime-requirement '()) + (networks-default-requirement '())) + (let* ((networks? + (> (length networks) 0)) + (networks-requirement + (if networks? + (list + (string->symbol + (oci-networks-shepherd-name runtime))) + '())) + (volumes? + (> (length volumes) 0)) + (volumes-requirement + (if volumes? + (list + (string->symbol + (oci-volumes-shepherd-name runtime))) + '()))) + (append + (map + (lambda (c) + (oci-container-shepherd-service + runtime runtime-cli c + #:user user + #:group group + #:oci-requirement + (append networks-requirement volumes-requirement) + #:verbose? verbose?)) + containers) + (if networks? + (list + (oci-networks-shepherd-service + runtime runtime-cli + (if (string? networks-name) + networks-name + (oci-networks-shepherd-name runtime)) + networks + #:user user #:group group + #:default-requirement networks-default-requirement + #:runtime-requirement runtime-requirement + #:verbose? verbose?)) + '()) + (if volumes? + (list + (oci-volumes-shepherd-service runtime runtime-cli + (if (string? volumes-name) + volumes-name + (oci-volumes-shepherd-name runtime)) + volumes + #:user user #:group group + #:runtime-requirement runtime-requirement + #:verbose? verbose?)) + '())))) + +(define (oci-configuration->shepherd-services config) + (let* ((runtime (oci-configuration-runtime config)) + (runtime-cli + (oci-runtime-system-cli config)) + (containers (oci-configuration-containers config)) + (networks (oci-configuration-networks config)) + (volumes (oci-configuration-volumes config)) + (user (oci-configuration-user config)) + (group (oci-runtime-group + runtime (oci-configuration-group config))) + (verbose? (oci-configuration-verbose? config))) + (oci-state->shepherd-services runtime runtime-cli containers networks volumes + #:user user #:group group #:verbose? verbose? + #:runtime-requirement + (oci-runtime-system-requirement runtime)))) + +(define (oci-service-subids config) + "Return a subids-extension record representing subuids and subgids required by +the rootless Podman backend." + (define (delete-duplicate-ranges ranges) + (delete-duplicates ranges + (lambda args + (apply string=? (map subid-range-name ranges))))) + (define runtime + (oci-configuration-runtime config)) + (define user + (oci-configuration-user config)) + (define subgids (oci-configuration-subgids-range config)) + (define subuids (oci-configuration-subuids-range config)) + (define container-users + (filter (lambda (range) (not (string=? (subid-range-name range) user))) + (map (lambda (container) + (subid-range + (name + (oci-container-configuration-user container)))) + (oci-configuration-containers config)))) + (define subgid-ranges + (delete-duplicate-ranges + (cons + (if (maybe-value-set? subgids) + subgids + (subid-range (name user))) + container-users))) + (define subuid-ranges + (delete-duplicate-ranges + (cons + (if (maybe-value-set? subuids) + subuids + (subid-range (name user))) + container-users))) + + (if (eq? 'podman runtime) + (subids-extension + (subgids + subgid-ranges) + (subuids + subuid-ranges)) + (subids-extension))) + +(define (oci-objects-merge-lst a b object get-name) + (define (contains? value lst) + (member value (map get-name lst))) + (let loop ((merged '()) + (lst (append a b))) + (if (null? lst) + merged + (loop + (let ((element (car lst))) + (when (contains? element merged) + (raise + (formatted-message + (G_ "Duplicated ~a: ~a. ~as names should be unique, please +remove the duplicate.") object (get-name element) object))) + (cons element merged)) + (cdr lst))))) + +(define (oci-extension-merge a b) + (oci-extension + (containers (oci-objects-merge-lst + (oci-extension-containers a) + (oci-extension-containers b) + "container" + (lambda (config) + (define maybe-name (oci-container-configuration-provision config)) + (if (maybe-value-set? maybe-name) + maybe-name + (oci-image->container-name + (oci-container-configuration-image config)))))) + (networks (oci-objects-merge-lst + (oci-extension-networks a) + (oci-extension-networks b) + "network" + oci-networks-shepherd-name)) + (volumes (oci-objects-merge-lst + (oci-extension-volumes a) + (oci-extension-volumes b) + "volume" + oci-volumes-shepherd-name)))) + +(define (oci-service-profile runtime runtime-cli) + (list bash-minimal + (cond + ((maybe-value-set? runtime-cli) + runtime-cli) + ((eq? 'podman runtime) + podman) + (else + docker-cli)))) + +(define oci-service-type + (service-type (name 'oci) + (extensions + (list + (service-extension profile-service-type + (lambda (config) + (let ((runtime-cli + (oci-configuration-runtime-cli config)) + (runtime + (oci-configuration-runtime config))) + (oci-service-profile runtime runtime-cli)))) + (service-extension subids-service-type + oci-service-subids) + (service-extension account-service-type + oci-service-accounts) + (service-extension shepherd-root-service-type + oci-configuration->shepherd-services))) + ;; Concatenate OCI object lists. + (compose (lambda (args) + (fold oci-extension-merge + (oci-extension) + args))) + (extend + (lambda (config extension) + (oci-configuration + (inherit config) + (containers + (oci-objects-merge-lst + (oci-configuration-containers config) + (oci-extension-containers extension) + "container" + (lambda (oci-config) + (define runtime + (oci-configuration-runtime config)) + (oci-container-shepherd-name runtime oci-config)))) + (networks (oci-objects-merge-lst + (oci-configuration-networks config) + (oci-extension-networks extension) + "network" + oci-networks-shepherd-name)) + (volumes (oci-objects-merge-lst + (oci-configuration-volumes config) + (oci-extension-volumes extension) + "volume" + oci-volumes-shepherd-name))))) + (default-value (oci-configuration)) + (description + "This service implements the provisioning of OCI object such +as containers, networks and volumes."))) diff --git a/gnu/services/docker.scm b/gnu/services/docker.scm index 69ff9f1d9e4..98ee175873d 100644 --- a/gnu/services/docker.scm +++ b/gnu/services/docker.scm @@ -31,7 +31,10 @@ (define-module (gnu services docker) #:use-module (gnu system shadow) #:use-module (gnu packages docker) #:use-module (gnu packages linux) ;singularity + #:use-module (guix deprecation) + #:use-module (guix diagnostics) #:use-module (guix gexp) + #:use-module (guix i18n) #:use-module (guix records) #:use-module (srfi srfi-1) #:use-module (ice-9 format) @@ -67,16 +70,18 @@ (define-module (gnu services docker) 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) + oci-container-configuration-extra-arguments) #:export (containerd-configuration containerd-service-type docker-configuration docker-service-type singularity-service-type - oci-container-service-type)) + ;; for backwards compatibility, until the + ;; oci-container-service-type is fully deprecated + oci-container-shepherd-service + oci-container-service-type + %oci-container-accounts)) (define-maybe file-like) @@ -295,17 +300,25 @@ (define singularity-service-type ;;; OCI container. ;;; -(define (configs->shepherd-services configs) - (map oci-container-shepherd-service configs)) +;; for backwards compatibility, until the +;; oci-container-service-type is fully deprecated +(define-deprecated (oci-container-shepherd-service config) + oci-service-type + ((@ (gnu services containers) oci-container-shepherd-service) + 'docker config)) +(define %oci-container-accounts + (filter user-account? (oci-service-accounts (oci-configuration)))) (define oci-container-service-type (service-type (name 'oci-container) - (extensions (list (service-extension profile-service-type - (lambda _ (list docker-cli))) - (service-extension account-service-type - (const %oci-container-accounts)) - (service-extension shepherd-root-service-type - configs->shepherd-services))) + (extensions + (list (service-extension oci-service-type + (lambda (containers) + (warning + (G_ + "'oci-container-service-type' is deprecated, use 'oci-service-type' instead~%")) + (oci-extension + (containers containers)))))) (default-value '()) (extend append) (compose concatenate) diff --git a/gnu/tests/containers.scm b/gnu/tests/containers.scm index 0ecc8ddb126..719647c298e 100644 --- a/gnu/tests/containers.scm +++ b/gnu/tests/containers.scm @@ -27,6 +27,9 @@ (define-module (gnu tests containers) #: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 @@ (define-module (gnu tests containers) #: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 @@ -345,3 +350,952 @@ (define %test-rootless-podman (name "rootless-podman") (description "Test rootless Podman service.") (value (build-tarball&run-rootless-podman-test)))) + + +(define %guile-oci-image + (oci-image + (repository "guile") + (value + (specifications->manifest '("guile"))) + (pack-options + '(#:symlinks (("/bin" -> "bin")))))) + +(define %oci-test-containers + (list + (oci-container-configuration + (provision "first") + (image %guile-oci-image) + (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 %guile-oci-image) + (entrypoint "/bin/guile") + (network "my-network") + (command + '("-c" "(let l ((c 300))(display c)(sleep 1)(when(positive? c)(l (- c 1))))")) + (volumes + '(("my-volume" . "/my-volume") + ("/shared.txt" . "/shared.txt:ro")))))) + +(define %oci-extension-test + (oci-extension + (networks + (list (oci-network-configuration (name "my-network")))) + (volumes + (list (oci-volume-configuration (name "my-volume")))) + (containers %oci-test-containers))) + +(define %oci-rootless-podman-os + (simple-operating-system + (service dhcp-client-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-test))) + +(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 services herd) + (guix combinators)))) + + (define vm + (virtual-machine + (operating-system os) + (volatile? #f) + (memory-size 1024) + (disk-image-size (* 3000 (expt 2 20))) + (port-forwardings '()))) + + (define test + (with-imported-modules '((gnu build marionette)) + #~(begin + (use-modules (srfi srfi-11) (srfi srfi-64) + (gnu build marionette)) + + (define marionette + ;; Relax timeout to accommodate older systems and + ;; allow for pulling the image. + (make-marionette (list #$vm) #:timeout 60)) + (define out-dir "/tmp") + + (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 "rootless-podman services started successfully" + (begin + (define (run-test) + (marionette-eval + `(begin + (use-modules (ice-9 popen) + (ice-9 match) + (ice-9 rdelim)) + + (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 slurp + (lambda args + (let* ((port (apply open-pipe* OPEN_READ args)) + (output (read-lines port)) + (status (close-pipe port))) + output))) + (let* ((bash + ,(string-append #$bash "/bin/bash")) + (response1 + (slurp bash "-c" + (string-append "ls -la /sys/fs/cgroup | " + "grep -E ' \\./?$' | awk '{ print $4 }'"))) + (response2 (slurp bash "-c" + (string-append "ls -l /sys/fs/cgroup/cgroup" + ".{procs,subtree_control,threads} | " + "awk '{ print $4 }' | sort -u")))) + (list (string-join response1 "\n") (string-join response2 "\n")))) + marionette)) + ;; Allow services to come up on slower machines + (let loop ((attempts 0)) + (if (= attempts 60) + (error "Services didn't come up after more than 60 seconds") + (if (equal? '("cgroup" "cgroup") + (run-test)) + #t + (begin + (sleep 1) + (format #t "Services didn't come up yet, retrying with attempt ~a~%" + (+ 1 attempts)) + (loop (+ 1 attempts)))))))) + + (test-assert "podman-volumes running" + (begin + (define (run-test) + (marionette-eval + `(begin + (use-modules (srfi srfi-1) + (ice-9 popen) + (ice-9 match) + (ice-9 rdelim)) + + (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 (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 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))) + + (match (primitive-fork) + (0 + (dynamic-wind + (const #f) + (lambda () + (setgid (passwd:gid (getpwnam "oci-container"))) + (setuid (passwd:uid (getpw "oci-container"))) + + (let ((response (slurp + "/run/current-system/profile/bin/podman" + "volume" "ls" "-n" "--format" "\"{{.Name}}\"" + "|" "tr" "' '" "'\n'"))) + + (call-with-output-file (string-append ,out-dir "/response") + (lambda (port) + (display (string-join response "\n") port))))) + (lambda () + (primitive-exit 127)))) + (pid + (cdr (waitpid pid)))) + + (wait-for-file (string-append ,out-dir "/response")) + + (stable-sort + (slurp "cat" (string-append ,out-dir "/response")) + string<=?)) + marionette)) + ;; Allow services to come up on slower machines + (let loop ((attempts 0)) + (if (= attempts 80) + (error "Service didn't come up after more than 80 seconds") + (if (equal? '("my-volume") + (run-test)) + #t + (begin + (sleep 1) + (loop (+ 1 attempts)))))))) + + (test-assert "podman-networks running" + (begin + (define (run-test) + (marionette-eval + `(begin + (use-modules (srfi srfi-1) + (ice-9 popen) + (ice-9 match) + (ice-9 rdelim)) + + (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 (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 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))) + + (match (primitive-fork) + (0 + (dynamic-wind + (const #f) + (lambda () + (setgid (passwd:gid (getpwnam "oci-container"))) + (setuid (passwd:uid (getpw "oci-container"))) + + (let ((response (slurp + "/run/current-system/profile/bin/podman" + "network" "ls" "-n" "--format" "\"{{.Name}}\"" + "|" "tr" "' '" "'\n'"))) + + (call-with-output-file (string-append ,out-dir "/response") + (lambda (port) + (display (string-join response "\n") port))))) + (lambda () + (primitive-exit 127)))) + (pid + (cdr (waitpid pid)))) + + (wait-for-file (string-append ,out-dir "/response")) + + (stable-sort + (slurp "cat" (string-append ,out-dir "/response")) + string<=?)) + marionette)) + ;; Allow services to come up on slower machines + (let loop ((attempts 0)) + (if (= attempts 80) + (error "Service didn't come up after more than 80 seconds") + (if (equal? '("my-network" "podman") + (run-test)) + #t + (begin + (sleep 1) + (loop (+ 1 attempts)))))))) + + (test-assert "first container running" + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (wait-for-service 'first #:timeout 120) + #t) + marionette)) + + (test-assert "second container running" + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (wait-for-service 'second #:timeout 120) + #t) + marionette)) + + (test-assert "passing host environment variables" + (begin + (define (run-test) + (marionette-eval + `(begin + (use-modules (srfi srfi-1) + (ice-9 popen) + (ice-9 match) + (ice-9 rdelim)) + + (define (wait-for-file file) + ;; Wait until FILE shows up. + (let loop ((i 60)) + (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 (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 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))) + + (match (primitive-fork) + (0 + (dynamic-wind + (const #f) + (lambda () + (setgid (passwd:gid (getpwnam "oci-container"))) + (setuid (passwd:uid (getpw "oci-container"))) + + (let ((response (slurp + "/run/current-system/profile/bin/podman" + "exec" "first" + "/bin/guile" "-c" "'(display (getenv \"VARIABLE\"))'"))) + (call-with-output-file (string-append ,out-dir "/response") + (lambda (port) + (display (string-join response "\n") port))))) + (lambda () + (primitive-exit 127)))) + (pid + (cdr (waitpid pid)))) + + (wait-for-file (string-append ,out-dir "/response")) + (slurp "cat" (string-append ,out-dir "/response"))) + marionette)) + ;; Allow image to be loaded on slower machines + (let loop ((attempts 0)) + (if (= attempts 180) + (error "Service didn't come up after more than 180 seconds") + (if (equal? (list "value") + (run-test)) + #t + (begin + (sleep 1) + (loop (+ 1 attempts)))))))) + + (test-equal "mounting host files" + '("hello") + (marionette-eval + `(begin + (use-modules (srfi srfi-1) + (ice-9 popen) + (ice-9 match) + (ice-9 rdelim)) + + (define (wait-for-file file) + ;; Wait until FILE shows up. + (let loop ((i 60)) + (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 (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 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))) + + (match (primitive-fork) + (0 + (dynamic-wind + (const #f) + (lambda () + (setgid (passwd:gid (getpwnam "oci-container"))) + (setuid (passwd:uid (getpw "oci-container"))) + + (let ((response (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)))'"))) + (call-with-output-file (string-append ,out-dir "/response") + (lambda (port) + (display (string-join response " ") port))))) + (lambda () + (primitive-exit 127)))) + (pid + (cdr (waitpid pid)))) + + (wait-for-file (string-append ,out-dir "/response")) + (slurp "cat" (string-append ,out-dir "/response"))) + marionette)) + + (test-equal "write to volumes" + '("world") + (marionette-eval + `(begin + (use-modules (srfi srfi-1) + (ice-9 popen) + (ice-9 match) + (ice-9 rdelim)) + + (define (wait-for-file file) + ;; Wait until FILE shows up. + (let loop ((i 60)) + (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 (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 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))) + + (match (primitive-fork) + (0 + (dynamic-wind + (const #f) + (lambda () + (setgid (passwd:gid (getpwnam "oci-container"))) + (setuid (passwd:uid (getpw "oci-container"))) + + (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))))'") + + (let ((response (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)))'"))) + (call-with-output-file (string-append ,out-dir "/response") + (lambda (port) + (display (string-join response " ") port))))) + (lambda () + (primitive-exit 127)))) + (pid + (cdr (waitpid pid)))) + + (wait-for-file (string-append ,out-dir "/response")) + (slurp "cat" (string-append ,out-dir "/response"))) + marionette)) + + (test-equal "can read ports over network" + '("out of office") + (marionette-eval + `(begin + (use-modules (srfi srfi-1) + (ice-9 popen) + (ice-9 match) + (ice-9 rdelim)) + + (define (wait-for-file file) + ;; Wait until FILE shows up. + (let loop ((i 60)) + (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 (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 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))) + + (match (primitive-fork) + (0 + (dynamic-wind + (const #f) + (lambda () + (setgid (passwd:gid (getpwnam "oci-container"))) + (setuid (passwd:uid (getpw "oci-container"))) + + (let ((response (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))'"))) + (call-with-output-file (string-append ,out-dir "/response") + (lambda (port) + (display (string-join response " ") port))))) + (lambda () + (primitive-exit 127)))) + (pid + (cdr (waitpid pid)))) + + (wait-for-file (string-append ,out-dir "/response")) + (slurp "cat" (string-append ,out-dir "/response"))) + 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-os + (simple-operating-system + (service dhcp-client-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-test))) + +(define (run-docker-oci-service-test) + (define os + (marionette-operating-system + (operating-system-with-gc-roots + %oci-docker-os + (list)) + #:imported-modules '((gnu services herd) + (guix combinators)))) + + (define vm + (virtual-machine + (operating-system os) + (volatile? #f) + (memory-size 1024) + (disk-image-size (* 3000 (expt 2 20))) + (port-forwardings '()))) + + (define test + (with-imported-modules '((gnu build marionette)) + #~(begin + (use-modules (srfi srfi-11) (srfi srfi-64) + (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) + (marionette-eval + `(begin + (use-modules (ice-9 popen) + (ice-9 rdelim)) + + (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 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))) + + (stable-sort + (slurp + "/run/current-system/profile/bin/docker" + "volume" "ls" "--format" "\"{{.Name}}\"") + string<=?)) + + marionette)) + ;; Allow services to come up on slower machines + (let loop ((attempts 0)) + (if (= attempts 80) + (error "Service didn't come up after more than 80 seconds") + (if (equal? '("my-volume") + (run-test)) + #t + (begin + (sleep 1) + (loop (+ 1 attempts)))))))) + + (test-assert "docker-networks running" + (begin + (define (run-test) + (marionette-eval + `(begin + (use-modules (ice-9 popen) + (ice-9 rdelim)) + + (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 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))) + + (stable-sort + (slurp + "/run/current-system/profile/bin/docker" + "network" "ls" "--format" "\"{{.Name}}\"") + string<=?)) + + marionette)) + ;; Allow services to come up on slower machines + (let loop ((attempts 0)) + (if (= attempts 80) + (error "Service didn't come up after more than 80 seconds") + (if (equal? '("bridge" "host" "my-network" "none") + (run-test)) + #t + (begin + (sleep 1) + (loop (+ 1 attempts)))))))) + + (test-assert "first container running" + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (wait-for-service 'first #:timeout 120) + #t) + marionette)) + + (test-assert "second container running" + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (wait-for-service 'second #:timeout 120) + #t) + marionette)) + + (test-assert "passing host environment variables" + (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))) + + (slurp + "/run/current-system/profile/bin/docker" + "exec" "first" + "/bin/guile" "-c" "(display (getenv \"VARIABLE\"))")) + marionette)) + ;; Allow image to be loaded on slower machines + (let loop ((attempts 0)) + (if (= attempts 180) + (error "Service didn't come up after more than 180 seconds") + (if (equal? "value" + (run-test)) + #t + (begin + (sleep 1) + (loop (+ 1 attempts)))))))) + + (test-equal "mounting host files" + "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))) + + (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 \"/shared.txt\" read-line)))")) + marionette)) + + (test-equal "write to volumes" + "world" + (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))) + + (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 ports over network" + "out of office" + (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))) + + (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)))) -- 2.48.1 From unknown Fri Jun 13 11:55:10 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#76081] [PATCH 2/4] services: oci-container-configuration: Move to (gnu services containers). Resent-From: Giacomo Leidi Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Wed, 05 Feb 2025 22:04:03 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 76081 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 76081@debbugs.gnu.org Cc: Giacomo Leidi Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.173879300314868 (code B ref 76081); Wed, 05 Feb 2025 22:04:03 +0000 Received: (at 76081) by debbugs.gnu.org; 5 Feb 2025 22:03:23 +0000 Received: from localhost ([127.0.0.1]:53030 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tfnUO-0003ri-K3 for submit@debbugs.gnu.org; Wed, 05 Feb 2025 17:03:23 -0500 Received: from confino.investici.org ([2a11:7980:1::2:0]:25221) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1tfnUG-0003qp-Vp for 76081@debbugs.gnu.org; Wed, 05 Feb 2025 17:03:16 -0500 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org; s=stigmate; t=1738792990; bh=C6uHhY9S9WpgPkIaaAgAOz8vooJK2RfngRRsEihvD9o=; h=From:To:Cc:Subject:Date:In-Reply-To:References:From; b=mCb7fsmCuTThphUNjdAVAKxzVf6SW7ThY1U6WGIDC+B632QS3NfNrnAvL03sHt+Sg CWBMPQrO7OVlwLm20jId/OLeu1qEqytsDxN2vwZJsKSrP/EAKLmDPo4b0bZfIswKup /YwTBRWmmzJophH6632Bd6nKqj9Fka4iDfo5KQJQ= Received: from mx1.investici.org (unknown [127.0.0.1]) by confino.investici.org (Postfix) with ESMTP id 4YpDkk1HPPz112w; Wed, 5 Feb 2025 22:03:10 +0000 (UTC) Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19]) (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with ESMTPSA id 4YpDkj751mz1156; Wed, 5 Feb 2025 22:03:09 +0000 (UTC) From: Giacomo Leidi Date: Wed, 5 Feb 2025 23:02:29 +0100 Message-ID: <92f19ba6c0842885735dfce653eef535360085f4.1738792951.git.goodoldpaul@autistici.org> X-Mailer: git-send-email 2.48.1 In-Reply-To: <89778533f32ad1388f03414e884fff10f74ef379.1738792951.git.goodoldpaul@autistici.org> References: <89778533f32ad1388f03414e884fff10f74ef379.1738792951.git.goodoldpaul@autistici.org> MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit X-Spam-Score: -0.0 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) 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 dc66ac4f967..50bf6c05549 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 +;;; Copyright © 2024, 2025 Giacomo Leidi ;;; ;;; This file is part of GNU Guix. ;;; @@ -17,19 +17,31 @@ ;;; along with GNU Guix. If not, see . (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) @@ -188,7 +237,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 @@ -242,3 +291,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 3af0f792701..69ff9f1d9e4 100644 --- a/gnu/services/docker.scm +++ b/gnu/services/docker.scm @@ -5,7 +5,7 @@ ;;; Copyright © 2020 Efraim Flashner ;;; Copyright © 2020 Jesse Dowell ;;; Copyright © 2021 Brice Waegeneire -;;; Copyright © 2023, 2024 Giacomo Leidi +;;; Copyright © 2023, 2024, 2025 Giacomo Leidi ;;; ;;; This file is part of GNU Guix. ;;; @@ -23,72 +23,60 @@ ;;; along with GNU Guix. If not, see . (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) @@ -307,495 +295,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} 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"))))) - (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 ;;; Copyright © 2019-2023 Ludovic Courtès -;;; Copyright © 2024 Giacomo Leidi +;;; Copyright © 2024, 2025 Giacomo Leidi ;;; ;;; 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 From unknown Fri Jun 13 11:55:10 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#76081] OCI provisioning service References: <2f43e635-508c-407a-8309-06e75d492d89@autistici.org> In-Reply-To: <2f43e635-508c-407a-8309-06e75d492d89@autistici.org> Resent-From: paul Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sun, 09 Feb 2025 19:15:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 76081 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 76081@debbugs.gnu.org Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.173912848110815 (code B ref 76081); Sun, 09 Feb 2025 19:15:02 +0000 Received: (at 76081) by debbugs.gnu.org; 9 Feb 2025 19:14:41 +0000 Received: from localhost ([127.0.0.1]:46320 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1thClM-0002oN-Rs for submit@debbugs.gnu.org; Sun, 09 Feb 2025 14:14:41 -0500 Received: from confino.investici.org ([2a11:7980:1::2:0]:47541) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1thClJ-0002o5-SP for 76081@debbugs.gnu.org; Sun, 09 Feb 2025 14:14:39 -0500 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org; s=stigmate; t=1739128474; bh=obw0w5hG5W64ht/JHyDk9qs/lqcbkWyMrEDV3XOZL/E=; h=Date:To:From:Subject:From; b=KUbt4bJFDGi8YHDtMEKpc4lo3QfNu87PqnHS3Ab4DnBhe3bXZ96LFCShSS/Ek7dwn wRLe2EggaMDHU8n6S28XhaHivxiJ5yraOgu7dXK+pXihtRCqgrBBQs1shPo8MlKS6p bJj20VCTjztzf4N77w9pqEnKl9jkqPCZ/IK8UABk= Received: from mx1.investici.org (unknown [127.0.0.1]) by confino.investici.org (Postfix) with ESMTP id 4YrcpL0l6Zz11Df for <76081@debbugs.gnu.org>; Sun, 9 Feb 2025 19:14:34 +0000 (UTC) Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19]) (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with ESMTPSA id 4YrcpL03Qcz11Cp for <76081@debbugs.gnu.org>; Sun, 9 Feb 2025 19:14:33 +0000 (UTC) Message-ID: Date: Sun, 9 Feb 2025 20:14:33 +0100 MIME-Version: 1.0 User-Agent: Icedove Daily Content-Language: en-US From: paul Content-Type: text/plain; charset=UTF-8; format=flowed Content-Transfer-Encoding: 7bit X-Spam-Score: -0.0 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) Hi, I'm about to send a v2. v2 compared to the first revision features: - it actually compiles all the times :) (rev 1 referenced oci-image too early for it to be working and generated a compile time error, if you recompiled it sometimes went away so I thought it was a problem of my setup. CI caught this) - it allows more values to be overridden by eventual users of the Scheme API - it allows passing extra arguments directly after each podman or docker invokation, allowing for example for overriding podman --root and similar options. All of these tests should pass: guix shell -D guix -CPW -- make check-system TESTS="oci-container oci-service-rootless-podman docker docker-system rootless-podman oci-service-docker" Thank you for your work, giacomo From unknown Fri Jun 13 11:55:10 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#76081] [PATCH v2 1/4] services: rootless-podman: Use login shell. References: <2f43e635-508c-407a-8309-06e75d492d89@autistici.org> In-Reply-To: <2f43e635-508c-407a-8309-06e75d492d89@autistici.org> Resent-From: Giacomo Leidi Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sun, 09 Feb 2025 19:16:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 76081 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 76081@debbugs.gnu.org Cc: Giacomo Leidi Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.173912854111320 (code B ref 76081); Sun, 09 Feb 2025 19:16:01 +0000 Received: (at 76081) by debbugs.gnu.org; 9 Feb 2025 19:15:41 +0000 Received: from localhost ([127.0.0.1]:46329 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1thCmJ-0002wL-Ho for submit@debbugs.gnu.org; Sun, 09 Feb 2025 14:15:41 -0500 Received: from confino.investici.org ([2a11:7980:1::2:0]:45329) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1thCmH-0002w6-T3 for 76081@debbugs.gnu.org; Sun, 09 Feb 2025 14:15:38 -0500 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org; s=stigmate; t=1739128536; bh=IdX9voWndJaRYrFOGe4a/X2LYvkwV0vTWt7K16N+Iog=; h=From:To:Cc:Subject:Date:From; b=RxFnfHFOQJAVXzlot9YMq9wkovxQshhnbb8Wcd2YjbkVYPELa0MldQJLF8YXuN+3E gxgqFxqVfIYm5kh7GAjVNFZ2wmNcM+IOlEQ46tz9pcnxCFTEOP8AFfPnGYVFdMzQ6+ 7RMHgESzyaBBw2xgswtIhFkhWXGnaz4rp3b/I6nk= Received: from mx1.investici.org (unknown [127.0.0.1]) by confino.investici.org (Postfix) with ESMTP id 4YrcqX6bJBz11Cp; Sun, 9 Feb 2025 19:15:36 +0000 (UTC) Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19]) (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with ESMTPSA id 4YrcqX5YJHz11F7; Sun, 9 Feb 2025 19:15:36 +0000 (UTC) From: Giacomo Leidi Date: Sun, 9 Feb 2025 20:15:01 +0100 Message-ID: <89778533f32ad1388f03414e884fff10f74ef379.1739128504.git.goodoldpaul@autistici.org> X-Mailer: git-send-email 2.48.1 MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Spam-Score: -0.0 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) This commit allows for having PATH set when changing the owner of /sys/fs/group. * gnu/services/containers.scm (crgroups-fs-owner): Use login shell. Change-Id: I9510c637a5332325e05ca5ebc9dfd4de32685c50 --- gnu/services/containers.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm index 19d35ccbcb6..dc66ac4f967 100644 --- a/gnu/services/containers.scm +++ b/gnu/services/containers.scm @@ -140,7 +140,7 @@ (define (cgroups-fs-owner-entrypoint config) (rootless-podman-configuration-group-name config)) (program-file "cgroups2-fs-owner-entrypoint" #~(system* - (string-append #+bash-minimal "/bin/bash") "-c" + (string-append #+bash-minimal "/bin/bash") "-l" "-c" (string-append "echo Setting /sys/fs/cgroup " "group ownership to " #$group " && chown -v " "root:" #$group " /sys/fs/cgroup && " base-commit: 5a897c5c95a81278b044c18d962d3bd83131ba06 -- 2.48.1 From unknown Fri Jun 13 11:55:10 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#76081] [PATCH v2 3/4] services: Add oci-service-type. Resent-From: Giacomo Leidi Original-Sender: "Debbugs-submit" Resent-CC: ludo@gnu.org, maxim.cournoyer@gmail.com, guix-patches@gnu.org Resent-Date: Sun, 09 Feb 2025 19:16:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 76081 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 76081@debbugs.gnu.org Cc: Giacomo Leidi , Ludovic =?UTF-8?Q?Court=C3=A8s?= , Maxim Cournoyer X-Debbugs-Original-Xcc: Ludovic =?UTF-8?Q?Court=C3=A8s?= , Maxim Cournoyer Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.173912854311335 (code B ref 76081); Sun, 09 Feb 2025 19:16:02 +0000 Received: (at 76081) by debbugs.gnu.org; 9 Feb 2025 19:15:43 +0000 Received: from localhost ([127.0.0.1]:46331 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1thCmN-0002wk-5f for submit@debbugs.gnu.org; Sun, 09 Feb 2025 14:15:43 -0500 Received: from confino.investici.org ([2a11:7980:1::2:0]:28977) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1thCmI-0002wB-Uq for 76081@debbugs.gnu.org; Sun, 09 Feb 2025 14:15:39 -0500 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org; s=stigmate; t=1739128537; bh=yzEAg3727KejHWShjEPKh27mqDTLvagvfAZQ5/oMQRM=; h=From:To:Cc:Subject:Date:In-Reply-To:References:From; b=HEhnPfHPfHhjVMqObh2JTwscsKI1bPBBSh7j6qC6FRBJDAK8KLkYb6JPhvosvton5 teTOlkee9SDj2TRNbqvZj2k/zzPWEq42f1zoze3/clNXnjxLC6vuuq08iqA0Io6evM EeTmFACn9/2AejKkhD9PHh47ElDlRxrtrD9VhgEo= Received: from mx1.investici.org (unknown [127.0.0.1]) by confino.investici.org (Postfix) with ESMTP id 4YrcqY5Y7wz11FL; Sun, 9 Feb 2025 19:15:37 +0000 (UTC) Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19]) (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with ESMTPSA id 4YrcqY4D8qz11F7; Sun, 9 Feb 2025 19:15:37 +0000 (UTC) From: Giacomo Leidi Date: Sun, 9 Feb 2025 20:15:03 +0100 Message-ID: X-Mailer: git-send-email 2.48.1 In-Reply-To: <89778533f32ad1388f03414e884fff10f74ef379.1739128504.git.goodoldpaul@autistici.org> References: <89778533f32ad1388f03414e884fff10f74ef379.1739128504.git.goodoldpaul@autistici.org> MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" 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/services/containers.scm (%oci-supported-runtimes): New variable; (oci-runtime-cli): new variable; (oci-runtime-name): new variable; (oci-network-configuration): new variable; (oci-volume-configuration): new variable; (oci-configuration): new variable; (oci-extension): new variable; (oci-networks-shepherd-name): new variable; (oci-service-type): new variable; (oci-state->shepherd-services): new variable. * doc/guix.texi: Document it. * gnu/tests/containers.scm: Test it. * gnu/services/docker.scm: Deprecate the oci-container-service-type. Change-Id: I656b3db85832e42d53072fcbfb91d1226f39ef38 --- doc/guix.texi | 299 ++++++++-- gnu/services/containers.scm | 1086 +++++++++++++++++++++++++++++++---- gnu/services/docker.scm | 37 +- gnu/tests/containers.scm | 999 +++++++++++++++++++++++++++++++- 4 files changed, 2225 insertions(+), 196 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index bb5f29277fb..8f66b35297b 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -41778,59 +41778,159 @@ Miscellaneous Services @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: given an -@acronym{Open Container Initiative, OCI} container image, it will run it in a +Should you wish to manage your @acronym{Open Container Initiative, OCI} containers +with the same consistent interface you use for your other Shepherd services, +@var{oci-service-type} is the tool to use: given an +OCI container image, it will run it in a Shepherd service. One example where this is useful: it lets you run services -that are available as Docker/OCI images but not yet packaged for Guix. +that are available as OCI images but not yet packaged for Guix. -@defvar oci-container-service-type +@defvar oci-service-type -This is a thin wrapper around Docker's CLI that executes OCI images backed +This is a thin wrapper around Docker's or Podman's CLI that executes OCI images backed processes as Shepherd Services. @lisp -(service oci-container-service-type - (list - (oci-container-configuration - (network "host") - (image - (oci-image - (repository "guile") - (tag "3") - (value (specifications->manifest '("guile"))) - (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile")) - #:max-layers 2)))) - (entrypoint "/bin/guile") - (command - '("-c" "(display \"hello!\n\")"))) - (oci-container-configuration - (image "prom/prometheus") - (ports - '(("9000" . "9000") - ("9090" . "9090")))) - (oci-container-configuration - (image "grafana/grafana:10.0.1") - (network "host") - (volumes - '("/var/lib/grafana:/var/lib/grafana"))))) +(simple-service 'oci-provisioning + oci-service-type + (oci-extension + (networks + (list + (oci-network-configuration (name "monitoring")))) + (containers + (list + (oci-container-configuration + (network "monitoring") + (image + (oci-image + (repository "guile") + (tag "3") + (value (specifications->manifest '("guile"))) + (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile")) + #:max-layers 2)))) + (entrypoint "/bin/guile") + (command + '("-c" "(display \"hello!\n\")"))) + (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 In this example three different Shepherd services are going to be added to the system. Each @code{oci-container-configuration} record translates to a -@code{docker run} invocation and its fields directly map to options. You can -refer to the -@url{https://docs.docker.com/engine/reference/commandline/run,upstream} -documentation for the semantics of each value. If the images are not found, -they will be -@url{https://docs.docker.com/engine/reference/commandline/pull/,pulled}. The +@command{docker run} or @command{podman run} invocation and its fields directly +map to options. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html,Podman} +upstream documentation for semantics of each value. If the images are not found, +they will be pulled. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/pull/,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-pull.1.html,Podman} +upstream documentation for semantics. The services with @code{(network "host")} are going to be attached to the host network and are supposed to behave like native processes with regard to networking. @end defvar +@c %start of fragment + +@deftp {Data Type} oci-configuration +Available @code{oci-configuration} fields are: + +@table @asis +@item @code{runtime} (default: @code{'docker}) (type: symbol) +The OCI runtime to use to run commands. It can be either @code{'docker} or +@code{'podman}. + +@item @code{runtime-cli} (type: maybe-package) +The OCI runtime command line to be installed in the system profile and used +to provision OCI resources. When unset it will default to @code{docker-cli} +package for the @code{'docker} runtime or to @code{podman} package for the +@code{'podman} runtime. + +@item @code{runtime-extra-arguments} (default: @code{'()}) (type: list) +A list of strings, gexps or file-like objects that will be placed +after each @command{docker} or @command{podman} invokation. + +@item @code{user} (default: @code{"oci-container"}) (type: string) +The user name under whose authority OCI commands will be run. + +@item @code{group} (default: @code{"docker"}) (type: string) +The group name under whose authority OCI commands will be run. When +using the @code{'podman} OCI runtime, this field will be ignored and the +default group of the user configured in the @code{user} field will be used. + +@item @code{subuids-range} (type: maybe-subid-range) +An optional @code{subid-range} record allocating subuids for the user from +the @code{user} field. When unset, with the rootless Podman OCI runtime, it +defaults to @code{(subid-range (name "oci-container"))}. + +@item @code{subgids-range} (type: maybe-subid-range) +An optional @code{subid-range} record allocating subgids for the user from +the @code{user} field. When unset, with the rootless Podman OCI runtime, it +defaults to @code{(subid-range (name "oci-container"))}. + +@item @code{containers} (default: @code{'()}) (type: list-of-oci-containers) +The list of @code{oci-container-configuration} records representing the +containers to provision. Most users are supposed not to use this field and use +the @code{oci-extension} record instead. + +@item @code{networks} (default: @code{'()}) (type: list-of-oci-networks) +The list of @code{oci-network-configuration} records representing the +containers to provision. Most users are supposed not to use this field and use +the @code{oci-extension} record instead. + +@item @code{volumes} (default: @code{'()}) (type: list-of-oci-volumes) +The list of @code{oci-volumes-configuration} records representing the +containers to provision. Most users are supposed not to use this field and use +the @code{oci-extension} record instead. + +@item @code{verbose?} (default: @code{#f}) (type: boolean) +When true, additional output will be printed, allowing to better follow the +flow of execution. + +@end table + +@end deftp + + +@c %end of fragment + +@c %start of fragment + +@deftp {Data Type} oci-extension +Available @code{oci-extension} fields are: + +@table @asis +@item @code{containers} (default: @code{'()}) (type: list-of-oci-containers) +The list of @code{oci-container-configuration} records representing the +containers to provision. + +@item @code{networks} (default: @code{'()}) (type: list-of-oci-networks) +The list of @code{oci-network-configuration} records representing the +containers to provision. + +@item @code{volumes} (default: @code{'()}) (type: list-of-oci-volumes) +The list of @code{oci-volumes-configuration} records representing the +containers to provision. + +@end table + +@end deftp + + +@c %end of fragment + + @c %start of fragment @deftp {Data Type} oci-container-configuration @@ -41850,16 +41950,16 @@ Miscellaneous Services Overwrite the default entrypoint (@code{ENTRYPOINT}) of the image. @item @code{host-environment} (default: @code{'()}) (type: 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 +Set environment variables in the host environment where @command{docker run} +or @command{podman run} are invoked. This is especially useful to pass secrets +from the host to the container without having them on the OCI runtime command line, +for example: by setting the @code{MYSQL_PASSWORD} on the host and by passing @code{--env MYSQL_PASSWORD} through the @code{extra-arguments} field, it is possible to securely set values in the container environment. This field's value can be a list of pairs or strings, even mixed: @lisp -(list '("LANGUAGE\" . "eo:ca:eu") +(list '("LANGUAGE" . "eo:ca:eu") "JAVA_HOME=/opt/java") @end lisp @@ -41867,22 +41967,24 @@ Miscellaneous Services directly to @code{make-forkexec-constructor}. @item @code{environment} (default: @code{'()}) (type: list) -Set environment variables. This can be a list of pairs or strings, even mixed: +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 -@uref{https://docs.docker.com/engine/reference/commandline/run/#env,upstream} -documentation for semantics. +Pair members can be strings, gexps or file-like objects. Strings are passed +directly to the OCI runtime CLI. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run/#env,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#env-e-env,Podman} +upstream documentation for semantics. @item @code{image} (type: 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{oci-image} record. Strings are resolved by the OCI runtime, +and follow the usual format @code{myregistry.local:5000/testing/test-image:tag}. @item @code{provision} (default: @code{""}) (type: string) @@ -41910,7 +42012,7 @@ Miscellaneous Services by the service. @item @code{network} (default: @code{""}) (type: string) -Set a Docker network for the spawned container. +Set an OCI 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 @@ -41921,10 +42023,11 @@ Miscellaneous Services "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 -@uref{https://docs.docker.com/engine/reference/commandline/run/#publish,upstream} -documentation for semantics. +Pair members can be strings, gexps or file-like objects. Strings are passed +directly to the OCI runtime CLI. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run/#publish,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#publish-p-ip-hostport-containerport-protocol,Podman} +upstream documentation for semantics. @item @code{volumes} (default: @code{'()}) (type: list) Set volume mappings for the spawned container. This can be a @@ -41935,25 +42038,95 @@ Miscellaneous Services "/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 -@uref{https://docs.docker.com/engine/reference/commandline/run/#volume,upstream} -documentation for semantics. +Pair members can be strings, gexps or file-like objects. Strings are passed +directly to the OCI runtime CLI. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run/#volume,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#volume-v-source-volume-host-dir-container-dir-options,Podman} +upstream documentation for semantics. @item @code{container-user} (default: @code{""}) (type: 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. +@url{https://docs.docker.com/engine/reference/run/#user,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#user-u-user-group,Podman} +upstream documentation for semantics. @item @code{workdir} (default: @code{""}) (type: string) Set the current working directory for the spawned Shepherd service. You can refer to the -@url{https://docs.docker.com/engine/reference/run/#workdir,upstream} -documentation for semantics. +@url{https://docs.docker.com/engine/reference/run/#workdir,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#workdir-w-dir,Podman} +upstream documentation for semantics. + +@item @code{extra-arguments} (default: @code{'()}) (type: list) +A list of strings, gexps or file-like objects that will be directly passed +to the @command{docker run} or @command{podman run} invokation. + +@end table + +@end deftp + + +@c %end of fragment + +@c %start of fragment + +@deftp {Data Type} oci-network-configuration +Available @code{oci-network-configuration} fields are: + +@table @asis +@item @code{name} (type: string) +The name of the OCI network to provision. + +@item @code{driver} (type: maybe-string) +The driver to manage the network. + +@item @code{gateway} (type: maybe-string) +IPv4 or IPv6 gateway for the subnet. + +@item @code{internal?} (default: @code{#f}) (type: boolean) +Restrict external access to the network + +@item @code{ip-range} (type: maybe-string) +Allocate container ip from a sub-range in CIDR format. + +@item @code{ipam-driver} (type: maybe-string) +IP Address Management Driver. + +@item @code{ipv6?} (default: @code{#f}) (type: boolean) +Enable IPv6 networking. + +@item @code{subnet} (type: maybe-string) +Subnet in CIDR format that represents a network segment. + +@item @code{labels} (default: @code{'()}) (type: list) +The list of labels that will be used to tag the current volume. + +@item @code{extra-arguments} (default: @code{'()}) (type: list) +A list of strings, gexps or file-like objects that will be directly +passed to the runtime invokation. + +@end table + +@end deftp + + +@c %end of fragment + +@c %start of fragment + +@deftp {Data Type} oci-volume-configuration +Available @code{oci-volume-configuration} fields are: + +@table @asis +@item @code{name} (type: string) +The name of the OCI volume to provision. + +@item @code{labels} (default: @code{'()}) (type: list) +The list of labels that will be used to tag the current volume. @item @code{extra-arguments} (default: @code{'()}) (type: list) A list of strings, gexps or file-like objects that will be directly -passed to the @command{docker run} invocation. +passed to the runtime invokation. @end table diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm index 50bf6c05549..5c50c99eaf6 100644 --- a/gnu/services/containers.scm +++ b/gnu/services/containers.scm @@ -41,6 +41,7 @@ (define-module (gnu services containers) #:use-module ((guix scripts pack) #:prefix pack:) #:use-module (guix store) #:use-module (srfi srfi-1) + #:use-module (ice-9 format) #:use-module (ice-9 match) #:export (rootless-podman-configuration rootless-podman-configuration? @@ -96,8 +97,72 @@ (define-module (gnu services containers) oci-container-configuration-workdir oci-container-configuration-extra-arguments + list-of-oci-containers? + list-of-oci-networks? + list-of-oci-volumes? + + %oci-supported-runtimes + oci-sanitize-runtime + oci-runtime-system-environment + oci-runtime-system-extra-arguments + oci-runtime-system-group + oci-runtime-system-requirement + oci-runtime-cli + oci-runtime-system-cli + oci-runtime-name + oci-runtime-group + + oci-network-configuration + oci-network-configuration? + oci-network-configuration-fields + oci-network-configuration-name + oci-network-configuration-driver + oci-network-configuration-gateway + oci-network-configuration-internal? + oci-network-configuration-ip-range + oci-network-configuration-ipam-driver + oci-network-configuration-ipv6? + oci-network-configuration-subnet + oci-network-configuration-labels + oci-network-configuration-extra-arguments + + oci-volume-configuration + oci-volume-configuration? + oci-volume-configuration-fields + oci-volume-configuration-name + oci-volume-configuration-labels + oci-volume-configuration-extra-arguments + + oci-configuration + oci-configuration? + oci-configuration-fields + oci-configuration-runtime + oci-configuration-runtime-cli + oci-configuration-runtime-extra-arguments + oci-configuration-user + oci-configuration-group + oci-configuration-containers + oci-configuration-networks + oci-configuration-volumes + oci-configuration-verbose? + + oci-extension + oci-extension? + oci-extension-fields + oci-extension-containers + oci-extension-networks + oci-extension-volumes + + oci-networks-shepherd-name + oci-volumes-shepherd-name + oci-container-shepherd-service - %oci-container-accounts)) + oci-service-type + oci-service-accounts + oci-service-profile + oci-service-subids + oci-state->shepherd-services + oci-configuration->shepherd-services)) (define (gexp-or-string? value) (or (gexp? value) @@ -294,9 +359,42 @@ (define rootless-podman-service-type ;;; -;;; OCI container. +;;; OCI provisioning service. ;;; +(define %oci-supported-runtimes + '(docker podman)) + +(define (oci-runtime-system-requirement runtime) + "Return a list of Shepherd service names required by a given OCI runtime, +before it is able to run containers." + (if (eq? 'podman runtime) + '(cgroups2-fs-owner cgroups2-limits + rootless-podman-shared-root-fs user-processes) + '(dockerd user-processes))) + +(define (oci-runtime-name runtime) + "Return a human readable name for a given OCI runtime." + (if (eq? 'podman runtime) + "Podman" "Docker")) + +(define (oci-runtime-group runtime maybe-group) + "Implement the logic behind selection of the group that is to be used by +Shepherd to execute OCI commands." + (if (maybe-value-set? maybe-group) + maybe-group + (if (eq? 'podman runtime) + "cgroup" + "docker"))) + +(define (oci-sanitize-runtime value) + (unless (member value %oci-supported-runtimes) + (raise + (formatted-message + (G_ "OCI runtime must be a symbol and one of ~a, +but ~a was found") %oci-supported-runtimes value))) + value) + (define (oci-sanitize-pair pair delimiter) (define (valid? member) (or (string? member) @@ -345,6 +443,11 @@ (define (oci-sanitize-volumes value) ;; '(("/mnt/dir" . "/dir") "/run/current-system/profile:/java") (oci-sanitize-mixed-list "volumes" value ":")) +(define (oci-sanitize-labels value) + ;; Expected spec format: + ;; '(("foo" . "bar") "foo=bar") + (oci-sanitize-mixed-list "labels" value "=")) + (define (oci-sanitize-shepherd-actions value) (map (lambda (el) @@ -372,6 +475,7 @@ (define (oci-sanitize-extra-arguments value) value)) (define (oci-image-reference image) + "Return a string OCI image reference representing IMAGE." (if (string? image) image (string-append (oci-image-repository image) @@ -390,7 +494,19 @@ (define (string-or-oci-image? image) (define list-of-symbols? (list-of symbol?)) +(define (list-of-oci-records? name predicate value) + (map + (lambda (el) + (if (predicate el) + el + (raise + (formatted-message + (G_ "~a contains an illegal value: ~a") name el)))) + value)) + (define-maybe/no-serialization string) +(define-maybe/no-serialization package) +(define-maybe/no-serialization subid-range) (define-configuration/no-serialization oci-image (repository @@ -436,10 +552,12 @@ (define-configuration/no-serialization oci-image (define-configuration/no-serialization oci-container-configuration (user (string "oci-container") - "The user under whose authority docker commands will be run.") + "The user name under whose authority OCI commands will be run.") (group (string "docker") - "The group under whose authority docker commands will be run.") + "The group name under whose authority OCI commands will be run. When +using the @code{'podman} OCI runtime, this field will be ignored and the +default group of the user configured in the @code{user} field will be used.") (command (list-of-strings '()) "Overwrite the default command (@code{CMD}) of the image.") @@ -449,9 +567,9 @@ (define-configuration/no-serialization oci-container-configuration (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 +or @command{podman run} are invoked. This is especially useful to pass secrets +from the host to the container without having them on the OCI runtime command line, +for example: by setting the @code{MYSQL_PASSWORD} on the host and by passing @code{--env MYSQL_PASSWORD} through the @code{extra-arguments} field, it is possible to securely set values in the container environment. This field's value can be a list of pairs or strings, even mixed: @@ -475,15 +593,16 @@ (define-configuration/no-serialization oci-container-configuration @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." +directly to the OCI runtime CLI. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run/#env,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#env-e-env,Podman} +upstream documentation for semantics." (sanitizer oci-sanitize-environment)) (image (string-or-oci-image) "The image used to build the container. It can be a string or an -@code{oci-image} record. Strings are resolved by the Docker -Engine, and follow the usual format +@code{oci-image} record. Strings are resolved by the OCI runtime, +and follow the usual format @code{myregistry.local:5000/testing/test-image:tag}.") (provision (maybe-string) @@ -512,7 +631,7 @@ (define-configuration/no-serialization oci-container-configuration (sanitizer oci-sanitize-shepherd-actions)) (network (maybe-string) - "Set a Docker network for the spawned container.") + "Set an OCI network for the spawned container.") (ports (list '()) "Set the port or port ranges to expose from the spawned container. This can @@ -524,9 +643,10 @@ (define-configuration/no-serialization oci-container-configuration @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." +directly to the OCI runtime CLI. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run/#publish,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#publish-p-ip-hostport-containerport-protocol,Podman} +upstream documentation for semantics." (sanitizer oci-sanitize-ports)) (volumes (list '()) @@ -539,63 +659,326 @@ (define-configuration/no-serialization oci-container-configuration @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." +directly to the OCI runtime CLI. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run/#volume,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#volume-v-source-volume-host-dir-container-dir-options,Podman} +upstream documentation for semantics." (sanitizer oci-sanitize-volumes)) (container-user (maybe-string) "Set the current user inside the spawned container. You can refer to the -@url{https://docs.docker.com/engine/reference/run/#user,upstream} -documentation for semantics.") +@url{https://docs.docker.com/engine/reference/run/#user,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#user-u-user-group,Podman} +upstream documentation for semantics.") (workdir (maybe-string) - "Set the current working for the spawned Shepherd service. + "Set the current working directory for the spawned Shepherd service. You can refer to the -@url{https://docs.docker.com/engine/reference/run/#workdir,upstream} -documentation for semantics.") +@url{https://docs.docker.com/engine/reference/run/#workdir,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#workdir-w-dir,Podman} +upstream documentation for semantics.") (extra-arguments (list '()) "A list of strings, gexps or file-like objects that will be directly passed -to the @command{docker run} invokation." +to the @command{docker run} or @command{podman 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 (list-of-oci-containers? value) + (list-of-oci-records? "containers" oci-container-configuration? value)) + +(define-configuration/no-serialization oci-volume-configuration + (name + (string) + "The name of the OCI volume to provision.") + (labels + (list '()) + "The list of labels that will be used to tag the current volume." + (sanitizer oci-sanitize-labels)) + (extra-arguments + (list '()) + "A list of strings, gexps or file-like objects that will be directly passed +to the runtime invokation." + (sanitizer oci-sanitize-extra-arguments))) + +(define (list-of-oci-volumes? value) + (list-of-oci-records? "volumes" oci-volume-configuration? value)) + +(define-configuration/no-serialization oci-network-configuration + (name + (string) + "The name of the OCI network to provision.") + (driver + (maybe-string) + "The driver to manage the network.") + (gateway + (maybe-string) + "IPv4 or IPv6 gateway for the subnet.") + (internal? + (boolean #f) + "Restrict external access to the network") + (ip-range + (maybe-string) + "Allocate container ip from a sub-range in CIDR format.") + (ipam-driver + (maybe-string) + "IP Address Management Driver.") + (ipv6? + (boolean #f) + "Enable IPv6 networking.") + (subnet + (maybe-string) + "Subnet in CIDR format that represents a network segment.") + (labels + (list '()) + "The list of labels that will be used to tag the current volume." + (sanitizer oci-sanitize-labels)) + (extra-arguments + (list '()) + "A list of strings, gexps or file-like objects that will be directly passed +to the runtime invokation." + (sanitizer oci-sanitize-extra-arguments))) + +(define (list-of-oci-networks? value) + (list-of-oci-records? "networks" oci-network-configuration? value)) + +(define-configuration/no-serialization oci-configuration + (runtime + (symbol 'docker) + "The OCI runtime to use to run commands. It can be either @code{'docker} or +@code{'podman}." + (sanitizer oci-sanitize-runtime)) + (runtime-cli + (maybe-package) + "The OCI runtime command line to be installed in the system profile and used +to provision OCI resources. When unset it will default to @code{docker-cli} +package for the @code{'docker} runtime or to @code{podman} package for the +@code{'podman} runtime.") + (runtime-extra-arguments + (list '()) + "A list of strings, gexps or file-like objects that will be placed +after each @command{docker} or @command{podman} invokation.") + (user + (string "oci-container") + "The user name under whose authority OCI runtime commands will be run.") + (group + (maybe-string) + "The group name under whose authority OCI commands will be run. When +using the @code{'podman} OCI runtime, this field will be ignored and the +default group of the user configured in the @code{user} field will be used.") + (subuids-range + (maybe-subid-range) + "An optional @code{subid-range} record allocating subuids for the user from +the @code{user} field. When unset, with the rootless Podman OCI runtime, it +defaults to @code{(subid-range (name \"oci-container\"))}.") + (subgids-range + (maybe-subid-range) + "An optional @code{subid-range} record allocating subgids for the user from +the @code{user} field. When unset, with the rootless Podman OCI runtime, it +defaults to @code{(subid-range (name \"oci-container\"))}.") + (containers + (list-of-oci-containers '()) + "The list of @code{oci-container-configuration} records representing the +containers to provision. Most users are supposed not to use this field and use +the @code{oci-extension} record instead.") + (networks + (list-of-oci-networks '()) + "The list of @code{oci-network-configuration} records representing the +networks to provision. Most users are supposed not to use this field and use +the @code{oci-extension} record instead.") + (volumes + (list-of-oci-volumes '()) + "The list of @code{oci-volume-configuration} records representing the +volumes to provision. Most users are supposed not to use this field and use +the @code{oci-extension} record instead.") + (verbose? + (boolean #f) + "When true, additional output will be printed, allowing to better follow the +flow of execution.")) + +(define (oci-runtime-system-environment runtime user) + (if (eq? runtime 'podman) + (list + #~(string-append + "HOME=" (passwd:dir (getpwnam #$user)))) + #~())) + +(define (oci-runtime-system-group runtime user group) + (if (eq? runtime 'podman) + #~(group:name + (getgrgid + (passwd:gid + (getpwnam #$user)))) + group)) + +(define (oci-runtime-cli runtime runtime-cli path) + "Return a gexp that, when lowered, evaluates to the file system path of the OCI +runtime command requested by the user." + (if (string? runtime-cli) + ;; It is a user defined absolute path + runtime-cli + #~(string-append + #$(if (maybe-value-set? runtime-cli) + runtime-cli + path) + #$(if (eq? 'podman runtime) + "/bin/podman" + "/bin/docker")))) + +(define* (oci-runtime-system-cli config #:key (path "/run/current-system/profile")) + (let ((runtime-cli + (oci-configuration-runtime-cli config)) + (runtime + (oci-configuration-runtime config))) + (oci-runtime-cli runtime runtime-cli path))) + +(define-configuration/no-serialization oci-extension + (containers + (list-of-oci-containers '()) + "The list of @code{oci-container-configuration} records representing the +containers to add.") + (networks + (list-of-oci-networks '()) + "The list of @code{oci-network-configuration} records representing the +networks to add.") + (volumes + (list-of-oci-volumes '()) + "The list of @code{oci-volume-configuration} records representing the +volumes to add.")) + +(define (oci-image->container-name image) + "Infer the name of an OCI backed Shepherd service from its OCI image." + (basename + (if (string? image) + (first (string-split image #\:)) + (oci-image-repository image)))) + +(define (oci-object-command-shepherd-action object-name invokation) + "Return a Shepherd action printing a given INVOKATION of an OCI command for the +given OBJECT-NAME." + (shepherd-action + (name 'command-line) + (documentation + (format #f "Prints ~a's OCI runtime command line invokation." + object-name)) + (procedure + #~(lambda _ + (format #t "~a~%" #$invokation))))) + +(define (oci-container-shepherd-name runtime config) + "Return the name of an OCI backed Shepherd service based on CONFIG. +The name configured in the configuration record is returned when +CONFIG's name field has a value, otherwise a name is inferred from CONFIG's +image field." + (define name (oci-container-configuration-provision config)) + (define image (oci-container-configuration-image config)) + + (if (maybe-value-set? name) + name + (string-append (symbol->string runtime) "-" + (oci-image->container-name image)))) + +(define (oci-networks-shepherd-name runtime) + "Return the name of the OCI networks provisioning Shepherd service based on +RUNTIME." + (string-append (symbol->string runtime) "-networks")) + +(define (oci-volumes-shepherd-name runtime) + "Return the name of the OCI volumes provisioning Shepherd service based on +RUNTIME." + (string-append (symbol->string runtime) "-volumes")) + +(define (oci-container-configuration->options config) + "Map CONFIG, an oci-container-configuration record, to a gexp that, upon +lowering, will be evaluated to a list of strings containing command line options +for the OCI runtime run command." + (let ((entrypoint + (oci-container-configuration-entrypoint config)) + (network + (oci-container-configuration-network config)) + (user + (oci-container-configuration-container-user config)) + (workdir + (oci-container-configuration-workdir config))) + (apply append + (filter (compose not unspecified?) + `(,(if (maybe-value-set? entrypoint) + `("--entrypoint" ,entrypoint) + '()) + ,(append-map + (lambda (spec) + (list "--env" spec)) + (oci-container-configuration-environment config)) + ,(if (maybe-value-set? network) + `("--network" ,network) + '()) + ,(if (maybe-value-set? user) + `("--user" ,user) + '()) + ,(if (maybe-value-set? workdir) + `("--workdir" ,workdir) + '()) + ,(append-map + (lambda (spec) + (list "-p" spec)) + (oci-container-configuration-ports config)) + ,(append-map + (lambda (spec) + (list "-v" spec)) + (oci-container-configuration-volumes config))))))) + +(define (oci-network-configuration->options config) + "Map CONFIG, an oci-network-configuration record, to a gexp that, upon +lowering, will be evaluated to a list of strings containing command line options +for the OCI runtime network create command." + (let ((driver (oci-network-configuration-driver config)) + (gateway + (oci-network-configuration-gateway config)) + (internal? + (oci-network-configuration-internal? config)) + (ip-range + (oci-network-configuration-ip-range config)) + (ipam-driver + (oci-network-configuration-ipam-driver config)) + (ipv6? + (oci-network-configuration-ipv6? config)) + (subnet + (oci-network-configuration-subnet config))) + (apply append + (filter (compose not unspecified?) + `(,(if (maybe-value-set? driver) + `("--driver" ,driver) + '()) + ,(if (maybe-value-set? gateway) + `("--gateway" ,gateway) + '()) + ,(if internal? + `("--internal") + '()) + ,(if (maybe-value-set? ip-range) + `("--ip-range" ,ip-range) + '()) + ,(if (maybe-value-set? ipam-driver) + `("--ipam-driver" ,ipam-driver) + '()) + ,(if ipv6? + `("--ipv6") + '()) + ,(if (maybe-value-set? subnet) + `("--subnet" ,subnet) + '()) + ,(append-map + (lambda (spec) + (list "--label" spec)) + (oci-network-configuration-labels config))))))) + +(define (oci-volume-configuration->options config) + "Map CONFIG, an oci-volume-configuration record, to a gexp that, upon +lowering, will be evaluated to a list of strings containing command line options +for the OCI runtime volume create command." + (append-map + (lambda (spec) + (list "--label" spec)) + (oci-volume-configuration-labels config))) (define* (get-keyword-value args keyword #:key (default #f)) (let ((kv (memq keyword args))) @@ -604,6 +987,7 @@ (define* (get-keyword-value args keyword #:key (default #f)) default))) (define (lower-operating-system os target system) + "Lower OS, an operating-system record, into a tarball containing an OCI image." (mlet* %store-monad ((tarball (lower-object @@ -613,6 +997,7 @@ (define (lower-operating-system os target system) (return tarball))) (define (lower-manifest name image target system) + "Lower IMAGE, a manifest record, into a tarball containing an OCI image." (define value (oci-image-value image)) (define options (oci-image-pack-options image)) (define image-reference @@ -645,6 +1030,7 @@ (define (lower-manifest name image target system) (return tarball))) (define (lower-oci-image name image) + "Lower IMAGE, a oci-image record, into a tarball containing an OCI image." (define value (oci-image-value image)) (define image-target (oci-image-target image)) (define image-system (oci-image-system image)) @@ -675,9 +1061,10 @@ (define (lower-oci-image name image) #: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))) +(define* (oci-image-loader runtime-cli name image tag #:key (verbose? #f)) + "Return a file-like object that, once lowered, will evaluate to a program able +to load IMAGE through RUNTIME-CLI and to tag it with TAG afterwards." + (let ((tarball (lower-oci-image name image))) (with-imported-modules '((guix build utils)) (program-file (format #f "~a-image-loader" name) #~(begin @@ -686,102 +1073,561 @@ (define (%oci-image-loader name image tag) (ice-9 rdelim)) (format #t "Loading image for ~a from ~a...~%" #$name #$tarball) + (define load-command + (string-append #$runtime-cli + " load -i " #$tarball)) + (when #$verbose? + (format #t "Running ~a~%" load-command)) (define line (read-line - (open-input-pipe - (string-append #$docker " load -i " #$tarball)))) + (open-input-pipe load-command))) (unless (or (eof-object? line) (string-null? line)) (format #t "~a~%" line) - (let ((repository&tag - (string-drop line - (string-length - "Loaded image: ")))) + (let* ((repository&tag + (string-drop line + (string-length + "Loaded image: "))) + (tag-command + (list #$runtime-cli "tag" repository&tag #$tag))) + + (when #$verbose? + (format #t "Running~{ ~a~}~%" tag-command)) - (invoke #$docker "tag" repository&tag #$tag) + (apply invoke tag-command) (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)) +(define (oci-container-run-invokation runtime-cli name command image-reference + options runtime-extra-arguments run-extra-arguments) + "Return a list representing the OCI runtime +invokation for running containers." + ;; run [OPTIONS] IMAGE [COMMAND] [ARG...] + `(,runtime-cli ,@runtime-extra-arguments "run" + "--rm" "--name" ,name + ,@options ,@run-extra-arguments + ,image-reference ,@command)) + +(define* (oci-container-entrypoint runtime-cli name image image-reference + invokation #:key (verbose? #f)) + "Return a file-like object that, once lowered, will evaluate to the entrypoint +for the Shepherd service that will run IMAGE through RUNTIME-CLI." + (program-file + (string-append "oci-entrypoint-" name) + #~(begin + (use-modules (ice-9 format) + (srfi srfi-1)) + (when #$verbose? + (format #t "Running in verbose mode...~%")) + (define invokation (list #$@invokation)) + #$@(if (oci-image? image) + #~((system* + #$(oci-image-loader + runtime-cli name image + image-reference #:verbose? verbose?))) + #~()) + (when #$verbose? + (format #t "Running~{ ~a~}~%" invokation)) + (apply execlp `(,(first invokation) ,@invokation))))) + +(define* (oci-container-shepherd-service runtime runtime-cli config + #:key + (runtime-environment #~()) + (runtime-extra-arguments '()) + (oci-requirement '()) + (user #f) + (group #f) + (verbose? #f)) + "Return a Shepherd service object that will run the OCI container represented +by CONFIG through RUNTIME-CLI." + (let* ((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)) + (user (or user (oci-container-configuration-user config))) + (group (if (and group (maybe-value-set? group)) + 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)) + (name + (oci-container-shepherd-name runtime config)) (extra-arguments - (oci-container-configuration-extra-arguments config))) + (oci-container-configuration-extra-arguments config)) + (invokation + (oci-container-run-invokation + runtime-cli name command image-reference + options runtime-extra-arguments extra-arguments))) (shepherd-service (provision `(,(string->symbol name))) - (requirement `(dockerd user-processes ,@requirement)) + (requirement `(,@oci-requirement + ,@requirement)) (respawn? respawn?) (auto-start? auto-start?) (documentation (string-append - "Docker backed Shepherd service for " + (oci-runtime-name runtime) " 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 + (list + #$(oci-container-entrypoint + runtime-cli name image image-reference + invokation #:verbose? verbose?)) + #$@(if user (list #:user user) '()) + #$@(if group (list #:group group) '()) #$@(if (maybe-value-set? log-file) (list #:log-file log-file) '()) + #$@(if (eq? runtime 'podman) + (list #:directory + #~(passwd:dir (getpwnam #$user))) + '()) #:environment-variables - (list #$@host-environment)))) + (append + (list #$@host-environment) + (list #$@runtime-environment))))) (stop #~(lambda _ - (invoke #$docker "rm" "-f" #$name))) + (invoke #$runtime-cli "rm" "-f" #$name))) (actions - (if (oci-image? image) - '() - (append + (append + (list + (oci-object-command-shepherd-action + name #~(string-join (list #$@invokation) " "))) + (if (oci-image? image) + '() (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 + (let ((service-name name)) + (shepherd-action + (name 'pull) + (documentation + (format #f "Pull ~a's image (~a)." + service-name image)) + (procedure + #~(lambda _ + (invoke #$runtime-cli "pull" #$image))))))) + actions))))) + +(define (oci-object-create-invokation object runtime-cli name options + runtime-extra-arguments + create-extra-arguments) + "Return a gexp that, upon lowering, will evaluate to the OCI runtime +invokation for creating networks and volumes." + ;; network|volume create [options] [NAME] + #~(list #$runtime-cli #$@runtime-extra-arguments #$object "create" + #$@options #$@create-extra-arguments #$name)) + +(define (format-oci-invokations invokations) + "Return a gexp that, upon lowering, will evaluate to a formatted message +containing the INVOKATIONS that the OCI runtime will execute to provision +networks or volumes." + #~(string-join (map (lambda (i) (string-join i " ")) + (list #$@invokations)) + "\n")) + +(define* (oci-object-create-script object runtime runtime-cli invokations + #:key (verbose? #f)) + "Return a file-like object that, once lowered, will evaluate to a program able +to create OCI networks and volumes through RUNTIME-CLI." + (define runtime-string (symbol->string runtime)) + (program-file + (string-append runtime-string "-" object "s-create.scm") + #~(begin + (use-modules (ice-9 format) + (ice-9 match) + (ice-9 popen) + (ice-9 rdelim) + (srfi srfi-1)) + + (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 (object-exists? name) + #$(if (eq? runtime 'podman) + #~(let ((command + (list #$runtime-cli + #$object "exists" name))) + (when #$verbose? + (format #t "Running~{ ~a~}~%" command)) + (define exit-code (status:exit-val (apply system* command))) + (when #$verbose? + (format #t "Exit code: ~a~%" exit-code)) + (equal? EXIT_SUCCESS exit-code)) + #~(let ((command + (string-append #$runtime-cli + " " #$object " ls --format " + "\"{{.Name}}\""))) + (when #$verbose? + (format #t "Running ~a~%" command)) + (member name (read-lines (open-input-pipe command)))))) + + (for-each + (lambda (invokation) + (define name (last invokation)) + (if (object-exists? name) + (format #t "~a ~a ~a already exists, skipping creation.~%" + #$(oci-runtime-name runtime) name #$object) + (begin + (when #$verbose? + (format #t "Running~{ ~a~}~%" invokation)) + (let ((exit-code (status:exit-val (apply system* invokation)))) + (when #$verbose? + (format #t "Exit code: ~a~%" exit-code)))))) + (list #$@invokations))))) + +(define* (oci-object-shepherd-service object runtime runtime-cli name requirement invokations + #:key + (runtime-environment #~()) + (user #f) + (group #f) + (verbose? #f)) + "Return a Shepherd service object that will create the OBJECTs represented +by INVOKATIONS through RUNTIME-CLI." + (shepherd-service (provision `(,(string->symbol name))) + (requirement requirement) + (one-shot? #t) + (documentation + (string-append + (oci-runtime-name runtime) " " object + " provisioning service")) + (start + #~(lambda _ + (fork+exec-command + (list + #$(oci-object-create-script + object runtime runtime-cli + invokations + #:verbose? verbose?)) + #$@(if user (list #:user user) '()) + #$@(if group (list #:group group) '()) + #:environment-variables + (list #$@runtime-environment)))) + (actions + (list + (oci-object-command-shepherd-action + name (format-oci-invokations invokations)))))) + +(define* (oci-networks-shepherd-service runtime runtime-cli name networks + #:key (user #f) (group #f) (verbose? #f) + (runtime-extra-arguments '()) + (runtime-environment #~()) + (runtime-requirement '())) + "Return a Shepherd service object that will create the networks represented +in CONFIG." + (let ((invokations + (map + (lambda (network) + (oci-object-create-invokation + "network" runtime-cli + (oci-network-configuration-name network) + (oci-network-configuration->options network) + runtime-extra-arguments + (oci-network-configuration-extra-arguments network))) + networks))) + + (oci-object-shepherd-service + "network" runtime runtime-cli name + runtime-requirement invokations + #:user user #:group group #:runtime-environment runtime-environment + #:verbose? verbose?))) + +(define* (oci-volumes-shepherd-service runtime runtime-cli name volumes + #:key (user #f) (group #f) (verbose? #f) + (runtime-extra-arguments '()) + (runtime-environment #~()) + (runtime-requirement '())) + "Return a Shepherd service object that will create the volumes represented +in CONFIG." + (let ((invokations + (map + (lambda (volume) + (oci-object-create-invokation + "volume" runtime-cli + (oci-volume-configuration-name volume) + (oci-volume-configuration->options volume) + runtime-extra-arguments + (oci-volume-configuration-extra-arguments volume))) + volumes))) + + (oci-object-shepherd-service + "volume" runtime runtime-cli name runtime-requirement invokations + #:user user #:group group #:runtime-environment runtime-environment + #:verbose? verbose?))) + +(define (oci-service-accounts config) + (define user (oci-configuration-user config)) + (define maybe-group (oci-configuration-group config)) + (define runtime (oci-configuration-runtime config)) (list (user-account - (name "oci-container") + (name user) (comment "OCI services account") - (group "docker") - (system? #t) - (home-directory "/var/empty") + (group "users") + (supplementary-groups + (list (oci-runtime-group runtime maybe-group))) + (system? (eq? 'docker runtime)) + (home-directory (if (eq? 'podman runtime) + (string-append "/home/" user) + "/var/empty")) + (create-home-directory? (eq? 'podman runtime)) (shell (file-append shadow "/sbin/nologin"))))) + +(define* (oci-state->shepherd-services runtime runtime-cli containers networks volumes + #:key (user #f) (group #f) (verbose? #f) + (networks-name #f) (volumes-name #f) + (runtime-extra-arguments '()) + (runtime-environment #~()) + (runtime-requirement '()) + (containers-requirement '()) + (networks-requirement '()) + (volumes-requirement '())) + (let* ((networks? + (> (length networks) 0)) + (networks-service + (if networks? + (list + (string->symbol + (oci-networks-shepherd-name runtime))) + '())) + (volumes? + (> (length volumes) 0)) + (volumes-service + (if volumes? + (list + (string->symbol + (oci-volumes-shepherd-name runtime))) + '()))) + (append + (map + (lambda (c) + (oci-container-shepherd-service + runtime runtime-cli c + #:user user + #:group group + #:runtime-environment runtime-environment + #:runtime-extra-arguments runtime-extra-arguments + #:oci-requirement + (append containers-requirement + runtime-requirement + networks-service + volumes-service) + #:verbose? verbose?)) + containers) + (if networks? + (list + (oci-networks-shepherd-service + runtime runtime-cli + (if (string? networks-name) + networks-name + (oci-networks-shepherd-name runtime)) + networks + #:user user #:group group + #:runtime-extra-arguments runtime-extra-arguments + #:runtime-environment runtime-environment + #:runtime-requirement (append networks-requirement + runtime-requirement) + #:verbose? verbose?)) + '()) + (if volumes? + (list + (oci-volumes-shepherd-service + runtime runtime-cli + (if (string? volumes-name) + volumes-name + (oci-volumes-shepherd-name runtime)) + volumes + #:user user #:group group + #:runtime-extra-arguments runtime-extra-arguments + #:runtime-environment runtime-environment + #:runtime-requirement (append runtime-requirement + volumes-requirement) + #:verbose? verbose?)) + '())))) + +(define (oci-configuration->shepherd-services config) + (let* ((runtime (oci-configuration-runtime config)) + (runtime-cli + (oci-runtime-system-cli config)) + (runtime-extra-arguments + (oci-configuration-runtime-extra-arguments config)) + (containers (oci-configuration-containers config)) + (networks (oci-configuration-networks config)) + (volumes (oci-configuration-volumes config)) + (user (oci-configuration-user config)) + (group (oci-runtime-group + runtime (oci-configuration-group config))) + (verbose? (oci-configuration-verbose? config))) + (oci-state->shepherd-services runtime runtime-cli containers networks volumes + #:user user + #:group + (oci-runtime-system-group runtime user group) + #:verbose? verbose? + #:runtime-extra-arguments + runtime-extra-arguments + #:runtime-environment + (oci-runtime-system-environment runtime user) + #:runtime-requirement + (oci-runtime-system-requirement runtime) + #:networks-requirement '(networking)))) + +(define (oci-service-subids config) + "Return a subids-extension record representing subuids and subgids required by +the rootless Podman backend." + (define (delete-duplicate-ranges ranges) + (delete-duplicates ranges + (lambda args + (apply string=? (map subid-range-name ranges))))) + (define runtime + (oci-configuration-runtime config)) + (define user + (oci-configuration-user config)) + (define subgids (oci-configuration-subgids-range config)) + (define subuids (oci-configuration-subuids-range config)) + (define container-users + (filter (lambda (range) (not (string=? (subid-range-name range) user))) + (map (lambda (container) + (subid-range + (name + (oci-container-configuration-user container)))) + (oci-configuration-containers config)))) + (define subgid-ranges + (delete-duplicate-ranges + (cons + (if (maybe-value-set? subgids) + subgids + (subid-range (name user))) + container-users))) + (define subuid-ranges + (delete-duplicate-ranges + (cons + (if (maybe-value-set? subuids) + subuids + (subid-range (name user))) + container-users))) + + (if (eq? 'podman runtime) + (subids-extension + (subgids + subgid-ranges) + (subuids + subuid-ranges)) + (subids-extension))) + +(define (oci-objects-merge-lst a b object get-name) + (define (contains? value lst) + (member value (map get-name lst))) + (let loop ((merged '()) + (lst (append a b))) + (if (null? lst) + merged + (loop + (let ((element (car lst))) + (when (contains? element merged) + (raise + (formatted-message + (G_ "Duplicated ~a: ~a. ~as names should be unique, please +remove the duplicate.") object (get-name element) object))) + (cons element merged)) + (cdr lst))))) + +(define (oci-extension-merge a b) + (oci-extension + (containers (oci-objects-merge-lst + (oci-extension-containers a) + (oci-extension-containers b) + "container" + (lambda (config) + (define maybe-name (oci-container-configuration-provision config)) + (if (maybe-value-set? maybe-name) + maybe-name + (oci-image->container-name + (oci-container-configuration-image config)))))) + (networks (oci-objects-merge-lst + (oci-extension-networks a) + (oci-extension-networks b) + "network" + oci-networks-shepherd-name)) + (volumes (oci-objects-merge-lst + (oci-extension-volumes a) + (oci-extension-volumes b) + "volume" + oci-volumes-shepherd-name)))) + +(define (oci-service-profile runtime runtime-cli) + (list bash-minimal + (cond + ((maybe-value-set? runtime-cli) + runtime-cli) + ((eq? 'podman runtime) + podman) + (else + docker-cli)))) + +(define oci-service-type + (service-type (name 'oci) + (extensions + (list + (service-extension profile-service-type + (lambda (config) + (let ((runtime-cli + (oci-configuration-runtime-cli config)) + (runtime + (oci-configuration-runtime config))) + (oci-service-profile runtime runtime-cli)))) + (service-extension subids-service-type + oci-service-subids) + (service-extension account-service-type + oci-service-accounts) + (service-extension shepherd-root-service-type + oci-configuration->shepherd-services))) + ;; Concatenate OCI object lists. + (compose (lambda (args) + (fold oci-extension-merge + (oci-extension) + args))) + (extend + (lambda (config extension) + (oci-configuration + (inherit config) + (containers + (oci-objects-merge-lst + (oci-configuration-containers config) + (oci-extension-containers extension) + "container" + (lambda (oci-config) + (define runtime + (oci-configuration-runtime config)) + (oci-container-shepherd-name runtime oci-config)))) + (networks (oci-objects-merge-lst + (oci-configuration-networks config) + (oci-extension-networks extension) + "network" + oci-networks-shepherd-name)) + (volumes (oci-objects-merge-lst + (oci-configuration-volumes config) + (oci-extension-volumes extension) + "volume" + oci-volumes-shepherd-name))))) + (default-value (oci-configuration)) + (description + "This service implements the provisioning of OCI object such +as containers, networks and volumes."))) diff --git a/gnu/services/docker.scm b/gnu/services/docker.scm index 69ff9f1d9e4..98ee175873d 100644 --- a/gnu/services/docker.scm +++ b/gnu/services/docker.scm @@ -31,7 +31,10 @@ (define-module (gnu services docker) #:use-module (gnu system shadow) #:use-module (gnu packages docker) #:use-module (gnu packages linux) ;singularity + #:use-module (guix deprecation) + #:use-module (guix diagnostics) #:use-module (guix gexp) + #:use-module (guix i18n) #:use-module (guix records) #:use-module (srfi srfi-1) #:use-module (ice-9 format) @@ -67,16 +70,18 @@ (define-module (gnu services docker) 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) + oci-container-configuration-extra-arguments) #:export (containerd-configuration containerd-service-type docker-configuration docker-service-type singularity-service-type - oci-container-service-type)) + ;; for backwards compatibility, until the + ;; oci-container-service-type is fully deprecated + oci-container-shepherd-service + oci-container-service-type + %oci-container-accounts)) (define-maybe file-like) @@ -295,17 +300,25 @@ (define singularity-service-type ;;; OCI container. ;;; -(define (configs->shepherd-services configs) - (map oci-container-shepherd-service configs)) +;; for backwards compatibility, until the +;; oci-container-service-type is fully deprecated +(define-deprecated (oci-container-shepherd-service config) + oci-service-type + ((@ (gnu services containers) oci-container-shepherd-service) + 'docker config)) +(define %oci-container-accounts + (filter user-account? (oci-service-accounts (oci-configuration)))) (define oci-container-service-type (service-type (name 'oci-container) - (extensions (list (service-extension profile-service-type - (lambda _ (list docker-cli))) - (service-extension account-service-type - (const %oci-container-accounts)) - (service-extension shepherd-root-service-type - configs->shepherd-services))) + (extensions + (list (service-extension oci-service-type + (lambda (containers) + (warning + (G_ + "'oci-container-service-type' is deprecated, use 'oci-service-type' instead~%")) + (oci-extension + (containers containers)))))) (default-value '()) (extend append) (compose concatenate) diff --git a/gnu/tests/containers.scm b/gnu/tests/containers.scm index 0ecc8ddb126..bac1f47bd34 100644 --- a/gnu/tests/containers.scm +++ b/gnu/tests/containers.scm @@ -27,6 +27,9 @@ (define-module (gnu tests containers) #: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 @@ (define-module (gnu tests containers) #: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 @@ -345,3 +350,995 @@ (define %test-rootless-podman (name "rootless-podman") (description "Test rootless Podman service.") (value (build-tarball&run-rootless-podman-test)))) + + +(define %oci-rootless-podman-os + (simple-operating-system + (service dhcp-client-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-configuration (name "my-network")))) + (volumes + (list (oci-volume-configuration (name "my-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)(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 services herd) + (guix combinators)))) + + (define vm + (virtual-machine + (operating-system os) + (volatile? #f) + (memory-size 1024) + (disk-image-size (* 3000 (expt 2 20))) + (port-forwardings '()))) + + (define test + (with-imported-modules '((gnu build marionette)) + #~(begin + (use-modules (srfi srfi-11) (srfi srfi-64) + (gnu build marionette)) + + (define marionette + ;; Relax timeout to accommodate older systems and + ;; allow for pulling the image. + (make-marionette (list #$vm) #:timeout 60)) + (define out-dir "/tmp") + + (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 "rootless-podman services started successfully" + (begin + (define (run-test) + (marionette-eval + `(begin + (use-modules (ice-9 popen) + (ice-9 match) + (ice-9 rdelim)) + + (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 slurp + (lambda args + (let* ((port (apply open-pipe* OPEN_READ args)) + (output (read-lines port)) + (status (close-pipe port))) + output))) + (let* ((bash + ,(string-append #$bash "/bin/bash")) + (response1 + (slurp bash "-c" + (string-append "ls -la /sys/fs/cgroup | " + "grep -E ' \\./?$' | awk '{ print $4 }'"))) + (response2 (slurp bash "-c" + (string-append "ls -l /sys/fs/cgroup/cgroup" + ".{procs,subtree_control,threads} | " + "awk '{ print $4 }' | sort -u")))) + (list (string-join response1 "\n") (string-join response2 "\n")))) + marionette)) + ;; Allow services to come up on slower machines + (let loop ((attempts 0)) + (if (= attempts 60) + (error "Services didn't come up after more than 60 seconds") + (if (equal? '("cgroup" "cgroup") + (run-test)) + #t + (begin + (sleep 1) + (format #t "Services didn't come up yet, retrying with attempt ~a~%" + (+ 1 attempts)) + (loop (+ 1 attempts)))))))) + + (test-assert "podman-volumes running" + (begin + (define (run-test) + (marionette-eval + `(begin + (use-modules (srfi srfi-1) + (ice-9 popen) + (ice-9 match) + (ice-9 rdelim)) + + (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 (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 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))) + + (match (primitive-fork) + (0 + (dynamic-wind + (const #f) + (lambda () + (setgid (passwd:gid (getpwnam "oci-container"))) + (setuid (passwd:uid (getpw "oci-container"))) + + (let ((response (slurp + "/run/current-system/profile/bin/podman" + "volume" "ls" "-n" "--format" "\"{{.Name}}\"" + "|" "tr" "' '" "'\n'"))) + + (call-with-output-file (string-append ,out-dir "/response") + (lambda (port) + (display (string-join response "\n") port))))) + (lambda () + (primitive-exit 127)))) + (pid + (cdr (waitpid pid)))) + + (wait-for-file (string-append ,out-dir "/response")) + + (stable-sort + (slurp "cat" (string-append ,out-dir "/response")) + string<=?)) + marionette)) + ;; Allow services to come up on slower machines + (let loop ((attempts 0)) + (if (= attempts 80) + (error "Service didn't come up after more than 80 seconds") + (if (equal? '("my-volume") + (run-test)) + #t + (begin + (sleep 1) + (loop (+ 1 attempts)))))))) + + (test-assert "podman-networks running" + (begin + (define (run-test) + (marionette-eval + `(begin + (use-modules (srfi srfi-1) + (ice-9 popen) + (ice-9 match) + (ice-9 rdelim)) + + (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 (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 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))) + + (match (primitive-fork) + (0 + (dynamic-wind + (const #f) + (lambda () + (setgid (passwd:gid (getpwnam "oci-container"))) + (setuid (passwd:uid (getpw "oci-container"))) + + (let ((response (slurp + "/run/current-system/profile/bin/podman" + "network" "ls" "-n" "--format" "\"{{.Name}}\"" + "|" "tr" "' '" "'\n'"))) + + (call-with-output-file (string-append ,out-dir "/response") + (lambda (port) + (display (string-join response "\n") port))))) + (lambda () + (primitive-exit 127)))) + (pid + (cdr (waitpid pid)))) + + (wait-for-file (string-append ,out-dir "/response")) + + (stable-sort + (slurp "cat" (string-append ,out-dir "/response")) + string<=?)) + marionette)) + ;; Allow services to come up on slower machines + (let loop ((attempts 0)) + (if (= attempts 80) + (error "Service didn't come up after more than 80 seconds") + (if (equal? '("my-network" "podman") + (run-test)) + #t + (begin + (sleep 1) + (loop (+ 1 attempts)))))))) + + (test-assert "first container running" + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (wait-for-service 'first #:timeout 120) + #t) + marionette)) + + (test-assert "second container running" + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (wait-for-service 'second #:timeout 120) + #t) + marionette)) + + (test-assert "passing host environment variables" + (begin + (define (run-test) + (marionette-eval + `(begin + (use-modules (srfi srfi-1) + (ice-9 popen) + (ice-9 match) + (ice-9 rdelim)) + + (define (wait-for-file file) + ;; Wait until FILE shows up. + (let loop ((i 60)) + (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 (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 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))) + + (match (primitive-fork) + (0 + (dynamic-wind + (const #f) + (lambda () + (setgid (passwd:gid (getpwnam "oci-container"))) + (setuid (passwd:uid (getpw "oci-container"))) + + (let ((response (slurp + "/run/current-system/profile/bin/podman" + "exec" "first" + "/bin/guile" "-c" "'(display (getenv \"VARIABLE\"))'"))) + (call-with-output-file (string-append ,out-dir "/response") + (lambda (port) + (display (string-join response "\n") port))))) + (lambda () + (primitive-exit 127)))) + (pid + (cdr (waitpid pid)))) + + (wait-for-file (string-append ,out-dir "/response")) + (slurp "cat" (string-append ,out-dir "/response"))) + marionette)) + ;; Allow image to be loaded on slower machines + (let loop ((attempts 0)) + (if (= attempts 180) + (error "Service didn't come up after more than 180 seconds") + (if (equal? (list "value") + (run-test)) + #t + (begin + (sleep 1) + (loop (+ 1 attempts)))))))) + + (test-equal "mounting host files" + '("hello") + (marionette-eval + `(begin + (use-modules (srfi srfi-1) + (ice-9 popen) + (ice-9 match) + (ice-9 rdelim)) + + (define (wait-for-file file) + ;; Wait until FILE shows up. + (let loop ((i 60)) + (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 (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 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))) + + (match (primitive-fork) + (0 + (dynamic-wind + (const #f) + (lambda () + (setgid (passwd:gid (getpwnam "oci-container"))) + (setuid (passwd:uid (getpw "oci-container"))) + + (let ((response (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)))'"))) + (call-with-output-file (string-append ,out-dir "/response") + (lambda (port) + (display (string-join response " ") port))))) + (lambda () + (primitive-exit 127)))) + (pid + (cdr (waitpid pid)))) + + (wait-for-file (string-append ,out-dir "/response")) + (slurp "cat" (string-append ,out-dir "/response"))) + marionette)) + + (test-equal "write to volumes" + '("world") + (marionette-eval + `(begin + (use-modules (srfi srfi-1) + (ice-9 popen) + (ice-9 match) + (ice-9 rdelim)) + + (define (wait-for-file file) + ;; Wait until FILE shows up. + (let loop ((i 60)) + (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 (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 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))) + + (match (primitive-fork) + (0 + (dynamic-wind + (const #f) + (lambda () + (setgid (passwd:gid (getpwnam "oci-container"))) + (setuid (passwd:uid (getpw "oci-container"))) + + (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))))'") + + (let ((response (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)))'"))) + (call-with-output-file (string-append ,out-dir "/response") + (lambda (port) + (display (string-join response " ") port))))) + (lambda () + (primitive-exit 127)))) + (pid + (cdr (waitpid pid)))) + + (wait-for-file (string-append ,out-dir "/response")) + (slurp "cat" (string-append ,out-dir "/response"))) + marionette)) + + (test-equal "can read ports over network" + '("out of office") + (marionette-eval + `(begin + (use-modules (srfi srfi-1) + (ice-9 popen) + (ice-9 match) + (ice-9 rdelim)) + + (define (wait-for-file file) + ;; Wait until FILE shows up. + (let loop ((i 60)) + (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 (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 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))) + + (match (primitive-fork) + (0 + (dynamic-wind + (const #f) + (lambda () + (setgid (passwd:gid (getpwnam "oci-container"))) + (setuid (passwd:uid (getpw "oci-container"))) + + (let ((response (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))'"))) + (call-with-output-file (string-append ,out-dir "/response") + (lambda (port) + (display (string-join response " ") port))))) + (lambda () + (primitive-exit 127)))) + (pid + (cdr (waitpid pid)))) + + (wait-for-file (string-append ,out-dir "/response")) + (slurp "cat" (string-append ,out-dir "/response"))) + 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-os + (simple-operating-system + (service dhcp-client-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-configuration (name "my-network")))) + (volumes + (list (oci-volume-configuration (name "my-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)(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 services herd) + (guix combinators)))) + + (define vm + (virtual-machine + (operating-system os) + (volatile? #f) + (memory-size 1024) + (disk-image-size (* 3000 (expt 2 20))) + (port-forwardings '()))) + + (define test + (with-imported-modules '((gnu build marionette)) + #~(begin + (use-modules (srfi srfi-11) (srfi srfi-64) + (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) + (marionette-eval + `(begin + (use-modules (ice-9 popen) + (ice-9 rdelim)) + + (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 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))) + + (stable-sort + (slurp + "/run/current-system/profile/bin/docker" + "volume" "ls" "--format" "\"{{.Name}}\"") + string<=?)) + + marionette)) + ;; Allow services to come up on slower machines + (let loop ((attempts 0)) + (if (= attempts 80) + (error "Service didn't come up after more than 80 seconds") + (if (equal? '("my-volume") + (run-test)) + #t + (begin + (sleep 1) + (loop (+ 1 attempts)))))))) + + (test-assert "docker-networks running" + (begin + (define (run-test) + (marionette-eval + `(begin + (use-modules (ice-9 popen) + (ice-9 rdelim)) + + (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 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))) + + (stable-sort + (slurp + "/run/current-system/profile/bin/docker" + "network" "ls" "--format" "\"{{.Name}}\"") + string<=?)) + + marionette)) + ;; Allow services to come up on slower machines + (let loop ((attempts 0)) + (if (= attempts 80) + (error "Service didn't come up after more than 80 seconds") + (if (equal? '("bridge" "host" "my-network" "none") + (run-test)) + #t + (begin + (sleep 1) + (loop (+ 1 attempts)))))))) + + (test-assert "first container running" + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (wait-for-service 'first #:timeout 120) + #t) + marionette)) + + (test-assert "second container running" + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (wait-for-service 'second #:timeout 120) + #t) + marionette)) + + (test-assert "passing host environment variables" + (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))) + + (slurp + "/run/current-system/profile/bin/docker" + "exec" "first" + "/bin/guile" "-c" "(display (getenv \"VARIABLE\"))")) + marionette)) + ;; Allow image to be loaded on slower machines + (let loop ((attempts 0)) + (if (= attempts 180) + (error "Service didn't come up after more than 180 seconds") + (if (equal? "value" + (run-test)) + #t + (begin + (sleep 1) + (loop (+ 1 attempts)))))))) + + (test-equal "mounting host files" + "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))) + + (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 \"/shared.txt\" read-line)))")) + marionette)) + + (test-equal "write to volumes" + "world" + (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))) + + (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 ports over network" + "out of office" + (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))) + + (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)))) -- 2.48.1 From unknown Fri Jun 13 11:55:10 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#76081] [PATCH v2 4/4] tests: Use lower-oci-image-state in container tests. Resent-From: Giacomo Leidi Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sun, 09 Feb 2025 19:16:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 76081 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 76081@debbugs.gnu.org Cc: Giacomo Leidi Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.173912854411343 (code B ref 76081); Sun, 09 Feb 2025 19:16:02 +0000 Received: (at 76081) by debbugs.gnu.org; 9 Feb 2025 19:15:44 +0000 Received: from localhost ([127.0.0.1]:46332 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1thCmN-0002wm-Al for submit@debbugs.gnu.org; Sun, 09 Feb 2025 14:15:44 -0500 Received: from confino.investici.org ([93.190.126.19]:47181) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1thCmJ-0002wC-4b for 76081@debbugs.gnu.org; Sun, 09 Feb 2025 14:15:40 -0500 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org; s=stigmate; t=1739128538; bh=y/zqLPAY9rcNRl2CpnNFoTia9j649oQq7kUfZKh6uC4=; h=From:To:Cc:Subject:Date:In-Reply-To:References:From; b=lMVIjxQyUneR0+QXensJvtvzAHRLbWeh97yIfbhPN4xTav5HD/aL0DOwihmEW1gCi fp6vAC/wp/EmNKnLj+TprQs2q3Tr2sJ2Cc17r66y5qooi0vxIl2uJBW1HosPkjsGsu /rjHTH78XROZtNYbdjxhqxUkHu3Sis/Fl6dEP4x4= Received: from mx1.investici.org (unknown [127.0.0.1]) by confino.investici.org (Postfix) with ESMTP id 4YrcqZ0vPnz11FM; Sun, 9 Feb 2025 19:15:38 +0000 (UTC) Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19]) (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with ESMTPSA id 4YrcqY710Tz11F7; Sun, 9 Feb 2025 19:15:37 +0000 (UTC) From: Giacomo Leidi Date: Sun, 9 Feb 2025 20:15:04 +0100 Message-ID: <10254ceb4ef758730d46c5c30798833f9f592833.1739128504.git.goodoldpaul@autistici.org> X-Mailer: git-send-email 2.48.1 In-Reply-To: <89778533f32ad1388f03414e884fff10f74ef379.1739128504.git.goodoldpaul@autistici.org> References: <89778533f32ad1388f03414e884fff10f74ef379.1739128504.git.goodoldpaul@autistici.org> MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Spam-Score: -0.7 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.7 (-) This patch replaces boilerplate in container related tests with oci-image plumbing from (gnu services containers). * gnu/services/containers.scm: Export lower-oci-image-state. * gnu/tests/containers.scm (%oci-tarball): New variable; (run-rootless-podman-test): use %oci-tarball; (build-tarball&run-rootless-podman-test): drop procedure. * gnu/tests/docker.scm (%docker-tarball): New variable; (build-tarball&run-docker-test): use %docker-tarball; (%docker-system-tarball): New variable; (build-tarball&run-docker-system-test): new procedure. Change-Id: Iad6f0704aee188d89464c83722dea0bb7adb084a --- gnu/services/containers.scm | 35 ++++++++----- gnu/tests/containers.scm | 80 ++++++++++++++--------------- gnu/tests/docker.scm | 100 ++++++++++++++++++++---------------- 3 files changed, 114 insertions(+), 101 deletions(-) diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm index 5c50c99eaf6..2808afe7f08 100644 --- a/gnu/services/containers.scm +++ b/gnu/services/containers.scm @@ -74,6 +74,8 @@ (define-module (gnu services containers) oci-image-system oci-image-grafts? + lower-oci-image-state + oci-container-configuration oci-container-configuration? oci-container-configuration-fields @@ -996,12 +998,9 @@ (define (lower-operating-system os target system) #:target target))) (return tarball))) -(define (lower-manifest name image target system) - "Lower IMAGE, a manifest record, into a tarball containing an OCI image." - (define value (oci-image-value image)) - (define options (oci-image-pack-options image)) - (define image-reference - (oci-image-reference image)) +(define (lower-manifest name value options image-reference + target system grafts?) + "Lower VALUE, a manifest record, into a tarball containing an OCI image." (define image-tag (let* ((extra-options (get-keyword-value options #:extra-options)) @@ -1013,8 +1012,7 @@ (define (lower-manifest name image target system) `(#:extra-options (#:image-tag ,image-reference))))) (mlet* %store-monad - ((_ (set-grafting - (oci-image-grafts? image))) + ((_ (set-grafting grafts?)) (guile (set-guile-for-build (default-guile))) (profile (profile-derivation value @@ -1029,11 +1027,8 @@ (define (lower-manifest name image target system) #:localstatedir? #t)))) (return tarball))) -(define (lower-oci-image name image) - "Lower IMAGE, a oci-image record, into a tarball containing an OCI image." - (define value (oci-image-value image)) - (define image-target (oci-image-target image)) - (define image-system (oci-image-system image)) +(define (lower-oci-image-state name value options reference + image-target image-system grafts?) (define target (if (maybe-value-set? image-target) image-target @@ -1046,7 +1041,8 @@ (define (lower-oci-image name image) (run-with-store store (match value ((? manifest? value) - (lower-manifest name image target system)) + (lower-manifest name value options reference + target system grafts?)) ((? operating-system? value) (lower-operating-system value target system)) ((or (? gexp? value) @@ -1061,6 +1057,17 @@ (define (lower-oci-image name image) #:target target #:system system))) +(define (lower-oci-image name image) + "Lower IMAGE, a oci-image record, into a tarball containing an OCI image." + (lower-oci-image-state + name + (oci-image-value image) + (oci-image-pack-options image) + (oci-image-reference image) + (oci-image-target image) + (oci-image-system image) + (oci-image-grafts? image))) + (define* (oci-image-loader runtime-cli name image tag #:key (verbose? #f)) "Return a file-like object that, once lowered, will evaluate to a program able to load IMAGE through RUNTIME-CLI and to tag it with TAG afterwards." diff --git a/gnu/tests/containers.scm b/gnu/tests/containers.scm index bac1f47bd34..1fcf6be7ace 100644 --- a/gnu/tests/containers.scm +++ b/gnu/tests/containers.scm @@ -69,13 +69,47 @@ (define %rootless-podman-os (supplementary-groups '("wheel" "netdev" "cgroup" "audio" "video"))))))) -(define (run-rootless-podman-test oci-tarball) +(define %oci-tarball + (lower-oci-image-state + "guile-guest" + (packages->manifest + (list + guile-3.0 guile-json-3 + (package + (name "guest-script") + (version "0") + (source #f) + (build-system trivial-build-system) + (arguments `(#:guile ,guile-3.0 + #:builder + (let ((out (assoc-ref %outputs "out"))) + (mkdir out) + (call-with-output-file (string-append out "/a.scm") + (lambda (port) + (display "(display \"hello world\n\")" port))) + #t))) + (synopsis "Display hello world using Guile") + (description "This package displays the text \"hello world\" on the +standard output device and then enters a new line.") + (home-page #f) + (license license:public-domain)))) + '(#:entry-point "bin/guile" + #:localstatedir? #t + #:extra-options (#:image-tag "guile-guest") + #:symlinks (("/bin/Guile" -> "bin/guile") + ("aa.scm" -> "a.scm"))) + "guile-guest" + (%current-target-system) + (%current-system) + #f)) + +(define (run-rootless-podman-test) (define os (marionette-operating-system (operating-system-with-gc-roots %rootless-podman-os - (list oci-tarball)) + (list %oci-tarball)) #:imported-modules '((gnu services herd) (guix combinators)))) @@ -254,7 +288,7 @@ (define (run-rootless-podman-test oci-tarball) (let* ((loaded (slurp ,(string-append #$podman "/bin/podman") "load" "-i" - ,#$oci-tarball)) + ,#$%oci-tarball)) (repository&tag "localhost/guile-guest:latest") (response1 (slurp ,(string-append #$podman "/bin/podman") @@ -307,49 +341,11 @@ (define (run-rootless-podman-test oci-tarball) (gexp->derivation "rootless-podman-test" test)) -(define (build-tarball&run-rootless-podman-test) - (mlet* %store-monad - ((_ (set-grafting #f)) - (guile (set-guile-for-build (default-guile))) - (guest-script-package -> - (package - (name "guest-script") - (version "0") - (source #f) - (build-system trivial-build-system) - (arguments `(#:guile ,guile-3.0 - #:builder - (let ((out (assoc-ref %outputs "out"))) - (mkdir out) - (call-with-output-file (string-append out "/a.scm") - (lambda (port) - (display "(display \"hello world\n\")" port))) - #t))) - (synopsis "Display hello world using Guile") - (description "This package displays the text \"hello world\" on the -standard output device and then enters a new line.") - (home-page #f) - (license license:public-domain))) - (profile (profile-derivation (packages->manifest - (list guile-3.0 guile-json-3 - guest-script-package)) - #:hooks '() - #:locales? #f)) - (tarball (pack:docker-image - "docker-pack" profile - #:symlinks '(("/bin/Guile" -> "bin/guile") - ("aa.scm" -> "a.scm")) - #:extra-options - '(#:image-tag "guile-guest") - #:entry-point "bin/guile" - #:localstatedir? #t))) - (run-rootless-podman-test tarball))) - (define %test-rootless-podman (system-test (name "rootless-podman") (description "Test rootless Podman service.") - (value (build-tarball&run-rootless-podman-test)))) + (value (run-rootless-podman-test)))) (define %oci-rootless-podman-os diff --git a/gnu/tests/docker.scm b/gnu/tests/docker.scm index 5dcf05a17e3..07edd9d5341 100644 --- a/gnu/tests/docker.scm +++ b/gnu/tests/docker.scm @@ -26,6 +26,7 @@ (define-module (gnu tests docker) #:use-module (gnu system image) #:use-module (gnu system vm) #:use-module (gnu services) + #:use-module (gnu services containers) #:use-module (gnu services dbus) #:use-module (gnu services networking) #:use-module (gnu services docker) @@ -57,6 +58,40 @@ (define %docker-os (service containerd-service-type) (service docker-service-type))) +(define %docker-tarball + (lower-oci-image-state + "guile-guest" + (packages->manifest + (list + guile-3.0 guile-json-3 + (package + (name "guest-script") + (version "0") + (source #f) + (build-system trivial-build-system) + (arguments `(#:guile ,guile-3.0 + #:builder + (let ((out (assoc-ref %outputs "out"))) + (mkdir out) + (call-with-output-file (string-append out "/a.scm") + (lambda (port) + (display "(display \"hello world\n\")" port))) + #t))) + (synopsis "Display hello world using Guile") + (description "This package displays the text \"hello world\" on the +standard output device and then enters a new line.") + (home-page #f) + (license license:public-domain)))) + '(#:entry-point "bin/guile" + #:localstatedir? #t + #:extra-options (#:image-tag "guile-guest") + #:symlinks (("/bin/Guile" -> "bin/guile") + ("aa.scm" -> "a.scm"))) + "guile-guest" + (%current-target-system) + (%current-system) + #f)) + (define (run-docker-test docker-tarball) "Load DOCKER-TARBALL as Docker image and run it in a Docker container, inside %DOCKER-OS." @@ -173,40 +208,7 @@ (define (run-docker-test docker-tarball) (gexp->derivation "docker-test" test)) (define (build-tarball&run-docker-test) - (mlet* %store-monad - ((_ (set-grafting #f)) - (guile (set-guile-for-build (default-guile))) - (guest-script-package -> - (package - (name "guest-script") - (version "0") - (source #f) - (build-system trivial-build-system) - (arguments `(#:guile ,guile-3.0 - #:builder - (let ((out (assoc-ref %outputs "out"))) - (mkdir out) - (call-with-output-file (string-append out "/a.scm") - (lambda (port) - (display "(display \"hello world\n\")" port))) - #t))) - (synopsis "Display hello world using Guile") - (description "This package displays the text \"hello world\" on the -standard output device and then enters a new line.") - (home-page #f) - (license license:public-domain))) - (profile (profile-derivation (packages->manifest - (list guile-3.0 guile-json-3 - guest-script-package)) - #:hooks '() - #:locales? #f)) - (tarball (pack:docker-image - "docker-pack" profile - #:symlinks '(("/bin/Guile" -> "bin/guile") - ("aa.scm" -> "a.scm")) - #:entry-point "bin/guile" - #:localstatedir? #t))) - (run-docker-test tarball))) + (run-docker-test %docker-tarball)) (define %test-docker (system-test @@ -215,8 +217,22 @@ (define %test-docker (value (build-tarball&run-docker-test)))) +(define %docker-system-tarball + (lower-oci-image-state + "guix-system-guest" + (operating-system + (inherit (simple-operating-system)) + ;; Use locales for a single libc to + ;; reduce space requirements. + (locale-libcs (list glibc))) + '() + "guix-system-guest" + (%current-target-system) + (%current-system) + #f)) + (define (run-docker-system-test tarball) - "Load DOCKER-TARBALL as Docker image and run it in a Docker container, + "Load TARBALL as Docker image and run it in a Docker container, inside %DOCKER-OS." (define os (marionette-operating-system @@ -333,21 +349,15 @@ (define (run-docker-system-test tarball) (gexp->derivation "docker-system-test" test)) +(define (build-tarball&run-docker-system-test) + (run-docker-system-test %docker-system-tarball)) + (define %test-docker-system (system-test (name "docker-system") (description "Run a system image as produced by @command{guix system docker-image} inside Docker.") - (value (with-monad %store-monad - (>>= (lower-object - (system-image (os->image - (operating-system - (inherit (simple-operating-system)) - ;; Use locales for a single libc to - ;; reduce space requirements. - (locale-libcs (list glibc))) - #:type docker-image-type))) - run-docker-system-test))))) + (value (build-tarball&run-docker-system-test)))) (define %oci-os -- 2.48.1 From unknown Fri Jun 13 11:55:10 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#76081] [PATCH v2 2/4] services: oci-container-configuration: Move to (gnu services containers). Resent-From: Giacomo Leidi Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sun, 09 Feb 2025 19:16:03 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 76081 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 76081@debbugs.gnu.org Cc: Giacomo Leidi Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.173912855011362 (code B ref 76081); Sun, 09 Feb 2025 19:16:03 +0000 Received: (at 76081) by debbugs.gnu.org; 9 Feb 2025 19:15:50 +0000 Received: from localhost ([127.0.0.1]:46334 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1thCmS-0002x8-8Z for submit@debbugs.gnu.org; Sun, 09 Feb 2025 14:15:50 -0500 Received: from confino.investici.org ([93.190.126.19]:39077) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1thCmI-0002w9-UR for 76081@debbugs.gnu.org; Sun, 09 Feb 2025 14:15:42 -0500 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org; s=stigmate; t=1739128537; bh=C6uHhY9S9WpgPkIaaAgAOz8vooJK2RfngRRsEihvD9o=; h=From:To:Cc:Subject:Date:In-Reply-To:References:From; b=l9c9NNJ0ugtilFgLhw/3XTinhmOrUk/BLtQku0AVdMdbtVE2jld8Q0q/UcfuXwppS cLgtUptwqDzvkDtaYtEzzu8ts2o28QVy0uX0whuy4A3FzcAc8LOn6jDzrzdR7m5oga wrN8cIA8R4h7cax6g4YUSgeAIozpoBaH1Oj0BATA= Received: from mx1.investici.org (unknown [127.0.0.1]) by confino.investici.org (Postfix) with ESMTP id 4YrcqY2JbCz11Df; Sun, 9 Feb 2025 19:15:37 +0000 (UTC) Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19]) (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with ESMTPSA id 4YrcqY13xKz11F7; Sun, 9 Feb 2025 19:15:37 +0000 (UTC) From: Giacomo Leidi Date: Sun, 9 Feb 2025 20:15:02 +0100 Message-ID: <92f19ba6c0842885735dfce653eef535360085f4.1739128504.git.goodoldpaul@autistici.org> X-Mailer: git-send-email 2.48.1 In-Reply-To: <89778533f32ad1388f03414e884fff10f74ef379.1739128504.git.goodoldpaul@autistici.org> References: <89778533f32ad1388f03414e884fff10f74ef379.1739128504.git.goodoldpaul@autistici.org> MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit X-Spam-Score: -0.7 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.7 (-) 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 dc66ac4f967..50bf6c05549 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 +;;; Copyright © 2024, 2025 Giacomo Leidi ;;; ;;; This file is part of GNU Guix. ;;; @@ -17,19 +17,31 @@ ;;; along with GNU Guix. If not, see . (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) @@ -188,7 +237,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 @@ -242,3 +291,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 3af0f792701..69ff9f1d9e4 100644 --- a/gnu/services/docker.scm +++ b/gnu/services/docker.scm @@ -5,7 +5,7 @@ ;;; Copyright © 2020 Efraim Flashner ;;; Copyright © 2020 Jesse Dowell ;;; Copyright © 2021 Brice Waegeneire -;;; Copyright © 2023, 2024 Giacomo Leidi +;;; Copyright © 2023, 2024, 2025 Giacomo Leidi ;;; ;;; This file is part of GNU Guix. ;;; @@ -23,72 +23,60 @@ ;;; along with GNU Guix. If not, see . (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) @@ -307,495 +295,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} 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"))))) - (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 ;;; Copyright © 2019-2023 Ludovic Courtès -;;; Copyright © 2024 Giacomo Leidi +;;; Copyright © 2024, 2025 Giacomo Leidi ;;; ;;; 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 From unknown Fri Jun 13 11:55:10 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#76081] OCI provisioning service Resent-From: paul Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sun, 09 Feb 2025 20:39:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 76081 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 76081@debbugs.gnu.org Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.173913353526677 (code B ref 76081); Sun, 09 Feb 2025 20:39:02 +0000 Received: (at 76081) by debbugs.gnu.org; 9 Feb 2025 20:38:55 +0000 Received: from localhost ([127.0.0.1]:46571 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1thE4t-0006wD-Cf for submit@debbugs.gnu.org; Sun, 09 Feb 2025 15:38:55 -0500 Received: from confino.investici.org ([2a11:7980:1::2:0]:32661) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1thE4q-0006vx-Dh for 76081@debbugs.gnu.org; Sun, 09 Feb 2025 15:38:53 -0500 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org; s=stigmate; t=1739133528; bh=HYtwwBuGG4jF0I3GDdJnb1K+l+dEy4xSfBm1X561Jto=; h=Date:Subject:From:To:References:In-Reply-To:From; b=YmyQ2804d5IMCGyG8BQF2OaWM8GoHlxT8E/hHkO8O8bKV25vPtm4Tbs3xTK2E9Ksg qnX1+kNsGu3gztf7zd4Q77kKgzbk1oMd3NrZ3dXsJgBTzsT2stZXuQ2mqTN8m27b+R 7Lu2KeLSJY89pVRkGr7jJ3ihfmnt2C1EOJMpzPi4= Received: from mx1.investici.org (unknown [127.0.0.1]) by confino.investici.org (Postfix) with ESMTP id 4YrfgX3QgQz112M for <76081@debbugs.gnu.org>; Sun, 9 Feb 2025 20:38:48 +0000 (UTC) Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19]) (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with ESMTPSA id 4YrfgX2tMCz112H for <76081@debbugs.gnu.org>; Sun, 9 Feb 2025 20:38:48 +0000 (UTC) Message-ID: Date: Sun, 9 Feb 2025 21:38:47 +0100 MIME-Version: 1.0 User-Agent: Icedove Daily From: paul References: Content-Language: en-US In-Reply-To: Content-Type: text/plain; charset=UTF-8; format=flowed Content-Transfer-Encoding: 7bit X-Spam-Score: -0.0 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) I'm sending a v3 fixing a bug in the merge algorithm for volumes and networks. On 2/9/25 20:14, paul wrote: > Hi, > > I'm about to send a v2. v2 compared to the first revision features: > > > - it actually compiles all the times :) (rev 1 referenced oci-image > too early for it to be working and generated a compile time error, if > you recompiled it sometimes went away so I thought it was a problem of > my setup. CI caught this) > - it allows more values to be overridden by eventual users of the > Scheme API > - it allows passing extra arguments directly after each podman or > docker invokation, allowing for example for overriding podman --root > and similar options. > > All of these tests should pass: > > guix shell -D guix -CPW -- make check-system TESTS="oci-container > oci-service-rootless-podman docker docker-system rootless-podman > oci-service-docker" > > > Thank you for your work, > > giacomo > From unknown Fri Jun 13 11:55:10 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#76081] [PATCH v3 1/4] services: rootless-podman: Use login shell. References: <2f43e635-508c-407a-8309-06e75d492d89@autistici.org> In-Reply-To: <2f43e635-508c-407a-8309-06e75d492d89@autistici.org> Resent-From: Giacomo Leidi Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sun, 09 Feb 2025 20:40:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 76081 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 76081@debbugs.gnu.org Cc: Giacomo Leidi Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.173913355926760 (code B ref 76081); Sun, 09 Feb 2025 20:40:02 +0000 Received: (at 76081) by debbugs.gnu.org; 9 Feb 2025 20:39:19 +0000 Received: from localhost ([127.0.0.1]:46577 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1thE5G-0006xW-PS for submit@debbugs.gnu.org; Sun, 09 Feb 2025 15:39:19 -0500 Received: from confino.investici.org ([93.190.126.19]:25459) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1thE5E-0006x7-MF for 76081@debbugs.gnu.org; Sun, 09 Feb 2025 15:39:17 -0500 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org; s=stigmate; t=1739133555; bh=IdX9voWndJaRYrFOGe4a/X2LYvkwV0vTWt7K16N+Iog=; h=From:To:Cc:Subject:Date:From; b=OBJmgYJnfwBQc7cX3iPMCaQaXiPgJbLbJnXXZHrwbpf3oXUT7voV6DnB7/rPtfIqI vg3cDDA2ZtzVVKdhVWNvGJIPYd246cKG3orv1N9zIGQ82Ranig2rY8Q9rbcf42EH57 lw/c2M7hRTIl4LRSbeVdHFt2YQqD87FLVy+/t1BI= Received: from mx1.investici.org (unknown [127.0.0.1]) by confino.investici.org (Postfix) with ESMTP id 4Yrfh31X9rz112M; Sun, 9 Feb 2025 20:39:15 +0000 (UTC) Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19]) (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with ESMTPSA id 4Yrfh30Plsz112H; Sun, 9 Feb 2025 20:39:15 +0000 (UTC) From: Giacomo Leidi Date: Sun, 9 Feb 2025 21:39:05 +0100 Message-ID: <89778533f32ad1388f03414e884fff10f74ef379.1739133548.git.goodoldpaul@autistici.org> X-Mailer: git-send-email 2.48.1 MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Spam-Score: -0.7 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.7 (-) This commit allows for having PATH set when changing the owner of /sys/fs/group. * gnu/services/containers.scm (crgroups-fs-owner): Use login shell. Change-Id: I9510c637a5332325e05ca5ebc9dfd4de32685c50 --- gnu/services/containers.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm index 19d35ccbcb6..dc66ac4f967 100644 --- a/gnu/services/containers.scm +++ b/gnu/services/containers.scm @@ -140,7 +140,7 @@ (define (cgroups-fs-owner-entrypoint config) (rootless-podman-configuration-group-name config)) (program-file "cgroups2-fs-owner-entrypoint" #~(system* - (string-append #+bash-minimal "/bin/bash") "-c" + (string-append #+bash-minimal "/bin/bash") "-l" "-c" (string-append "echo Setting /sys/fs/cgroup " "group ownership to " #$group " && chown -v " "root:" #$group " /sys/fs/cgroup && " base-commit: 5a897c5c95a81278b044c18d962d3bd83131ba06 -- 2.48.1 From unknown Fri Jun 13 11:55:10 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#76081] [PATCH v3 3/4] services: Add oci-service-type. Resent-From: Giacomo Leidi Original-Sender: "Debbugs-submit" Resent-CC: ludo@gnu.org, maxim.cournoyer@gmail.com, guix-patches@gnu.org Resent-Date: Sun, 09 Feb 2025 20:40:03 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 76081 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 76081@debbugs.gnu.org Cc: Giacomo Leidi , Ludovic =?UTF-8?Q?Court=C3=A8s?= , Maxim Cournoyer X-Debbugs-Original-Xcc: Ludovic =?UTF-8?Q?Court=C3=A8s?= , Maxim Cournoyer Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.173913355926766 (code B ref 76081); Sun, 09 Feb 2025 20:40:03 +0000 Received: (at 76081) by debbugs.gnu.org; 9 Feb 2025 20:39:19 +0000 Received: from localhost ([127.0.0.1]:46579 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1thE5H-0006xa-9x for submit@debbugs.gnu.org; Sun, 09 Feb 2025 15:39:19 -0500 Received: from confino.investici.org ([93.190.126.19]:27355) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1thE5F-0006xA-4O for 76081@debbugs.gnu.org; Sun, 09 Feb 2025 15:39:17 -0500 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org; s=stigmate; t=1739133556; bh=cx52ch+QeD6GNDq7ORhibtW/Xhi7HnMWUEySPhIXRaA=; h=From:To:Cc:Subject:Date:In-Reply-To:References:From; b=G8I14Agm19qaQZ3LTQ9xzVJ/sY0AFC/klqETL9ciktAOsURyIwNSxGD+sIi6408jc 0nz6KM3OMWYVHAAWeXJeDY3lH9hh1ezbNFHNiFcb4v0GabXsOodmkk71ip0cB5mWkG EtE4c5g2FHmPRCEcNwHhdtm5FZILEqtay6oNfl7Y= Received: from mx1.investici.org (unknown [127.0.0.1]) by confino.investici.org (Postfix) with ESMTP id 4Yrfh41Y7Gz112l; Sun, 9 Feb 2025 20:39:16 +0000 (UTC) Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19]) (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with ESMTPSA id 4Yrfh36l0Wz112H; Sun, 9 Feb 2025 20:39:15 +0000 (UTC) From: Giacomo Leidi Date: Sun, 9 Feb 2025 21:39:07 +0100 Message-ID: <5fa06184f4690fd44c553972dad855feaf7491f5.1739133548.git.goodoldpaul@autistici.org> X-Mailer: git-send-email 2.48.1 In-Reply-To: <89778533f32ad1388f03414e884fff10f74ef379.1739133548.git.goodoldpaul@autistici.org> References: <89778533f32ad1388f03414e884fff10f74ef379.1739133548.git.goodoldpaul@autistici.org> MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" 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/services/containers.scm (%oci-supported-runtimes): New variable; (oci-runtime-cli): new variable; (oci-runtime-name): new variable; (oci-network-configuration): new variable; (oci-volume-configuration): new variable; (oci-configuration): new variable; (oci-extension): new variable; (oci-networks-shepherd-name): new variable; (oci-service-type): new variable; (oci-state->shepherd-services): new variable. * doc/guix.texi: Document it. * gnu/tests/containers.scm: Test it. * gnu/services/docker.scm: Deprecate the oci-container-service-type. Change-Id: I656b3db85832e42d53072fcbfb91d1226f39ef38 --- doc/guix.texi | 299 ++++++++-- gnu/services/containers.scm | 1086 +++++++++++++++++++++++++++++++---- gnu/services/docker.scm | 37 +- gnu/tests/containers.scm | 999 +++++++++++++++++++++++++++++++- 4 files changed, 2225 insertions(+), 196 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index bb5f29277fb..8f66b35297b 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -41778,59 +41778,159 @@ Miscellaneous Services @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: given an -@acronym{Open Container Initiative, OCI} container image, it will run it in a +Should you wish to manage your @acronym{Open Container Initiative, OCI} containers +with the same consistent interface you use for your other Shepherd services, +@var{oci-service-type} is the tool to use: given an +OCI container image, it will run it in a Shepherd service. One example where this is useful: it lets you run services -that are available as Docker/OCI images but not yet packaged for Guix. +that are available as OCI images but not yet packaged for Guix. -@defvar oci-container-service-type +@defvar oci-service-type -This is a thin wrapper around Docker's CLI that executes OCI images backed +This is a thin wrapper around Docker's or Podman's CLI that executes OCI images backed processes as Shepherd Services. @lisp -(service oci-container-service-type - (list - (oci-container-configuration - (network "host") - (image - (oci-image - (repository "guile") - (tag "3") - (value (specifications->manifest '("guile"))) - (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile")) - #:max-layers 2)))) - (entrypoint "/bin/guile") - (command - '("-c" "(display \"hello!\n\")"))) - (oci-container-configuration - (image "prom/prometheus") - (ports - '(("9000" . "9000") - ("9090" . "9090")))) - (oci-container-configuration - (image "grafana/grafana:10.0.1") - (network "host") - (volumes - '("/var/lib/grafana:/var/lib/grafana"))))) +(simple-service 'oci-provisioning + oci-service-type + (oci-extension + (networks + (list + (oci-network-configuration (name "monitoring")))) + (containers + (list + (oci-container-configuration + (network "monitoring") + (image + (oci-image + (repository "guile") + (tag "3") + (value (specifications->manifest '("guile"))) + (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile")) + #:max-layers 2)))) + (entrypoint "/bin/guile") + (command + '("-c" "(display \"hello!\n\")"))) + (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 In this example three different Shepherd services are going to be added to the system. Each @code{oci-container-configuration} record translates to a -@code{docker run} invocation and its fields directly map to options. You can -refer to the -@url{https://docs.docker.com/engine/reference/commandline/run,upstream} -documentation for the semantics of each value. If the images are not found, -they will be -@url{https://docs.docker.com/engine/reference/commandline/pull/,pulled}. The +@command{docker run} or @command{podman run} invocation and its fields directly +map to options. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html,Podman} +upstream documentation for semantics of each value. If the images are not found, +they will be pulled. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/pull/,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-pull.1.html,Podman} +upstream documentation for semantics. The services with @code{(network "host")} are going to be attached to the host network and are supposed to behave like native processes with regard to networking. @end defvar +@c %start of fragment + +@deftp {Data Type} oci-configuration +Available @code{oci-configuration} fields are: + +@table @asis +@item @code{runtime} (default: @code{'docker}) (type: symbol) +The OCI runtime to use to run commands. It can be either @code{'docker} or +@code{'podman}. + +@item @code{runtime-cli} (type: maybe-package) +The OCI runtime command line to be installed in the system profile and used +to provision OCI resources. When unset it will default to @code{docker-cli} +package for the @code{'docker} runtime or to @code{podman} package for the +@code{'podman} runtime. + +@item @code{runtime-extra-arguments} (default: @code{'()}) (type: list) +A list of strings, gexps or file-like objects that will be placed +after each @command{docker} or @command{podman} invokation. + +@item @code{user} (default: @code{"oci-container"}) (type: string) +The user name under whose authority OCI commands will be run. + +@item @code{group} (default: @code{"docker"}) (type: string) +The group name under whose authority OCI commands will be run. When +using the @code{'podman} OCI runtime, this field will be ignored and the +default group of the user configured in the @code{user} field will be used. + +@item @code{subuids-range} (type: maybe-subid-range) +An optional @code{subid-range} record allocating subuids for the user from +the @code{user} field. When unset, with the rootless Podman OCI runtime, it +defaults to @code{(subid-range (name "oci-container"))}. + +@item @code{subgids-range} (type: maybe-subid-range) +An optional @code{subid-range} record allocating subgids for the user from +the @code{user} field. When unset, with the rootless Podman OCI runtime, it +defaults to @code{(subid-range (name "oci-container"))}. + +@item @code{containers} (default: @code{'()}) (type: list-of-oci-containers) +The list of @code{oci-container-configuration} records representing the +containers to provision. Most users are supposed not to use this field and use +the @code{oci-extension} record instead. + +@item @code{networks} (default: @code{'()}) (type: list-of-oci-networks) +The list of @code{oci-network-configuration} records representing the +containers to provision. Most users are supposed not to use this field and use +the @code{oci-extension} record instead. + +@item @code{volumes} (default: @code{'()}) (type: list-of-oci-volumes) +The list of @code{oci-volumes-configuration} records representing the +containers to provision. Most users are supposed not to use this field and use +the @code{oci-extension} record instead. + +@item @code{verbose?} (default: @code{#f}) (type: boolean) +When true, additional output will be printed, allowing to better follow the +flow of execution. + +@end table + +@end deftp + + +@c %end of fragment + +@c %start of fragment + +@deftp {Data Type} oci-extension +Available @code{oci-extension} fields are: + +@table @asis +@item @code{containers} (default: @code{'()}) (type: list-of-oci-containers) +The list of @code{oci-container-configuration} records representing the +containers to provision. + +@item @code{networks} (default: @code{'()}) (type: list-of-oci-networks) +The list of @code{oci-network-configuration} records representing the +containers to provision. + +@item @code{volumes} (default: @code{'()}) (type: list-of-oci-volumes) +The list of @code{oci-volumes-configuration} records representing the +containers to provision. + +@end table + +@end deftp + + +@c %end of fragment + + @c %start of fragment @deftp {Data Type} oci-container-configuration @@ -41850,16 +41950,16 @@ Miscellaneous Services Overwrite the default entrypoint (@code{ENTRYPOINT}) of the image. @item @code{host-environment} (default: @code{'()}) (type: 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 +Set environment variables in the host environment where @command{docker run} +or @command{podman run} are invoked. This is especially useful to pass secrets +from the host to the container without having them on the OCI runtime command line, +for example: by setting the @code{MYSQL_PASSWORD} on the host and by passing @code{--env MYSQL_PASSWORD} through the @code{extra-arguments} field, it is possible to securely set values in the container environment. This field's value can be a list of pairs or strings, even mixed: @lisp -(list '("LANGUAGE\" . "eo:ca:eu") +(list '("LANGUAGE" . "eo:ca:eu") "JAVA_HOME=/opt/java") @end lisp @@ -41867,22 +41967,24 @@ Miscellaneous Services directly to @code{make-forkexec-constructor}. @item @code{environment} (default: @code{'()}) (type: list) -Set environment variables. This can be a list of pairs or strings, even mixed: +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 -@uref{https://docs.docker.com/engine/reference/commandline/run/#env,upstream} -documentation for semantics. +Pair members can be strings, gexps or file-like objects. Strings are passed +directly to the OCI runtime CLI. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run/#env,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#env-e-env,Podman} +upstream documentation for semantics. @item @code{image} (type: 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{oci-image} record. Strings are resolved by the OCI runtime, +and follow the usual format @code{myregistry.local:5000/testing/test-image:tag}. @item @code{provision} (default: @code{""}) (type: string) @@ -41910,7 +42012,7 @@ Miscellaneous Services by the service. @item @code{network} (default: @code{""}) (type: string) -Set a Docker network for the spawned container. +Set an OCI 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 @@ -41921,10 +42023,11 @@ Miscellaneous Services "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 -@uref{https://docs.docker.com/engine/reference/commandline/run/#publish,upstream} -documentation for semantics. +Pair members can be strings, gexps or file-like objects. Strings are passed +directly to the OCI runtime CLI. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run/#publish,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#publish-p-ip-hostport-containerport-protocol,Podman} +upstream documentation for semantics. @item @code{volumes} (default: @code{'()}) (type: list) Set volume mappings for the spawned container. This can be a @@ -41935,25 +42038,95 @@ Miscellaneous Services "/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 -@uref{https://docs.docker.com/engine/reference/commandline/run/#volume,upstream} -documentation for semantics. +Pair members can be strings, gexps or file-like objects. Strings are passed +directly to the OCI runtime CLI. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run/#volume,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#volume-v-source-volume-host-dir-container-dir-options,Podman} +upstream documentation for semantics. @item @code{container-user} (default: @code{""}) (type: 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. +@url{https://docs.docker.com/engine/reference/run/#user,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#user-u-user-group,Podman} +upstream documentation for semantics. @item @code{workdir} (default: @code{""}) (type: string) Set the current working directory for the spawned Shepherd service. You can refer to the -@url{https://docs.docker.com/engine/reference/run/#workdir,upstream} -documentation for semantics. +@url{https://docs.docker.com/engine/reference/run/#workdir,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#workdir-w-dir,Podman} +upstream documentation for semantics. + +@item @code{extra-arguments} (default: @code{'()}) (type: list) +A list of strings, gexps or file-like objects that will be directly passed +to the @command{docker run} or @command{podman run} invokation. + +@end table + +@end deftp + + +@c %end of fragment + +@c %start of fragment + +@deftp {Data Type} oci-network-configuration +Available @code{oci-network-configuration} fields are: + +@table @asis +@item @code{name} (type: string) +The name of the OCI network to provision. + +@item @code{driver} (type: maybe-string) +The driver to manage the network. + +@item @code{gateway} (type: maybe-string) +IPv4 or IPv6 gateway for the subnet. + +@item @code{internal?} (default: @code{#f}) (type: boolean) +Restrict external access to the network + +@item @code{ip-range} (type: maybe-string) +Allocate container ip from a sub-range in CIDR format. + +@item @code{ipam-driver} (type: maybe-string) +IP Address Management Driver. + +@item @code{ipv6?} (default: @code{#f}) (type: boolean) +Enable IPv6 networking. + +@item @code{subnet} (type: maybe-string) +Subnet in CIDR format that represents a network segment. + +@item @code{labels} (default: @code{'()}) (type: list) +The list of labels that will be used to tag the current volume. + +@item @code{extra-arguments} (default: @code{'()}) (type: list) +A list of strings, gexps or file-like objects that will be directly +passed to the runtime invokation. + +@end table + +@end deftp + + +@c %end of fragment + +@c %start of fragment + +@deftp {Data Type} oci-volume-configuration +Available @code{oci-volume-configuration} fields are: + +@table @asis +@item @code{name} (type: string) +The name of the OCI volume to provision. + +@item @code{labels} (default: @code{'()}) (type: list) +The list of labels that will be used to tag the current volume. @item @code{extra-arguments} (default: @code{'()}) (type: list) A list of strings, gexps or file-like objects that will be directly -passed to the @command{docker run} invocation. +passed to the runtime invokation. @end table diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm index 50bf6c05549..12c509c07ab 100644 --- a/gnu/services/containers.scm +++ b/gnu/services/containers.scm @@ -41,6 +41,7 @@ (define-module (gnu services containers) #:use-module ((guix scripts pack) #:prefix pack:) #:use-module (guix store) #:use-module (srfi srfi-1) + #:use-module (ice-9 format) #:use-module (ice-9 match) #:export (rootless-podman-configuration rootless-podman-configuration? @@ -96,8 +97,72 @@ (define-module (gnu services containers) oci-container-configuration-workdir oci-container-configuration-extra-arguments + list-of-oci-containers? + list-of-oci-networks? + list-of-oci-volumes? + + %oci-supported-runtimes + oci-sanitize-runtime + oci-runtime-system-environment + oci-runtime-system-extra-arguments + oci-runtime-system-group + oci-runtime-system-requirement + oci-runtime-cli + oci-runtime-system-cli + oci-runtime-name + oci-runtime-group + + oci-network-configuration + oci-network-configuration? + oci-network-configuration-fields + oci-network-configuration-name + oci-network-configuration-driver + oci-network-configuration-gateway + oci-network-configuration-internal? + oci-network-configuration-ip-range + oci-network-configuration-ipam-driver + oci-network-configuration-ipv6? + oci-network-configuration-subnet + oci-network-configuration-labels + oci-network-configuration-extra-arguments + + oci-volume-configuration + oci-volume-configuration? + oci-volume-configuration-fields + oci-volume-configuration-name + oci-volume-configuration-labels + oci-volume-configuration-extra-arguments + + oci-configuration + oci-configuration? + oci-configuration-fields + oci-configuration-runtime + oci-configuration-runtime-cli + oci-configuration-runtime-extra-arguments + oci-configuration-user + oci-configuration-group + oci-configuration-containers + oci-configuration-networks + oci-configuration-volumes + oci-configuration-verbose? + + oci-extension + oci-extension? + oci-extension-fields + oci-extension-containers + oci-extension-networks + oci-extension-volumes + + oci-networks-shepherd-name + oci-volumes-shepherd-name + oci-container-shepherd-service - %oci-container-accounts)) + oci-service-type + oci-service-accounts + oci-service-profile + oci-service-subids + oci-state->shepherd-services + oci-configuration->shepherd-services)) (define (gexp-or-string? value) (or (gexp? value) @@ -294,9 +359,42 @@ (define rootless-podman-service-type ;;; -;;; OCI container. +;;; OCI provisioning service. ;;; +(define %oci-supported-runtimes + '(docker podman)) + +(define (oci-runtime-system-requirement runtime) + "Return a list of Shepherd service names required by a given OCI runtime, +before it is able to run containers." + (if (eq? 'podman runtime) + '(cgroups2-fs-owner cgroups2-limits + rootless-podman-shared-root-fs user-processes) + '(dockerd user-processes))) + +(define (oci-runtime-name runtime) + "Return a human readable name for a given OCI runtime." + (if (eq? 'podman runtime) + "Podman" "Docker")) + +(define (oci-runtime-group runtime maybe-group) + "Implement the logic behind selection of the group that is to be used by +Shepherd to execute OCI commands." + (if (maybe-value-set? maybe-group) + maybe-group + (if (eq? 'podman runtime) + "cgroup" + "docker"))) + +(define (oci-sanitize-runtime value) + (unless (member value %oci-supported-runtimes) + (raise + (formatted-message + (G_ "OCI runtime must be a symbol and one of ~a, +but ~a was found") %oci-supported-runtimes value))) + value) + (define (oci-sanitize-pair pair delimiter) (define (valid? member) (or (string? member) @@ -345,6 +443,11 @@ (define (oci-sanitize-volumes value) ;; '(("/mnt/dir" . "/dir") "/run/current-system/profile:/java") (oci-sanitize-mixed-list "volumes" value ":")) +(define (oci-sanitize-labels value) + ;; Expected spec format: + ;; '(("foo" . "bar") "foo=bar") + (oci-sanitize-mixed-list "labels" value "=")) + (define (oci-sanitize-shepherd-actions value) (map (lambda (el) @@ -372,6 +475,7 @@ (define (oci-sanitize-extra-arguments value) value)) (define (oci-image-reference image) + "Return a string OCI image reference representing IMAGE." (if (string? image) image (string-append (oci-image-repository image) @@ -390,7 +494,19 @@ (define (string-or-oci-image? image) (define list-of-symbols? (list-of symbol?)) +(define (list-of-oci-records? name predicate value) + (map + (lambda (el) + (if (predicate el) + el + (raise + (formatted-message + (G_ "~a contains an illegal value: ~a") name el)))) + value)) + (define-maybe/no-serialization string) +(define-maybe/no-serialization package) +(define-maybe/no-serialization subid-range) (define-configuration/no-serialization oci-image (repository @@ -436,10 +552,12 @@ (define-configuration/no-serialization oci-image (define-configuration/no-serialization oci-container-configuration (user (string "oci-container") - "The user under whose authority docker commands will be run.") + "The user name under whose authority OCI commands will be run.") (group (string "docker") - "The group under whose authority docker commands will be run.") + "The group name under whose authority OCI commands will be run. When +using the @code{'podman} OCI runtime, this field will be ignored and the +default group of the user configured in the @code{user} field will be used.") (command (list-of-strings '()) "Overwrite the default command (@code{CMD}) of the image.") @@ -449,9 +567,9 @@ (define-configuration/no-serialization oci-container-configuration (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 +or @command{podman run} are invoked. This is especially useful to pass secrets +from the host to the container without having them on the OCI runtime command line, +for example: by setting the @code{MYSQL_PASSWORD} on the host and by passing @code{--env MYSQL_PASSWORD} through the @code{extra-arguments} field, it is possible to securely set values in the container environment. This field's value can be a list of pairs or strings, even mixed: @@ -475,15 +593,16 @@ (define-configuration/no-serialization oci-container-configuration @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." +directly to the OCI runtime CLI. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run/#env,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#env-e-env,Podman} +upstream documentation for semantics." (sanitizer oci-sanitize-environment)) (image (string-or-oci-image) "The image used to build the container. It can be a string or an -@code{oci-image} record. Strings are resolved by the Docker -Engine, and follow the usual format +@code{oci-image} record. Strings are resolved by the OCI runtime, +and follow the usual format @code{myregistry.local:5000/testing/test-image:tag}.") (provision (maybe-string) @@ -512,7 +631,7 @@ (define-configuration/no-serialization oci-container-configuration (sanitizer oci-sanitize-shepherd-actions)) (network (maybe-string) - "Set a Docker network for the spawned container.") + "Set an OCI network for the spawned container.") (ports (list '()) "Set the port or port ranges to expose from the spawned container. This can @@ -524,9 +643,10 @@ (define-configuration/no-serialization oci-container-configuration @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." +directly to the OCI runtime CLI. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run/#publish,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#publish-p-ip-hostport-containerport-protocol,Podman} +upstream documentation for semantics." (sanitizer oci-sanitize-ports)) (volumes (list '()) @@ -539,63 +659,326 @@ (define-configuration/no-serialization oci-container-configuration @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." +directly to the OCI runtime CLI. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run/#volume,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#volume-v-source-volume-host-dir-container-dir-options,Podman} +upstream documentation for semantics." (sanitizer oci-sanitize-volumes)) (container-user (maybe-string) "Set the current user inside the spawned container. You can refer to the -@url{https://docs.docker.com/engine/reference/run/#user,upstream} -documentation for semantics.") +@url{https://docs.docker.com/engine/reference/run/#user,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#user-u-user-group,Podman} +upstream documentation for semantics.") (workdir (maybe-string) - "Set the current working for the spawned Shepherd service. + "Set the current working directory for the spawned Shepherd service. You can refer to the -@url{https://docs.docker.com/engine/reference/run/#workdir,upstream} -documentation for semantics.") +@url{https://docs.docker.com/engine/reference/run/#workdir,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#workdir-w-dir,Podman} +upstream documentation for semantics.") (extra-arguments (list '()) "A list of strings, gexps or file-like objects that will be directly passed -to the @command{docker run} invokation." +to the @command{docker run} or @command{podman 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 (list-of-oci-containers? value) + (list-of-oci-records? "containers" oci-container-configuration? value)) + +(define-configuration/no-serialization oci-volume-configuration + (name + (string) + "The name of the OCI volume to provision.") + (labels + (list '()) + "The list of labels that will be used to tag the current volume." + (sanitizer oci-sanitize-labels)) + (extra-arguments + (list '()) + "A list of strings, gexps or file-like objects that will be directly passed +to the runtime invokation." + (sanitizer oci-sanitize-extra-arguments))) + +(define (list-of-oci-volumes? value) + (list-of-oci-records? "volumes" oci-volume-configuration? value)) + +(define-configuration/no-serialization oci-network-configuration + (name + (string) + "The name of the OCI network to provision.") + (driver + (maybe-string) + "The driver to manage the network.") + (gateway + (maybe-string) + "IPv4 or IPv6 gateway for the subnet.") + (internal? + (boolean #f) + "Restrict external access to the network") + (ip-range + (maybe-string) + "Allocate container ip from a sub-range in CIDR format.") + (ipam-driver + (maybe-string) + "IP Address Management Driver.") + (ipv6? + (boolean #f) + "Enable IPv6 networking.") + (subnet + (maybe-string) + "Subnet in CIDR format that represents a network segment.") + (labels + (list '()) + "The list of labels that will be used to tag the current volume." + (sanitizer oci-sanitize-labels)) + (extra-arguments + (list '()) + "A list of strings, gexps or file-like objects that will be directly passed +to the runtime invokation." + (sanitizer oci-sanitize-extra-arguments))) + +(define (list-of-oci-networks? value) + (list-of-oci-records? "networks" oci-network-configuration? value)) + +(define-configuration/no-serialization oci-configuration + (runtime + (symbol 'docker) + "The OCI runtime to use to run commands. It can be either @code{'docker} or +@code{'podman}." + (sanitizer oci-sanitize-runtime)) + (runtime-cli + (maybe-package) + "The OCI runtime command line to be installed in the system profile and used +to provision OCI resources. When unset it will default to @code{docker-cli} +package for the @code{'docker} runtime or to @code{podman} package for the +@code{'podman} runtime.") + (runtime-extra-arguments + (list '()) + "A list of strings, gexps or file-like objects that will be placed +after each @command{docker} or @command{podman} invokation.") + (user + (string "oci-container") + "The user name under whose authority OCI runtime commands will be run.") + (group + (maybe-string) + "The group name under whose authority OCI commands will be run. When +using the @code{'podman} OCI runtime, this field will be ignored and the +default group of the user configured in the @code{user} field will be used.") + (subuids-range + (maybe-subid-range) + "An optional @code{subid-range} record allocating subuids for the user from +the @code{user} field. When unset, with the rootless Podman OCI runtime, it +defaults to @code{(subid-range (name \"oci-container\"))}.") + (subgids-range + (maybe-subid-range) + "An optional @code{subid-range} record allocating subgids for the user from +the @code{user} field. When unset, with the rootless Podman OCI runtime, it +defaults to @code{(subid-range (name \"oci-container\"))}.") + (containers + (list-of-oci-containers '()) + "The list of @code{oci-container-configuration} records representing the +containers to provision. Most users are supposed not to use this field and use +the @code{oci-extension} record instead.") + (networks + (list-of-oci-networks '()) + "The list of @code{oci-network-configuration} records representing the +networks to provision. Most users are supposed not to use this field and use +the @code{oci-extension} record instead.") + (volumes + (list-of-oci-volumes '()) + "The list of @code{oci-volume-configuration} records representing the +volumes to provision. Most users are supposed not to use this field and use +the @code{oci-extension} record instead.") + (verbose? + (boolean #f) + "When true, additional output will be printed, allowing to better follow the +flow of execution.")) + +(define (oci-runtime-system-environment runtime user) + (if (eq? runtime 'podman) + (list + #~(string-append + "HOME=" (passwd:dir (getpwnam #$user)))) + #~())) + +(define (oci-runtime-system-group runtime user group) + (if (eq? runtime 'podman) + #~(group:name + (getgrgid + (passwd:gid + (getpwnam #$user)))) + group)) + +(define (oci-runtime-cli runtime runtime-cli path) + "Return a gexp that, when lowered, evaluates to the file system path of the OCI +runtime command requested by the user." + (if (string? runtime-cli) + ;; It is a user defined absolute path + runtime-cli + #~(string-append + #$(if (maybe-value-set? runtime-cli) + runtime-cli + path) + #$(if (eq? 'podman runtime) + "/bin/podman" + "/bin/docker")))) + +(define* (oci-runtime-system-cli config #:key (path "/run/current-system/profile")) + (let ((runtime-cli + (oci-configuration-runtime-cli config)) + (runtime + (oci-configuration-runtime config))) + (oci-runtime-cli runtime runtime-cli path))) + +(define-configuration/no-serialization oci-extension + (containers + (list-of-oci-containers '()) + "The list of @code{oci-container-configuration} records representing the +containers to add.") + (networks + (list-of-oci-networks '()) + "The list of @code{oci-network-configuration} records representing the +networks to add.") + (volumes + (list-of-oci-volumes '()) + "The list of @code{oci-volume-configuration} records representing the +volumes to add.")) + +(define (oci-image->container-name image) + "Infer the name of an OCI backed Shepherd service from its OCI image." + (basename + (if (string? image) + (first (string-split image #\:)) + (oci-image-repository image)))) + +(define (oci-object-command-shepherd-action object-name invokation) + "Return a Shepherd action printing a given INVOKATION of an OCI command for the +given OBJECT-NAME." + (shepherd-action + (name 'command-line) + (documentation + (format #f "Prints ~a's OCI runtime command line invokation." + object-name)) + (procedure + #~(lambda _ + (format #t "~a~%" #$invokation))))) + +(define (oci-container-shepherd-name runtime config) + "Return the name of an OCI backed Shepherd service based on CONFIG. +The name configured in the configuration record is returned when +CONFIG's name field has a value, otherwise a name is inferred from CONFIG's +image field." + (define name (oci-container-configuration-provision config)) + (define image (oci-container-configuration-image config)) + + (if (maybe-value-set? name) + name + (string-append (symbol->string runtime) "-" + (oci-image->container-name image)))) + +(define (oci-networks-shepherd-name runtime) + "Return the name of the OCI networks provisioning Shepherd service based on +RUNTIME." + (string-append (symbol->string runtime) "-networks")) + +(define (oci-volumes-shepherd-name runtime) + "Return the name of the OCI volumes provisioning Shepherd service based on +RUNTIME." + (string-append (symbol->string runtime) "-volumes")) + +(define (oci-container-configuration->options config) + "Map CONFIG, an oci-container-configuration record, to a gexp that, upon +lowering, will be evaluated to a list of strings containing command line options +for the OCI runtime run command." + (let ((entrypoint + (oci-container-configuration-entrypoint config)) + (network + (oci-container-configuration-network config)) + (user + (oci-container-configuration-container-user config)) + (workdir + (oci-container-configuration-workdir config))) + (apply append + (filter (compose not unspecified?) + `(,(if (maybe-value-set? entrypoint) + `("--entrypoint" ,entrypoint) + '()) + ,(append-map + (lambda (spec) + (list "--env" spec)) + (oci-container-configuration-environment config)) + ,(if (maybe-value-set? network) + `("--network" ,network) + '()) + ,(if (maybe-value-set? user) + `("--user" ,user) + '()) + ,(if (maybe-value-set? workdir) + `("--workdir" ,workdir) + '()) + ,(append-map + (lambda (spec) + (list "-p" spec)) + (oci-container-configuration-ports config)) + ,(append-map + (lambda (spec) + (list "-v" spec)) + (oci-container-configuration-volumes config))))))) + +(define (oci-network-configuration->options config) + "Map CONFIG, an oci-network-configuration record, to a gexp that, upon +lowering, will be evaluated to a list of strings containing command line options +for the OCI runtime network create command." + (let ((driver (oci-network-configuration-driver config)) + (gateway + (oci-network-configuration-gateway config)) + (internal? + (oci-network-configuration-internal? config)) + (ip-range + (oci-network-configuration-ip-range config)) + (ipam-driver + (oci-network-configuration-ipam-driver config)) + (ipv6? + (oci-network-configuration-ipv6? config)) + (subnet + (oci-network-configuration-subnet config))) + (apply append + (filter (compose not unspecified?) + `(,(if (maybe-value-set? driver) + `("--driver" ,driver) + '()) + ,(if (maybe-value-set? gateway) + `("--gateway" ,gateway) + '()) + ,(if internal? + `("--internal") + '()) + ,(if (maybe-value-set? ip-range) + `("--ip-range" ,ip-range) + '()) + ,(if (maybe-value-set? ipam-driver) + `("--ipam-driver" ,ipam-driver) + '()) + ,(if ipv6? + `("--ipv6") + '()) + ,(if (maybe-value-set? subnet) + `("--subnet" ,subnet) + '()) + ,(append-map + (lambda (spec) + (list "--label" spec)) + (oci-network-configuration-labels config))))))) + +(define (oci-volume-configuration->options config) + "Map CONFIG, an oci-volume-configuration record, to a gexp that, upon +lowering, will be evaluated to a list of strings containing command line options +for the OCI runtime volume create command." + (append-map + (lambda (spec) + (list "--label" spec)) + (oci-volume-configuration-labels config))) (define* (get-keyword-value args keyword #:key (default #f)) (let ((kv (memq keyword args))) @@ -604,6 +987,7 @@ (define* (get-keyword-value args keyword #:key (default #f)) default))) (define (lower-operating-system os target system) + "Lower OS, an operating-system record, into a tarball containing an OCI image." (mlet* %store-monad ((tarball (lower-object @@ -613,6 +997,7 @@ (define (lower-operating-system os target system) (return tarball))) (define (lower-manifest name image target system) + "Lower IMAGE, a manifest record, into a tarball containing an OCI image." (define value (oci-image-value image)) (define options (oci-image-pack-options image)) (define image-reference @@ -645,6 +1030,7 @@ (define (lower-manifest name image target system) (return tarball))) (define (lower-oci-image name image) + "Lower IMAGE, a oci-image record, into a tarball containing an OCI image." (define value (oci-image-value image)) (define image-target (oci-image-target image)) (define image-system (oci-image-system image)) @@ -675,9 +1061,10 @@ (define (lower-oci-image name image) #: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))) +(define* (oci-image-loader runtime-cli name image tag #:key (verbose? #f)) + "Return a file-like object that, once lowered, will evaluate to a program able +to load IMAGE through RUNTIME-CLI and to tag it with TAG afterwards." + (let ((tarball (lower-oci-image name image))) (with-imported-modules '((guix build utils)) (program-file (format #f "~a-image-loader" name) #~(begin @@ -686,102 +1073,561 @@ (define (%oci-image-loader name image tag) (ice-9 rdelim)) (format #t "Loading image for ~a from ~a...~%" #$name #$tarball) + (define load-command + (string-append #$runtime-cli + " load -i " #$tarball)) + (when #$verbose? + (format #t "Running ~a~%" load-command)) (define line (read-line - (open-input-pipe - (string-append #$docker " load -i " #$tarball)))) + (open-input-pipe load-command))) (unless (or (eof-object? line) (string-null? line)) (format #t "~a~%" line) - (let ((repository&tag - (string-drop line - (string-length - "Loaded image: ")))) + (let* ((repository&tag + (string-drop line + (string-length + "Loaded image: "))) + (tag-command + (list #$runtime-cli "tag" repository&tag #$tag))) + + (when #$verbose? + (format #t "Running~{ ~a~}~%" tag-command)) - (invoke #$docker "tag" repository&tag #$tag) + (apply invoke tag-command) (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)) +(define (oci-container-run-invokation runtime-cli name command image-reference + options runtime-extra-arguments run-extra-arguments) + "Return a list representing the OCI runtime +invokation for running containers." + ;; run [OPTIONS] IMAGE [COMMAND] [ARG...] + `(,runtime-cli ,@runtime-extra-arguments "run" + "--rm" "--name" ,name + ,@options ,@run-extra-arguments + ,image-reference ,@command)) + +(define* (oci-container-entrypoint runtime-cli name image image-reference + invokation #:key (verbose? #f)) + "Return a file-like object that, once lowered, will evaluate to the entrypoint +for the Shepherd service that will run IMAGE through RUNTIME-CLI." + (program-file + (string-append "oci-entrypoint-" name) + #~(begin + (use-modules (ice-9 format) + (srfi srfi-1)) + (when #$verbose? + (format #t "Running in verbose mode...~%")) + (define invokation (list #$@invokation)) + #$@(if (oci-image? image) + #~((system* + #$(oci-image-loader + runtime-cli name image + image-reference #:verbose? verbose?))) + #~()) + (when #$verbose? + (format #t "Running~{ ~a~}~%" invokation)) + (apply execlp `(,(first invokation) ,@invokation))))) + +(define* (oci-container-shepherd-service runtime runtime-cli config + #:key + (runtime-environment #~()) + (runtime-extra-arguments '()) + (oci-requirement '()) + (user #f) + (group #f) + (verbose? #f)) + "Return a Shepherd service object that will run the OCI container represented +by CONFIG through RUNTIME-CLI." + (let* ((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)) + (user (or user (oci-container-configuration-user config))) + (group (if (and group (maybe-value-set? group)) + 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)) + (name + (oci-container-shepherd-name runtime config)) (extra-arguments - (oci-container-configuration-extra-arguments config))) + (oci-container-configuration-extra-arguments config)) + (invokation + (oci-container-run-invokation + runtime-cli name command image-reference + options runtime-extra-arguments extra-arguments))) (shepherd-service (provision `(,(string->symbol name))) - (requirement `(dockerd user-processes ,@requirement)) + (requirement `(,@oci-requirement + ,@requirement)) (respawn? respawn?) (auto-start? auto-start?) (documentation (string-append - "Docker backed Shepherd service for " + (oci-runtime-name runtime) " 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 + (list + #$(oci-container-entrypoint + runtime-cli name image image-reference + invokation #:verbose? verbose?)) + #$@(if user (list #:user user) '()) + #$@(if group (list #:group group) '()) #$@(if (maybe-value-set? log-file) (list #:log-file log-file) '()) + #$@(if (eq? runtime 'podman) + (list #:directory + #~(passwd:dir (getpwnam #$user))) + '()) #:environment-variables - (list #$@host-environment)))) + (append + (list #$@host-environment) + (list #$@runtime-environment))))) (stop #~(lambda _ - (invoke #$docker "rm" "-f" #$name))) + (invoke #$runtime-cli "rm" "-f" #$name))) (actions - (if (oci-image? image) - '() - (append + (append + (list + (oci-object-command-shepherd-action + name #~(string-join (list #$@invokation) " "))) + (if (oci-image? image) + '() (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 + (let ((service-name name)) + (shepherd-action + (name 'pull) + (documentation + (format #f "Pull ~a's image (~a)." + service-name image)) + (procedure + #~(lambda _ + (invoke #$runtime-cli "pull" #$image))))))) + actions))))) + +(define (oci-object-create-invokation object runtime-cli name options + runtime-extra-arguments + create-extra-arguments) + "Return a gexp that, upon lowering, will evaluate to the OCI runtime +invokation for creating networks and volumes." + ;; network|volume create [options] [NAME] + #~(list #$runtime-cli #$@runtime-extra-arguments #$object "create" + #$@options #$@create-extra-arguments #$name)) + +(define (format-oci-invokations invokations) + "Return a gexp that, upon lowering, will evaluate to a formatted message +containing the INVOKATIONS that the OCI runtime will execute to provision +networks or volumes." + #~(string-join (map (lambda (i) (string-join i " ")) + (list #$@invokations)) + "\n")) + +(define* (oci-object-create-script object runtime runtime-cli invokations + #:key (verbose? #f)) + "Return a file-like object that, once lowered, will evaluate to a program able +to create OCI networks and volumes through RUNTIME-CLI." + (define runtime-string (symbol->string runtime)) + (program-file + (string-append runtime-string "-" object "s-create.scm") + #~(begin + (use-modules (ice-9 format) + (ice-9 match) + (ice-9 popen) + (ice-9 rdelim) + (srfi srfi-1)) + + (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 (object-exists? name) + #$(if (eq? runtime 'podman) + #~(let ((command + (list #$runtime-cli + #$object "exists" name))) + (when #$verbose? + (format #t "Running~{ ~a~}~%" command)) + (define exit-code (status:exit-val (apply system* command))) + (when #$verbose? + (format #t "Exit code: ~a~%" exit-code)) + (equal? EXIT_SUCCESS exit-code)) + #~(let ((command + (string-append #$runtime-cli + " " #$object " ls --format " + "\"{{.Name}}\""))) + (when #$verbose? + (format #t "Running ~a~%" command)) + (member name (read-lines (open-input-pipe command)))))) + + (for-each + (lambda (invokation) + (define name (last invokation)) + (if (object-exists? name) + (format #t "~a ~a ~a already exists, skipping creation.~%" + #$(oci-runtime-name runtime) name #$object) + (begin + (when #$verbose? + (format #t "Running~{ ~a~}~%" invokation)) + (let ((exit-code (status:exit-val (apply system* invokation)))) + (when #$verbose? + (format #t "Exit code: ~a~%" exit-code)))))) + (list #$@invokations))))) + +(define* (oci-object-shepherd-service object runtime runtime-cli name requirement invokations + #:key + (runtime-environment #~()) + (user #f) + (group #f) + (verbose? #f)) + "Return a Shepherd service object that will create the OBJECTs represented +by INVOKATIONS through RUNTIME-CLI." + (shepherd-service (provision `(,(string->symbol name))) + (requirement requirement) + (one-shot? #t) + (documentation + (string-append + (oci-runtime-name runtime) " " object + " provisioning service")) + (start + #~(lambda _ + (fork+exec-command + (list + #$(oci-object-create-script + object runtime runtime-cli + invokations + #:verbose? verbose?)) + #$@(if user (list #:user user) '()) + #$@(if group (list #:group group) '()) + #:environment-variables + (list #$@runtime-environment)))) + (actions + (list + (oci-object-command-shepherd-action + name (format-oci-invokations invokations)))))) + +(define* (oci-networks-shepherd-service runtime runtime-cli name networks + #:key (user #f) (group #f) (verbose? #f) + (runtime-extra-arguments '()) + (runtime-environment #~()) + (runtime-requirement '())) + "Return a Shepherd service object that will create the networks represented +in CONFIG." + (let ((invokations + (map + (lambda (network) + (oci-object-create-invokation + "network" runtime-cli + (oci-network-configuration-name network) + (oci-network-configuration->options network) + runtime-extra-arguments + (oci-network-configuration-extra-arguments network))) + networks))) + + (oci-object-shepherd-service + "network" runtime runtime-cli name + runtime-requirement invokations + #:user user #:group group #:runtime-environment runtime-environment + #:verbose? verbose?))) + +(define* (oci-volumes-shepherd-service runtime runtime-cli name volumes + #:key (user #f) (group #f) (verbose? #f) + (runtime-extra-arguments '()) + (runtime-environment #~()) + (runtime-requirement '())) + "Return a Shepherd service object that will create the volumes represented +in CONFIG." + (let ((invokations + (map + (lambda (volume) + (oci-object-create-invokation + "volume" runtime-cli + (oci-volume-configuration-name volume) + (oci-volume-configuration->options volume) + runtime-extra-arguments + (oci-volume-configuration-extra-arguments volume))) + volumes))) + + (oci-object-shepherd-service + "volume" runtime runtime-cli name runtime-requirement invokations + #:user user #:group group #:runtime-environment runtime-environment + #:verbose? verbose?))) + +(define (oci-service-accounts config) + (define user (oci-configuration-user config)) + (define maybe-group (oci-configuration-group config)) + (define runtime (oci-configuration-runtime config)) (list (user-account - (name "oci-container") + (name user) (comment "OCI services account") - (group "docker") - (system? #t) - (home-directory "/var/empty") + (group "users") + (supplementary-groups + (list (oci-runtime-group runtime maybe-group))) + (system? (eq? 'docker runtime)) + (home-directory (if (eq? 'podman runtime) + (string-append "/home/" user) + "/var/empty")) + (create-home-directory? (eq? 'podman runtime)) (shell (file-append shadow "/sbin/nologin"))))) + +(define* (oci-state->shepherd-services runtime runtime-cli containers networks volumes + #:key (user #f) (group #f) (verbose? #f) + (networks-name #f) (volumes-name #f) + (runtime-extra-arguments '()) + (runtime-environment #~()) + (runtime-requirement '()) + (containers-requirement '()) + (networks-requirement '()) + (volumes-requirement '())) + (let* ((networks? + (> (length networks) 0)) + (networks-service + (if networks? + (list + (string->symbol + (oci-networks-shepherd-name runtime))) + '())) + (volumes? + (> (length volumes) 0)) + (volumes-service + (if volumes? + (list + (string->symbol + (oci-volumes-shepherd-name runtime))) + '()))) + (append + (map + (lambda (c) + (oci-container-shepherd-service + runtime runtime-cli c + #:user user + #:group group + #:runtime-environment runtime-environment + #:runtime-extra-arguments runtime-extra-arguments + #:oci-requirement + (append containers-requirement + runtime-requirement + networks-service + volumes-service) + #:verbose? verbose?)) + containers) + (if networks? + (list + (oci-networks-shepherd-service + runtime runtime-cli + (if (string? networks-name) + networks-name + (oci-networks-shepherd-name runtime)) + networks + #:user user #:group group + #:runtime-extra-arguments runtime-extra-arguments + #:runtime-environment runtime-environment + #:runtime-requirement (append networks-requirement + runtime-requirement) + #:verbose? verbose?)) + '()) + (if volumes? + (list + (oci-volumes-shepherd-service + runtime runtime-cli + (if (string? volumes-name) + volumes-name + (oci-volumes-shepherd-name runtime)) + volumes + #:user user #:group group + #:runtime-extra-arguments runtime-extra-arguments + #:runtime-environment runtime-environment + #:runtime-requirement (append runtime-requirement + volumes-requirement) + #:verbose? verbose?)) + '())))) + +(define (oci-configuration->shepherd-services config) + (let* ((runtime (oci-configuration-runtime config)) + (runtime-cli + (oci-runtime-system-cli config)) + (runtime-extra-arguments + (oci-configuration-runtime-extra-arguments config)) + (containers (oci-configuration-containers config)) + (networks (oci-configuration-networks config)) + (volumes (oci-configuration-volumes config)) + (user (oci-configuration-user config)) + (group (oci-runtime-group + runtime (oci-configuration-group config))) + (verbose? (oci-configuration-verbose? config))) + (oci-state->shepherd-services runtime runtime-cli containers networks volumes + #:user user + #:group + (oci-runtime-system-group runtime user group) + #:verbose? verbose? + #:runtime-extra-arguments + runtime-extra-arguments + #:runtime-environment + (oci-runtime-system-environment runtime user) + #:runtime-requirement + (oci-runtime-system-requirement runtime) + #:networks-requirement '(networking)))) + +(define (oci-service-subids config) + "Return a subids-extension record representing subuids and subgids required by +the rootless Podman backend." + (define (delete-duplicate-ranges ranges) + (delete-duplicates ranges + (lambda args + (apply string=? (map subid-range-name ranges))))) + (define runtime + (oci-configuration-runtime config)) + (define user + (oci-configuration-user config)) + (define subgids (oci-configuration-subgids-range config)) + (define subuids (oci-configuration-subuids-range config)) + (define container-users + (filter (lambda (range) (not (string=? (subid-range-name range) user))) + (map (lambda (container) + (subid-range + (name + (oci-container-configuration-user container)))) + (oci-configuration-containers config)))) + (define subgid-ranges + (delete-duplicate-ranges + (cons + (if (maybe-value-set? subgids) + subgids + (subid-range (name user))) + container-users))) + (define subuid-ranges + (delete-duplicate-ranges + (cons + (if (maybe-value-set? subuids) + subuids + (subid-range (name user))) + container-users))) + + (if (eq? 'podman runtime) + (subids-extension + (subgids + subgid-ranges) + (subuids + subuid-ranges)) + (subids-extension))) + +(define (oci-objects-merge-lst a b object get-name) + (define (contains? value lst) + (member value (map get-name lst))) + (let loop ((merged '()) + (lst (append a b))) + (if (null? lst) + merged + (loop + (let ((element (car lst))) + (when (contains? element merged) + (raise + (formatted-message + (G_ "Duplicated ~a: ~a. ~as names should be unique, please +remove the duplicate.") object (get-name element) object))) + (cons element merged)) + (cdr lst))))) + +(define (oci-extension-merge a b) + (oci-extension + (containers (oci-objects-merge-lst + (oci-extension-containers a) + (oci-extension-containers b) + "container" + (lambda (config) + (define maybe-name (oci-container-configuration-provision config)) + (if (maybe-value-set? maybe-name) + maybe-name + (oci-image->container-name + (oci-container-configuration-image config)))))) + (networks (oci-objects-merge-lst + (oci-extension-networks a) + (oci-extension-networks b) + "network" + oci-network-configuration-name)) + (volumes (oci-objects-merge-lst + (oci-extension-volumes a) + (oci-extension-volumes b) + "volume" + oci-volume-configuration-name)))) + +(define (oci-service-profile runtime runtime-cli) + (list bash-minimal + (cond + ((maybe-value-set? runtime-cli) + runtime-cli) + ((eq? 'podman runtime) + podman) + (else + docker-cli)))) + +(define oci-service-type + (service-type (name 'oci) + (extensions + (list + (service-extension profile-service-type + (lambda (config) + (let ((runtime-cli + (oci-configuration-runtime-cli config)) + (runtime + (oci-configuration-runtime config))) + (oci-service-profile runtime runtime-cli)))) + (service-extension subids-service-type + oci-service-subids) + (service-extension account-service-type + oci-service-accounts) + (service-extension shepherd-root-service-type + oci-configuration->shepherd-services))) + ;; Concatenate OCI object lists. + (compose (lambda (args) + (fold oci-extension-merge + (oci-extension) + args))) + (extend + (lambda (config extension) + (oci-configuration + (inherit config) + (containers + (oci-objects-merge-lst + (oci-configuration-containers config) + (oci-extension-containers extension) + "container" + (lambda (oci-config) + (define runtime + (oci-configuration-runtime config)) + (oci-container-shepherd-name runtime oci-config)))) + (networks (oci-objects-merge-lst + (oci-configuration-networks config) + (oci-extension-networks extension) + "network" + oci-network-configuration-name)) + (volumes (oci-objects-merge-lst + (oci-configuration-volumes config) + (oci-extension-volumes extension) + "volume" + oci-volume-configuration-name))))) + (default-value (oci-configuration)) + (description + "This service implements the provisioning of OCI object such +as containers, networks and volumes."))) diff --git a/gnu/services/docker.scm b/gnu/services/docker.scm index 69ff9f1d9e4..98ee175873d 100644 --- a/gnu/services/docker.scm +++ b/gnu/services/docker.scm @@ -31,7 +31,10 @@ (define-module (gnu services docker) #:use-module (gnu system shadow) #:use-module (gnu packages docker) #:use-module (gnu packages linux) ;singularity + #:use-module (guix deprecation) + #:use-module (guix diagnostics) #:use-module (guix gexp) + #:use-module (guix i18n) #:use-module (guix records) #:use-module (srfi srfi-1) #:use-module (ice-9 format) @@ -67,16 +70,18 @@ (define-module (gnu services docker) 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) + oci-container-configuration-extra-arguments) #:export (containerd-configuration containerd-service-type docker-configuration docker-service-type singularity-service-type - oci-container-service-type)) + ;; for backwards compatibility, until the + ;; oci-container-service-type is fully deprecated + oci-container-shepherd-service + oci-container-service-type + %oci-container-accounts)) (define-maybe file-like) @@ -295,17 +300,25 @@ (define singularity-service-type ;;; OCI container. ;;; -(define (configs->shepherd-services configs) - (map oci-container-shepherd-service configs)) +;; for backwards compatibility, until the +;; oci-container-service-type is fully deprecated +(define-deprecated (oci-container-shepherd-service config) + oci-service-type + ((@ (gnu services containers) oci-container-shepherd-service) + 'docker config)) +(define %oci-container-accounts + (filter user-account? (oci-service-accounts (oci-configuration)))) (define oci-container-service-type (service-type (name 'oci-container) - (extensions (list (service-extension profile-service-type - (lambda _ (list docker-cli))) - (service-extension account-service-type - (const %oci-container-accounts)) - (service-extension shepherd-root-service-type - configs->shepherd-services))) + (extensions + (list (service-extension oci-service-type + (lambda (containers) + (warning + (G_ + "'oci-container-service-type' is deprecated, use 'oci-service-type' instead~%")) + (oci-extension + (containers containers)))))) (default-value '()) (extend append) (compose concatenate) diff --git a/gnu/tests/containers.scm b/gnu/tests/containers.scm index 0ecc8ddb126..bac1f47bd34 100644 --- a/gnu/tests/containers.scm +++ b/gnu/tests/containers.scm @@ -27,6 +27,9 @@ (define-module (gnu tests containers) #: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 @@ (define-module (gnu tests containers) #: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 @@ -345,3 +350,995 @@ (define %test-rootless-podman (name "rootless-podman") (description "Test rootless Podman service.") (value (build-tarball&run-rootless-podman-test)))) + + +(define %oci-rootless-podman-os + (simple-operating-system + (service dhcp-client-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-configuration (name "my-network")))) + (volumes + (list (oci-volume-configuration (name "my-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)(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 services herd) + (guix combinators)))) + + (define vm + (virtual-machine + (operating-system os) + (volatile? #f) + (memory-size 1024) + (disk-image-size (* 3000 (expt 2 20))) + (port-forwardings '()))) + + (define test + (with-imported-modules '((gnu build marionette)) + #~(begin + (use-modules (srfi srfi-11) (srfi srfi-64) + (gnu build marionette)) + + (define marionette + ;; Relax timeout to accommodate older systems and + ;; allow for pulling the image. + (make-marionette (list #$vm) #:timeout 60)) + (define out-dir "/tmp") + + (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 "rootless-podman services started successfully" + (begin + (define (run-test) + (marionette-eval + `(begin + (use-modules (ice-9 popen) + (ice-9 match) + (ice-9 rdelim)) + + (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 slurp + (lambda args + (let* ((port (apply open-pipe* OPEN_READ args)) + (output (read-lines port)) + (status (close-pipe port))) + output))) + (let* ((bash + ,(string-append #$bash "/bin/bash")) + (response1 + (slurp bash "-c" + (string-append "ls -la /sys/fs/cgroup | " + "grep -E ' \\./?$' | awk '{ print $4 }'"))) + (response2 (slurp bash "-c" + (string-append "ls -l /sys/fs/cgroup/cgroup" + ".{procs,subtree_control,threads} | " + "awk '{ print $4 }' | sort -u")))) + (list (string-join response1 "\n") (string-join response2 "\n")))) + marionette)) + ;; Allow services to come up on slower machines + (let loop ((attempts 0)) + (if (= attempts 60) + (error "Services didn't come up after more than 60 seconds") + (if (equal? '("cgroup" "cgroup") + (run-test)) + #t + (begin + (sleep 1) + (format #t "Services didn't come up yet, retrying with attempt ~a~%" + (+ 1 attempts)) + (loop (+ 1 attempts)))))))) + + (test-assert "podman-volumes running" + (begin + (define (run-test) + (marionette-eval + `(begin + (use-modules (srfi srfi-1) + (ice-9 popen) + (ice-9 match) + (ice-9 rdelim)) + + (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 (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 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))) + + (match (primitive-fork) + (0 + (dynamic-wind + (const #f) + (lambda () + (setgid (passwd:gid (getpwnam "oci-container"))) + (setuid (passwd:uid (getpw "oci-container"))) + + (let ((response (slurp + "/run/current-system/profile/bin/podman" + "volume" "ls" "-n" "--format" "\"{{.Name}}\"" + "|" "tr" "' '" "'\n'"))) + + (call-with-output-file (string-append ,out-dir "/response") + (lambda (port) + (display (string-join response "\n") port))))) + (lambda () + (primitive-exit 127)))) + (pid + (cdr (waitpid pid)))) + + (wait-for-file (string-append ,out-dir "/response")) + + (stable-sort + (slurp "cat" (string-append ,out-dir "/response")) + string<=?)) + marionette)) + ;; Allow services to come up on slower machines + (let loop ((attempts 0)) + (if (= attempts 80) + (error "Service didn't come up after more than 80 seconds") + (if (equal? '("my-volume") + (run-test)) + #t + (begin + (sleep 1) + (loop (+ 1 attempts)))))))) + + (test-assert "podman-networks running" + (begin + (define (run-test) + (marionette-eval + `(begin + (use-modules (srfi srfi-1) + (ice-9 popen) + (ice-9 match) + (ice-9 rdelim)) + + (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 (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 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))) + + (match (primitive-fork) + (0 + (dynamic-wind + (const #f) + (lambda () + (setgid (passwd:gid (getpwnam "oci-container"))) + (setuid (passwd:uid (getpw "oci-container"))) + + (let ((response (slurp + "/run/current-system/profile/bin/podman" + "network" "ls" "-n" "--format" "\"{{.Name}}\"" + "|" "tr" "' '" "'\n'"))) + + (call-with-output-file (string-append ,out-dir "/response") + (lambda (port) + (display (string-join response "\n") port))))) + (lambda () + (primitive-exit 127)))) + (pid + (cdr (waitpid pid)))) + + (wait-for-file (string-append ,out-dir "/response")) + + (stable-sort + (slurp "cat" (string-append ,out-dir "/response")) + string<=?)) + marionette)) + ;; Allow services to come up on slower machines + (let loop ((attempts 0)) + (if (= attempts 80) + (error "Service didn't come up after more than 80 seconds") + (if (equal? '("my-network" "podman") + (run-test)) + #t + (begin + (sleep 1) + (loop (+ 1 attempts)))))))) + + (test-assert "first container running" + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (wait-for-service 'first #:timeout 120) + #t) + marionette)) + + (test-assert "second container running" + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (wait-for-service 'second #:timeout 120) + #t) + marionette)) + + (test-assert "passing host environment variables" + (begin + (define (run-test) + (marionette-eval + `(begin + (use-modules (srfi srfi-1) + (ice-9 popen) + (ice-9 match) + (ice-9 rdelim)) + + (define (wait-for-file file) + ;; Wait until FILE shows up. + (let loop ((i 60)) + (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 (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 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))) + + (match (primitive-fork) + (0 + (dynamic-wind + (const #f) + (lambda () + (setgid (passwd:gid (getpwnam "oci-container"))) + (setuid (passwd:uid (getpw "oci-container"))) + + (let ((response (slurp + "/run/current-system/profile/bin/podman" + "exec" "first" + "/bin/guile" "-c" "'(display (getenv \"VARIABLE\"))'"))) + (call-with-output-file (string-append ,out-dir "/response") + (lambda (port) + (display (string-join response "\n") port))))) + (lambda () + (primitive-exit 127)))) + (pid + (cdr (waitpid pid)))) + + (wait-for-file (string-append ,out-dir "/response")) + (slurp "cat" (string-append ,out-dir "/response"))) + marionette)) + ;; Allow image to be loaded on slower machines + (let loop ((attempts 0)) + (if (= attempts 180) + (error "Service didn't come up after more than 180 seconds") + (if (equal? (list "value") + (run-test)) + #t + (begin + (sleep 1) + (loop (+ 1 attempts)))))))) + + (test-equal "mounting host files" + '("hello") + (marionette-eval + `(begin + (use-modules (srfi srfi-1) + (ice-9 popen) + (ice-9 match) + (ice-9 rdelim)) + + (define (wait-for-file file) + ;; Wait until FILE shows up. + (let loop ((i 60)) + (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 (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 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))) + + (match (primitive-fork) + (0 + (dynamic-wind + (const #f) + (lambda () + (setgid (passwd:gid (getpwnam "oci-container"))) + (setuid (passwd:uid (getpw "oci-container"))) + + (let ((response (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)))'"))) + (call-with-output-file (string-append ,out-dir "/response") + (lambda (port) + (display (string-join response " ") port))))) + (lambda () + (primitive-exit 127)))) + (pid + (cdr (waitpid pid)))) + + (wait-for-file (string-append ,out-dir "/response")) + (slurp "cat" (string-append ,out-dir "/response"))) + marionette)) + + (test-equal "write to volumes" + '("world") + (marionette-eval + `(begin + (use-modules (srfi srfi-1) + (ice-9 popen) + (ice-9 match) + (ice-9 rdelim)) + + (define (wait-for-file file) + ;; Wait until FILE shows up. + (let loop ((i 60)) + (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 (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 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))) + + (match (primitive-fork) + (0 + (dynamic-wind + (const #f) + (lambda () + (setgid (passwd:gid (getpwnam "oci-container"))) + (setuid (passwd:uid (getpw "oci-container"))) + + (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))))'") + + (let ((response (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)))'"))) + (call-with-output-file (string-append ,out-dir "/response") + (lambda (port) + (display (string-join response " ") port))))) + (lambda () + (primitive-exit 127)))) + (pid + (cdr (waitpid pid)))) + + (wait-for-file (string-append ,out-dir "/response")) + (slurp "cat" (string-append ,out-dir "/response"))) + marionette)) + + (test-equal "can read ports over network" + '("out of office") + (marionette-eval + `(begin + (use-modules (srfi srfi-1) + (ice-9 popen) + (ice-9 match) + (ice-9 rdelim)) + + (define (wait-for-file file) + ;; Wait until FILE shows up. + (let loop ((i 60)) + (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 (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 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))) + + (match (primitive-fork) + (0 + (dynamic-wind + (const #f) + (lambda () + (setgid (passwd:gid (getpwnam "oci-container"))) + (setuid (passwd:uid (getpw "oci-container"))) + + (let ((response (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))'"))) + (call-with-output-file (string-append ,out-dir "/response") + (lambda (port) + (display (string-join response " ") port))))) + (lambda () + (primitive-exit 127)))) + (pid + (cdr (waitpid pid)))) + + (wait-for-file (string-append ,out-dir "/response")) + (slurp "cat" (string-append ,out-dir "/response"))) + 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-os + (simple-operating-system + (service dhcp-client-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-configuration (name "my-network")))) + (volumes + (list (oci-volume-configuration (name "my-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)(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 services herd) + (guix combinators)))) + + (define vm + (virtual-machine + (operating-system os) + (volatile? #f) + (memory-size 1024) + (disk-image-size (* 3000 (expt 2 20))) + (port-forwardings '()))) + + (define test + (with-imported-modules '((gnu build marionette)) + #~(begin + (use-modules (srfi srfi-11) (srfi srfi-64) + (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) + (marionette-eval + `(begin + (use-modules (ice-9 popen) + (ice-9 rdelim)) + + (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 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))) + + (stable-sort + (slurp + "/run/current-system/profile/bin/docker" + "volume" "ls" "--format" "\"{{.Name}}\"") + string<=?)) + + marionette)) + ;; Allow services to come up on slower machines + (let loop ((attempts 0)) + (if (= attempts 80) + (error "Service didn't come up after more than 80 seconds") + (if (equal? '("my-volume") + (run-test)) + #t + (begin + (sleep 1) + (loop (+ 1 attempts)))))))) + + (test-assert "docker-networks running" + (begin + (define (run-test) + (marionette-eval + `(begin + (use-modules (ice-9 popen) + (ice-9 rdelim)) + + (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 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))) + + (stable-sort + (slurp + "/run/current-system/profile/bin/docker" + "network" "ls" "--format" "\"{{.Name}}\"") + string<=?)) + + marionette)) + ;; Allow services to come up on slower machines + (let loop ((attempts 0)) + (if (= attempts 80) + (error "Service didn't come up after more than 80 seconds") + (if (equal? '("bridge" "host" "my-network" "none") + (run-test)) + #t + (begin + (sleep 1) + (loop (+ 1 attempts)))))))) + + (test-assert "first container running" + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (wait-for-service 'first #:timeout 120) + #t) + marionette)) + + (test-assert "second container running" + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (wait-for-service 'second #:timeout 120) + #t) + marionette)) + + (test-assert "passing host environment variables" + (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))) + + (slurp + "/run/current-system/profile/bin/docker" + "exec" "first" + "/bin/guile" "-c" "(display (getenv \"VARIABLE\"))")) + marionette)) + ;; Allow image to be loaded on slower machines + (let loop ((attempts 0)) + (if (= attempts 180) + (error "Service didn't come up after more than 180 seconds") + (if (equal? "value" + (run-test)) + #t + (begin + (sleep 1) + (loop (+ 1 attempts)))))))) + + (test-equal "mounting host files" + "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))) + + (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 \"/shared.txt\" read-line)))")) + marionette)) + + (test-equal "write to volumes" + "world" + (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))) + + (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 ports over network" + "out of office" + (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))) + + (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)))) -- 2.48.1 From unknown Fri Jun 13 11:55:10 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#76081] [PATCH v3 4/4] tests: Use lower-oci-image-state in container tests. Resent-From: Giacomo Leidi Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sun, 09 Feb 2025 20:40:03 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 76081 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 76081@debbugs.gnu.org Cc: Giacomo Leidi Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.173913356526784 (code B ref 76081); Sun, 09 Feb 2025 20:40:03 +0000 Received: (at 76081) by debbugs.gnu.org; 9 Feb 2025 20:39:25 +0000 Received: from localhost ([127.0.0.1]:46580 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1thE5M-0006xv-Es for submit@debbugs.gnu.org; Sun, 09 Feb 2025 15:39:25 -0500 Received: from confino.investici.org ([93.190.126.19]:52013) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1thE5F-0006xB-Fa for 76081@debbugs.gnu.org; Sun, 09 Feb 2025 15:39:18 -0500 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org; s=stigmate; t=1739133556; bh=OR92uJtdqeJZb5/tRylm2hBiS5mxpqify+pKZXZURS4=; h=From:To:Cc:Subject:Date:In-Reply-To:References:From; b=r4Dn3TDzSIzdCh7y8hLkW1b3zKikkvP2FTI8+BQEEFiRxq9s4GTP8zivrpT778ZoL MMnT4xuvWzXVhHjXSfZxuLtwqt2eju80MQbqSC2Ub4yX6QfnwCtoT6KSa9arPK6x0I 9M9Csketc9jzuehjy0QVLt7DBsrRawXVml9nrwfM= Received: from mx1.investici.org (unknown [127.0.0.1]) by confino.investici.org (Postfix) with ESMTP id 4Yrfh448Kkz112p; Sun, 9 Feb 2025 20:39:16 +0000 (UTC) Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19]) (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with ESMTPSA id 4Yrfh436jqz112H; Sun, 9 Feb 2025 20:39:16 +0000 (UTC) From: Giacomo Leidi Date: Sun, 9 Feb 2025 21:39:08 +0100 Message-ID: X-Mailer: git-send-email 2.48.1 In-Reply-To: <89778533f32ad1388f03414e884fff10f74ef379.1739133548.git.goodoldpaul@autistici.org> References: <89778533f32ad1388f03414e884fff10f74ef379.1739133548.git.goodoldpaul@autistici.org> MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Spam-Score: -0.7 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.7 (-) This patch replaces boilerplate in container related tests with oci-image plumbing from (gnu services containers). * gnu/services/containers.scm: Export lower-oci-image-state. * gnu/tests/containers.scm (%oci-tarball): New variable; (run-rootless-podman-test): use %oci-tarball; (build-tarball&run-rootless-podman-test): drop procedure. * gnu/tests/docker.scm (%docker-tarball): New variable; (build-tarball&run-docker-test): use %docker-tarball; (%docker-system-tarball): New variable; (build-tarball&run-docker-system-test): new procedure. Change-Id: Iad6f0704aee188d89464c83722dea0bb7adb084a --- gnu/services/containers.scm | 35 ++++++++----- gnu/tests/containers.scm | 80 ++++++++++++++--------------- gnu/tests/docker.scm | 100 ++++++++++++++++++++---------------- 3 files changed, 114 insertions(+), 101 deletions(-) diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm index 12c509c07ab..5979b26e6c9 100644 --- a/gnu/services/containers.scm +++ b/gnu/services/containers.scm @@ -74,6 +74,8 @@ (define-module (gnu services containers) oci-image-system oci-image-grafts? + lower-oci-image-state + oci-container-configuration oci-container-configuration? oci-container-configuration-fields @@ -996,12 +998,9 @@ (define (lower-operating-system os target system) #:target target))) (return tarball))) -(define (lower-manifest name image target system) - "Lower IMAGE, a manifest record, into a tarball containing an OCI image." - (define value (oci-image-value image)) - (define options (oci-image-pack-options image)) - (define image-reference - (oci-image-reference image)) +(define (lower-manifest name value options image-reference + target system grafts?) + "Lower VALUE, a manifest record, into a tarball containing an OCI image." (define image-tag (let* ((extra-options (get-keyword-value options #:extra-options)) @@ -1013,8 +1012,7 @@ (define (lower-manifest name image target system) `(#:extra-options (#:image-tag ,image-reference))))) (mlet* %store-monad - ((_ (set-grafting - (oci-image-grafts? image))) + ((_ (set-grafting grafts?)) (guile (set-guile-for-build (default-guile))) (profile (profile-derivation value @@ -1029,11 +1027,8 @@ (define (lower-manifest name image target system) #:localstatedir? #t)))) (return tarball))) -(define (lower-oci-image name image) - "Lower IMAGE, a oci-image record, into a tarball containing an OCI image." - (define value (oci-image-value image)) - (define image-target (oci-image-target image)) - (define image-system (oci-image-system image)) +(define (lower-oci-image-state name value options reference + image-target image-system grafts?) (define target (if (maybe-value-set? image-target) image-target @@ -1046,7 +1041,8 @@ (define (lower-oci-image name image) (run-with-store store (match value ((? manifest? value) - (lower-manifest name image target system)) + (lower-manifest name value options reference + target system grafts?)) ((? operating-system? value) (lower-operating-system value target system)) ((or (? gexp? value) @@ -1061,6 +1057,17 @@ (define (lower-oci-image name image) #:target target #:system system))) +(define (lower-oci-image name image) + "Lower IMAGE, a oci-image record, into a tarball containing an OCI image." + (lower-oci-image-state + name + (oci-image-value image) + (oci-image-pack-options image) + (oci-image-reference image) + (oci-image-target image) + (oci-image-system image) + (oci-image-grafts? image))) + (define* (oci-image-loader runtime-cli name image tag #:key (verbose? #f)) "Return a file-like object that, once lowered, will evaluate to a program able to load IMAGE through RUNTIME-CLI and to tag it with TAG afterwards." diff --git a/gnu/tests/containers.scm b/gnu/tests/containers.scm index bac1f47bd34..1fcf6be7ace 100644 --- a/gnu/tests/containers.scm +++ b/gnu/tests/containers.scm @@ -69,13 +69,47 @@ (define %rootless-podman-os (supplementary-groups '("wheel" "netdev" "cgroup" "audio" "video"))))))) -(define (run-rootless-podman-test oci-tarball) +(define %oci-tarball + (lower-oci-image-state + "guile-guest" + (packages->manifest + (list + guile-3.0 guile-json-3 + (package + (name "guest-script") + (version "0") + (source #f) + (build-system trivial-build-system) + (arguments `(#:guile ,guile-3.0 + #:builder + (let ((out (assoc-ref %outputs "out"))) + (mkdir out) + (call-with-output-file (string-append out "/a.scm") + (lambda (port) + (display "(display \"hello world\n\")" port))) + #t))) + (synopsis "Display hello world using Guile") + (description "This package displays the text \"hello world\" on the +standard output device and then enters a new line.") + (home-page #f) + (license license:public-domain)))) + '(#:entry-point "bin/guile" + #:localstatedir? #t + #:extra-options (#:image-tag "guile-guest") + #:symlinks (("/bin/Guile" -> "bin/guile") + ("aa.scm" -> "a.scm"))) + "guile-guest" + (%current-target-system) + (%current-system) + #f)) + +(define (run-rootless-podman-test) (define os (marionette-operating-system (operating-system-with-gc-roots %rootless-podman-os - (list oci-tarball)) + (list %oci-tarball)) #:imported-modules '((gnu services herd) (guix combinators)))) @@ -254,7 +288,7 @@ (define (run-rootless-podman-test oci-tarball) (let* ((loaded (slurp ,(string-append #$podman "/bin/podman") "load" "-i" - ,#$oci-tarball)) + ,#$%oci-tarball)) (repository&tag "localhost/guile-guest:latest") (response1 (slurp ,(string-append #$podman "/bin/podman") @@ -307,49 +341,11 @@ (define (run-rootless-podman-test oci-tarball) (gexp->derivation "rootless-podman-test" test)) -(define (build-tarball&run-rootless-podman-test) - (mlet* %store-monad - ((_ (set-grafting #f)) - (guile (set-guile-for-build (default-guile))) - (guest-script-package -> - (package - (name "guest-script") - (version "0") - (source #f) - (build-system trivial-build-system) - (arguments `(#:guile ,guile-3.0 - #:builder - (let ((out (assoc-ref %outputs "out"))) - (mkdir out) - (call-with-output-file (string-append out "/a.scm") - (lambda (port) - (display "(display \"hello world\n\")" port))) - #t))) - (synopsis "Display hello world using Guile") - (description "This package displays the text \"hello world\" on the -standard output device and then enters a new line.") - (home-page #f) - (license license:public-domain))) - (profile (profile-derivation (packages->manifest - (list guile-3.0 guile-json-3 - guest-script-package)) - #:hooks '() - #:locales? #f)) - (tarball (pack:docker-image - "docker-pack" profile - #:symlinks '(("/bin/Guile" -> "bin/guile") - ("aa.scm" -> "a.scm")) - #:extra-options - '(#:image-tag "guile-guest") - #:entry-point "bin/guile" - #:localstatedir? #t))) - (run-rootless-podman-test tarball))) - (define %test-rootless-podman (system-test (name "rootless-podman") (description "Test rootless Podman service.") - (value (build-tarball&run-rootless-podman-test)))) + (value (run-rootless-podman-test)))) (define %oci-rootless-podman-os diff --git a/gnu/tests/docker.scm b/gnu/tests/docker.scm index 5dcf05a17e3..07edd9d5341 100644 --- a/gnu/tests/docker.scm +++ b/gnu/tests/docker.scm @@ -26,6 +26,7 @@ (define-module (gnu tests docker) #:use-module (gnu system image) #:use-module (gnu system vm) #:use-module (gnu services) + #:use-module (gnu services containers) #:use-module (gnu services dbus) #:use-module (gnu services networking) #:use-module (gnu services docker) @@ -57,6 +58,40 @@ (define %docker-os (service containerd-service-type) (service docker-service-type))) +(define %docker-tarball + (lower-oci-image-state + "guile-guest" + (packages->manifest + (list + guile-3.0 guile-json-3 + (package + (name "guest-script") + (version "0") + (source #f) + (build-system trivial-build-system) + (arguments `(#:guile ,guile-3.0 + #:builder + (let ((out (assoc-ref %outputs "out"))) + (mkdir out) + (call-with-output-file (string-append out "/a.scm") + (lambda (port) + (display "(display \"hello world\n\")" port))) + #t))) + (synopsis "Display hello world using Guile") + (description "This package displays the text \"hello world\" on the +standard output device and then enters a new line.") + (home-page #f) + (license license:public-domain)))) + '(#:entry-point "bin/guile" + #:localstatedir? #t + #:extra-options (#:image-tag "guile-guest") + #:symlinks (("/bin/Guile" -> "bin/guile") + ("aa.scm" -> "a.scm"))) + "guile-guest" + (%current-target-system) + (%current-system) + #f)) + (define (run-docker-test docker-tarball) "Load DOCKER-TARBALL as Docker image and run it in a Docker container, inside %DOCKER-OS." @@ -173,40 +208,7 @@ (define (run-docker-test docker-tarball) (gexp->derivation "docker-test" test)) (define (build-tarball&run-docker-test) - (mlet* %store-monad - ((_ (set-grafting #f)) - (guile (set-guile-for-build (default-guile))) - (guest-script-package -> - (package - (name "guest-script") - (version "0") - (source #f) - (build-system trivial-build-system) - (arguments `(#:guile ,guile-3.0 - #:builder - (let ((out (assoc-ref %outputs "out"))) - (mkdir out) - (call-with-output-file (string-append out "/a.scm") - (lambda (port) - (display "(display \"hello world\n\")" port))) - #t))) - (synopsis "Display hello world using Guile") - (description "This package displays the text \"hello world\" on the -standard output device and then enters a new line.") - (home-page #f) - (license license:public-domain))) - (profile (profile-derivation (packages->manifest - (list guile-3.0 guile-json-3 - guest-script-package)) - #:hooks '() - #:locales? #f)) - (tarball (pack:docker-image - "docker-pack" profile - #:symlinks '(("/bin/Guile" -> "bin/guile") - ("aa.scm" -> "a.scm")) - #:entry-point "bin/guile" - #:localstatedir? #t))) - (run-docker-test tarball))) + (run-docker-test %docker-tarball)) (define %test-docker (system-test @@ -215,8 +217,22 @@ (define %test-docker (value (build-tarball&run-docker-test)))) +(define %docker-system-tarball + (lower-oci-image-state + "guix-system-guest" + (operating-system + (inherit (simple-operating-system)) + ;; Use locales for a single libc to + ;; reduce space requirements. + (locale-libcs (list glibc))) + '() + "guix-system-guest" + (%current-target-system) + (%current-system) + #f)) + (define (run-docker-system-test tarball) - "Load DOCKER-TARBALL as Docker image and run it in a Docker container, + "Load TARBALL as Docker image and run it in a Docker container, inside %DOCKER-OS." (define os (marionette-operating-system @@ -333,21 +349,15 @@ (define (run-docker-system-test tarball) (gexp->derivation "docker-system-test" test)) +(define (build-tarball&run-docker-system-test) + (run-docker-system-test %docker-system-tarball)) + (define %test-docker-system (system-test (name "docker-system") (description "Run a system image as produced by @command{guix system docker-image} inside Docker.") - (value (with-monad %store-monad - (>>= (lower-object - (system-image (os->image - (operating-system - (inherit (simple-operating-system)) - ;; Use locales for a single libc to - ;; reduce space requirements. - (locale-libcs (list glibc))) - #:type docker-image-type))) - run-docker-system-test))))) + (value (build-tarball&run-docker-system-test)))) (define %oci-os -- 2.48.1 From unknown Fri Jun 13 11:55:10 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#76081] [PATCH v3 2/4] services: oci-container-configuration: Move to (gnu services containers). Resent-From: Giacomo Leidi Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sun, 09 Feb 2025 20:40:04 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 76081 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 76081@debbugs.gnu.org Cc: Giacomo Leidi Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.173913356826795 (code B ref 76081); Sun, 09 Feb 2025 20:40:04 +0000 Received: (at 76081) by debbugs.gnu.org; 9 Feb 2025 20:39:28 +0000 Received: from localhost ([127.0.0.1]:46582 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1thE5N-0006y2-9l for submit@debbugs.gnu.org; Sun, 09 Feb 2025 15:39:27 -0500 Received: from confino.investici.org ([93.190.126.19]:38057) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1thE5E-0006x9-MH for 76081@debbugs.gnu.org; Sun, 09 Feb 2025 15:39:19 -0500 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org; s=stigmate; t=1739133555; bh=C6uHhY9S9WpgPkIaaAgAOz8vooJK2RfngRRsEihvD9o=; h=From:To:Cc:Subject:Date:In-Reply-To:References:From; b=VZW7tY6crAquN7vL2SdjvCvrI/b5weQ5iTbTi5ODPH5RFQwWkbYFMJiaRDirrRMnB JGThGPmrTdlheBB906444KgMBl/krbsasxKA7oo8egdQCwB4UYrOx5h7RWwOwL8qEY hiAekJKF80hHJYEJHF2itPqd3wHIqn8uYVyODjAc= Received: from mx1.investici.org (unknown [127.0.0.1]) by confino.investici.org (Postfix) with ESMTP id 4Yrfh34q93z112f; Sun, 9 Feb 2025 20:39:15 +0000 (UTC) Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19]) (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with ESMTPSA id 4Yrfh337JDz112H; Sun, 9 Feb 2025 20:39:15 +0000 (UTC) From: Giacomo Leidi Date: Sun, 9 Feb 2025 21:39:06 +0100 Message-ID: <92f19ba6c0842885735dfce653eef535360085f4.1739133548.git.goodoldpaul@autistici.org> X-Mailer: git-send-email 2.48.1 In-Reply-To: <89778533f32ad1388f03414e884fff10f74ef379.1739133548.git.goodoldpaul@autistici.org> References: <89778533f32ad1388f03414e884fff10f74ef379.1739133548.git.goodoldpaul@autistici.org> MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit X-Spam-Score: -0.7 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.7 (-) 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 dc66ac4f967..50bf6c05549 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 +;;; Copyright © 2024, 2025 Giacomo Leidi ;;; ;;; This file is part of GNU Guix. ;;; @@ -17,19 +17,31 @@ ;;; along with GNU Guix. If not, see . (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) @@ -188,7 +237,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 @@ -242,3 +291,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 3af0f792701..69ff9f1d9e4 100644 --- a/gnu/services/docker.scm +++ b/gnu/services/docker.scm @@ -5,7 +5,7 @@ ;;; Copyright © 2020 Efraim Flashner ;;; Copyright © 2020 Jesse Dowell ;;; Copyright © 2021 Brice Waegeneire -;;; Copyright © 2023, 2024 Giacomo Leidi +;;; Copyright © 2023, 2024, 2025 Giacomo Leidi ;;; ;;; This file is part of GNU Guix. ;;; @@ -23,72 +23,60 @@ ;;; along with GNU Guix. If not, see . (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) @@ -307,495 +295,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} 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"))))) - (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 ;;; Copyright © 2019-2023 Ludovic Courtès -;;; Copyright © 2024 Giacomo Leidi +;;; Copyright © 2024, 2025 Giacomo Leidi ;;; ;;; 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 From unknown Fri Jun 13 11:55:10 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#76081] OCI provisioning service Resent-From: paul Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Wed, 12 Feb 2025 01:10:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 76081 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 76081@debbugs.gnu.org Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.173932257431835 (code B ref 76081); Wed, 12 Feb 2025 01:10:02 +0000 Received: (at 76081) by debbugs.gnu.org; 12 Feb 2025 01:09:34 +0000 Received: from localhost ([127.0.0.1]:59694 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ti1Fu-0008HP-2J for submit@debbugs.gnu.org; Tue, 11 Feb 2025 20:09:34 -0500 Received: from confino.investici.org ([93.190.126.19]:37533) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1ti1Fp-0008HB-Df for 76081@debbugs.gnu.org; Tue, 11 Feb 2025 20:09:31 -0500 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org; s=stigmate; t=1739322566; bh=wSqxT0AmfHZkcDc+nhirWeLwhKyq+LbuBpzlLwwOb/4=; h=Date:Subject:From:To:References:In-Reply-To:From; b=YRQ0GmhaHK2jzTviN38eP6Y3/VF1vOtMfzSi8xJsfm5rhrFkOQ81BQe7XSIy7RchZ 8q1pL0I5jktSJQCMTq+i03GUUSCsXqYvdYBSYtQdLFSfT8QNN58DEgkn4z4myCKHws MWitMvXbJWLzRysZg0K25y3TLa4+KuSKW9W/4bgw= Received: from mx1.investici.org (unknown [127.0.0.1]) by confino.investici.org (Postfix) with ESMTP id 4Yt0Zt65yrz110r for <76081@debbugs.gnu.org>; Wed, 12 Feb 2025 01:09:26 +0000 (UTC) Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19]) (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with ESMTPSA id 4Yt0Zt5ZYRz110q for <76081@debbugs.gnu.org>; Wed, 12 Feb 2025 01:09:26 +0000 (UTC) Message-ID: <274b98ea-1af9-4f0f-af58-8fa755feb73b@autistici.org> Date: Wed, 12 Feb 2025 02:09:26 +0100 MIME-Version: 1.0 User-Agent: Icedove Daily From: paul References: Content-Language: en-US In-Reply-To: Content-Type: text/plain; charset=UTF-8; format=flowed Content-Transfer-Encoding: 7bit X-Spam-Score: -0.7 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.7 (-) Hi guix, On 2/9/25 21:38, paul wrote: > I'm sending a v3 fixing a bug in the merge algorithm for volumes and > networks. > > On 2/9/25 20:14, paul wrote: >> Hi, >> >> I'm about to send a v2. v2 compared to the first revision features: >> >> >> - it actually compiles all the times :) (rev 1 referenced oci-image >> too early for it to be working and generated a compile time error, if >> you recompiled it sometimes went away so I thought it was a problem >> of my setup. CI caught this) >> - it allows more values to be overridden by eventual users of the >> Scheme API >> - it allows passing extra arguments directly after each podman or >> docker invokation, allowing for example for overriding podman --root >> and similar options. >> >> All of these tests should pass: >> >> guix shell -D guix -CPW -- make check-system TESTS="oci-container >> oci-service-rootless-podman docker docker-system rootless-podman >> oci-service-docker" >> I'm sending a v4 changing slightly the image loader, the same tests as before are supposed to pass. Now the Home service [0] is working for me with rootless podman. I'll try it on different distros if I manage to. Thank you for your work, giacomo [0]: https://github.com/fishinthecalculator/gocix/blob/main/modules/oci/home/services/containers.scm From unknown Fri Jun 13 11:55:10 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#76081] [PATCH v4 3/4] services: Add oci-service-type. Resent-From: Giacomo Leidi Original-Sender: "Debbugs-submit" Resent-CC: ludo@gnu.org, maxim.cournoyer@gmail.com, guix-patches@gnu.org Resent-Date: Wed, 12 Feb 2025 01:11:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 76081 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 76081@debbugs.gnu.org Cc: Giacomo Leidi , Ludovic =?UTF-8?Q?Court=C3=A8s?= , Maxim Cournoyer X-Debbugs-Original-Xcc: Ludovic =?UTF-8?Q?Court=C3=A8s?= , Maxim Cournoyer Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.173932265132374 (code B ref 76081); Wed, 12 Feb 2025 01:11:02 +0000 Received: (at 76081) by debbugs.gnu.org; 12 Feb 2025 01:10:51 +0000 Received: from localhost ([127.0.0.1]:59704 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ti1H8-0008Q6-Sg for submit@debbugs.gnu.org; Tue, 11 Feb 2025 20:10:50 -0500 Received: from confino.investici.org ([93.190.126.19]:24407) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1ti1H6-0008Pl-23 for 76081@debbugs.gnu.org; Tue, 11 Feb 2025 20:10:48 -0500 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org; s=stigmate; t=1739322647; bh=Nyfej6pMLQ1200H5wa4lySDmqxHy9uNI4Nz1FDafHGg=; h=From:To:Cc:Subject:Date:In-Reply-To:References:From; b=lnZV+k2UV9AAJaFuz8wKJlC8eU+kjPyWg7S4/L+5os/L4gUVYWHNfYhx3sEQukuPV RMH9UV7blpE3V/62gpigY4SSjvYv+VNGZ/7SaGyKq6k9iBU98jLRywY8Bs+Gtschl+ sm3IQA9Usy+4iPr44ZEWOWdN6DAiS852BAzTLz0Q= Received: from mx1.investici.org (unknown [127.0.0.1]) by confino.investici.org (Postfix) with ESMTP id 4Yt0cR1H52z111Z; Wed, 12 Feb 2025 01:10:47 +0000 (UTC) Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19]) (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with ESMTPSA id 4Yt0cR01fxz110r; Wed, 12 Feb 2025 01:10:46 +0000 (UTC) From: Giacomo Leidi Date: Wed, 12 Feb 2025 02:10:36 +0100 Message-ID: <30398d43f3b262022c3511187fe92296b00667ce.1739322637.git.goodoldpaul@autistici.org> X-Mailer: git-send-email 2.48.1 In-Reply-To: <3e199fa3b6b15d853ea1887ad0c518c7cb4f4b25.1739322637.git.goodoldpaul@autistici.org> References: <3e199fa3b6b15d853ea1887ad0c518c7cb4f4b25.1739322637.git.goodoldpaul@autistici.org> MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" 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/services/containers.scm (%oci-supported-runtimes): New variable; (oci-runtime-cli): new variable; (oci-runtime-name): new variable; (oci-network-configuration): new variable; (oci-volume-configuration): new variable; (oci-configuration): new variable; (oci-extension): new variable; (oci-networks-shepherd-name): new variable; (oci-service-type): new variable; (oci-state->shepherd-services): new variable. * doc/guix.texi: Document it. * gnu/tests/containers.scm: Test it. * gnu/services/docker.scm: Deprecate the oci-container-service-type. Change-Id: I656b3db85832e42d53072fcbfb91d1226f39ef38 --- doc/guix.texi | 305 +++++++-- gnu/services/containers.scm | 1217 ++++++++++++++++++++++++++++++----- gnu/services/docker.scm | 37 +- gnu/tests/containers.scm | 999 +++++++++++++++++++++++++++- 4 files changed, 2313 insertions(+), 245 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index ce780682ed0..500cf9f839c 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -41872,59 +41872,161 @@ Miscellaneous Services @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: given an -@acronym{Open Container Initiative, OCI} container image, it will run it in a +Should you wish to manage your @acronym{Open Container Initiative, OCI} containers +with the same consistent interface you use for your other Shepherd services, +@var{oci-service-type} is the tool to use: given an +OCI container image, it will run it in a Shepherd service. One example where this is useful: it lets you run services -that are available as Docker/OCI images but not yet packaged for Guix. +that are available as OCI images but not yet packaged for Guix. -@defvar oci-container-service-type +@defvar oci-service-type -This is a thin wrapper around Docker's CLI that executes OCI images backed +This is a thin wrapper around Docker's or Podman's CLI that executes OCI images backed processes as Shepherd Services. @lisp -(service oci-container-service-type - (list - (oci-container-configuration - (network "host") - (image - (oci-image - (repository "guile") - (tag "3") - (value (specifications->manifest '("guile"))) - (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile")) - #:max-layers 2)))) - (entrypoint "/bin/guile") - (command - '("-c" "(display \"hello!\n\")"))) - (oci-container-configuration - (image "prom/prometheus") - (ports - '(("9000" . "9000") - ("9090" . "9090")))) - (oci-container-configuration - (image "grafana/grafana:10.0.1") - (network "host") - (volumes - '("/var/lib/grafana:/var/lib/grafana"))))) +(simple-service 'oci-provisioning + oci-service-type + (oci-extension + (networks + (list + (oci-network-configuration (name "monitoring")))) + (containers + (list + (oci-container-configuration + (network "monitoring") + (image + (oci-image + (repository "guile") + (tag "3") + (value (specifications->manifest '("guile"))) + (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile")) + #:max-layers 2)))) + (entrypoint "/bin/guile") + (command + '("-c" "(display \"hello!\n\")"))) + (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 In this example three different Shepherd services are going to be added to the system. Each @code{oci-container-configuration} record translates to a -@code{docker run} invocation and its fields directly map to options. You can -refer to the -@url{https://docs.docker.com/engine/reference/commandline/run,upstream} -documentation for the semantics of each value. If the images are not found, -they will be -@url{https://docs.docker.com/engine/reference/commandline/pull/,pulled}. The +@command{docker run} or @command{podman run} invocation and its fields directly +map to options. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html,Podman} +upstream documentation for semantics of each value. If the images are not found, +they will be pulled. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/pull/,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-pull.1.html,Podman} +upstream documentation for semantics. The services with @code{(network "host")} are going to be attached to the host network and are supposed to behave like native processes with regard to networking. @end defvar +@c %start of fragment + +@deftp {Data Type} oci-configuration +Available @code{oci-configuration} fields are: + +@table @asis +@item @code{runtime} (default: @code{'docker}) (type: symbol) +The OCI runtime to use to run commands. It can be either @code{'docker} or +@code{'podman}. + +@item @code{runtime-cli} (type: maybe-package) +The OCI runtime command line to be installed in the system profile and used +to provision OCI resources. When unset it will default to @code{docker-cli} +package for the @code{'docker} runtime or to @code{podman} package for the +@code{'podman} runtime. + +@item @code{runtime-extra-arguments} (default: @code{'()}) (type: list) +A list of strings, gexps or file-like objects that will be placed +after each @command{docker} or @command{podman} invokation. + +@item @code{user} (type: maybe-string) +The user name under whose authority OCI commands will be run. This field will +override the @code{user} field of @code{oci-configuration}. + +@item @code{group} (type: maybe-string) +The group name under whose authority OCI commands will be run. When +using the @code{'podman} OCI runtime, this field will be ignored and the +default group of the user configured in the @code{user} field will be used. +This field will override the @code{group} field of @code{oci-configuration}. + +@item @code{subuids-range} (type: maybe-subid-range) +An optional @code{subid-range} record allocating subuids for the user from +the @code{user} field. When unset, with the rootless Podman OCI runtime, it +defaults to @code{(subid-range (name "oci-container"))}. + +@item @code{subgids-range} (type: maybe-subid-range) +An optional @code{subid-range} record allocating subgids for the user from +the @code{user} field. When unset, with the rootless Podman OCI runtime, it +defaults to @code{(subid-range (name "oci-container"))}. + +@item @code{containers} (default: @code{'()}) (type: list-of-oci-containers) +The list of @code{oci-container-configuration} records representing the +containers to provision. Most users are supposed not to use this field and use +the @code{oci-extension} record instead. + +@item @code{networks} (default: @code{'()}) (type: list-of-oci-networks) +The list of @code{oci-network-configuration} records representing the +containers to provision. Most users are supposed not to use this field and use +the @code{oci-extension} record instead. + +@item @code{volumes} (default: @code{'()}) (type: list-of-oci-volumes) +The list of @code{oci-volumes-configuration} records representing the +containers to provision. Most users are supposed not to use this field and use +the @code{oci-extension} record instead. + +@item @code{verbose?} (default: @code{#f}) (type: boolean) +When true, additional output will be printed, allowing to better follow the +flow of execution. + +@end table + +@end deftp + + +@c %end of fragment + +@c %start of fragment + +@deftp {Data Type} oci-extension +Available @code{oci-extension} fields are: + +@table @asis +@item @code{containers} (default: @code{'()}) (type: list-of-oci-containers) +The list of @code{oci-container-configuration} records representing the +containers to provision. + +@item @code{networks} (default: @code{'()}) (type: list-of-oci-networks) +The list of @code{oci-network-configuration} records representing the +containers to provision. + +@item @code{volumes} (default: @code{'()}) (type: list-of-oci-volumes) +The list of @code{oci-volumes-configuration} records representing the +containers to provision. + +@end table + +@end deftp + + +@c %end of fragment + + @c %start of fragment @deftp {Data Type} oci-container-configuration @@ -41944,16 +42046,16 @@ Miscellaneous Services Overwrite the default entrypoint (@code{ENTRYPOINT}) of the image. @item @code{host-environment} (default: @code{'()}) (type: 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 +Set environment variables in the host environment where @command{docker run} +or @command{podman run} are invoked. This is especially useful to pass secrets +from the host to the container without having them on the OCI runtime command line, +for example: by setting the @code{MYSQL_PASSWORD} on the host and by passing @code{--env MYSQL_PASSWORD} through the @code{extra-arguments} field, it is possible to securely set values in the container environment. This field's value can be a list of pairs or strings, even mixed: @lisp -(list '("LANGUAGE\" . "eo:ca:eu") +(list '("LANGUAGE" . "eo:ca:eu") "JAVA_HOME=/opt/java") @end lisp @@ -41961,22 +42063,24 @@ Miscellaneous Services directly to @code{make-forkexec-constructor}. @item @code{environment} (default: @code{'()}) (type: list) -Set environment variables. This can be a list of pairs or strings, even mixed: +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 -@uref{https://docs.docker.com/engine/reference/commandline/run/#env,upstream} -documentation for semantics. +Pair members can be strings, gexps or file-like objects. Strings are passed +directly to the OCI runtime CLI. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run/#env,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#env-e-env,Podman} +upstream documentation for semantics. @item @code{image} (type: 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{oci-image} record. Strings are resolved by the OCI runtime, +and follow the usual format @code{myregistry.local:5000/testing/test-image:tag}. @item @code{provision} (default: @code{""}) (type: string) @@ -42004,7 +42108,7 @@ Miscellaneous Services by the service. @item @code{network} (default: @code{""}) (type: string) -Set a Docker network for the spawned container. +Set an OCI 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 @@ -42015,10 +42119,11 @@ Miscellaneous Services "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 -@uref{https://docs.docker.com/engine/reference/commandline/run/#publish,upstream} -documentation for semantics. +Pair members can be strings, gexps or file-like objects. Strings are passed +directly to the OCI runtime CLI. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run/#publish,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#publish-p-ip-hostport-containerport-protocol,Podman} +upstream documentation for semantics. @item @code{volumes} (default: @code{'()}) (type: list) Set volume mappings for the spawned container. This can be a @@ -42029,25 +42134,97 @@ Miscellaneous Services "/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 -@uref{https://docs.docker.com/engine/reference/commandline/run/#volume,upstream} -documentation for semantics. +Pair members can be strings, gexps or file-like objects. Strings are passed +directly to the OCI runtime CLI. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run/#volume,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#volume-v-source-volume-host-dir-container-dir-options,Podman} +upstream documentation for semantics. @item @code{container-user} (default: @code{""}) (type: 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. +@url{https://docs.docker.com/engine/reference/run/#user,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#user-u-user-group,Podman} +upstream documentation for semantics. @item @code{workdir} (default: @code{""}) (type: string) Set the current working directory for the spawned Shepherd service. You can refer to the -@url{https://docs.docker.com/engine/reference/run/#workdir,upstream} -documentation for semantics. +@url{https://docs.docker.com/engine/reference/run/#workdir,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#workdir-w-dir,Podman} +upstream documentation for semantics. @item @code{extra-arguments} (default: @code{'()}) (type: list) -A list of strings, gexps or file-like objects that will be directly -passed to the @command{docker run} invocation. +A list of strings, gexps or file-like objects that will be directly passed +to the @command{docker run} or @command{podman run} invokation. + +@end table + +@end deftp + + +@c %end of fragment + +@c %start of fragment + +@deftp {Data Type} oci-network-configuration +Available @code{oci-network-configuration} fields are: + +@table @asis +@item @code{name} (type: string) +The name of the OCI network to provision. + +@item @code{driver} (type: maybe-string) +The driver to manage the network. + +@item @code{gateway} (type: maybe-string) +IPv4 or IPv6 gateway for the subnet. + +@item @code{internal?} (default: @code{#f}) (type: boolean) +Restrict external access to the network + +@item @code{ip-range} (type: maybe-string) +Allocate container ip from a sub-range in CIDR format. + +@item @code{ipam-driver} (type: maybe-string) +IP Address Management Driver. + +@item @code{ipv6?} (default: @code{#f}) (type: boolean) +Enable IPv6 networking. + +@item @code{subnet} (type: maybe-string) +Subnet in CIDR format that represents a network segment. + +@item @code{labels} (default: @code{'()}) (type: list) +The list of labels that will be used to tag the current volume. + +@item @code{extra-arguments} (default: @code{'()}) (type: list) +A list of strings, gexps or file-like objects that will be directly passed +to the @command{docker network create} or @command{podman network create} +invokation. + +@end table + +@end deftp + + +@c %end of fragment + +@c %start of fragment + +@deftp {Data Type} oci-volume-configuration +Available @code{oci-volume-configuration} fields are: + +@table @asis +@item @code{name} (type: string) +The name of the OCI volume to provision. + +@item @code{labels} (default: @code{'()}) (type: list) +The list of labels that will be used to tag the current volume. + +@item @code{extra-arguments} (default: @code{'()}) (type: list) +A list of strings, gexps or file-like objects that will be directly passed +to the @command{docker volume create} or @command{podman volume create} +invokation. @end table diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm index 50bf6c05549..018dfa60f48 100644 --- a/gnu/services/containers.scm +++ b/gnu/services/containers.scm @@ -41,6 +41,7 @@ (define-module (gnu services containers) #:use-module ((guix scripts pack) #:prefix pack:) #:use-module (guix store) #:use-module (srfi srfi-1) + #:use-module (ice-9 format) #:use-module (ice-9 match) #:export (rootless-podman-configuration rootless-podman-configuration? @@ -96,8 +97,73 @@ (define-module (gnu services containers) oci-container-configuration-workdir oci-container-configuration-extra-arguments + list-of-oci-containers? + list-of-oci-networks? + list-of-oci-volumes? + + %oci-supported-runtimes + oci-sanitize-runtime + oci-runtime-system-environment + oci-runtime-system-extra-arguments + oci-runtime-system-group + oci-runtime-system-requirement + oci-runtime-cli + oci-runtime-system-cli + oci-runtime-name + oci-runtime-group + + oci-network-configuration + oci-network-configuration? + oci-network-configuration-fields + oci-network-configuration-name + oci-network-configuration-driver + oci-network-configuration-gateway + oci-network-configuration-internal? + oci-network-configuration-ip-range + oci-network-configuration-ipam-driver + oci-network-configuration-ipv6? + oci-network-configuration-subnet + oci-network-configuration-labels + oci-network-configuration-extra-arguments + + oci-volume-configuration + oci-volume-configuration? + oci-volume-configuration-fields + oci-volume-configuration-name + oci-volume-configuration-labels + oci-volume-configuration-extra-arguments + + oci-configuration + oci-configuration? + oci-configuration-fields + oci-configuration-runtime + oci-configuration-runtime-cli + oci-configuration-runtime-extra-arguments + oci-configuration-user + oci-configuration-group + oci-configuration-containers + oci-configuration-networks + oci-configuration-volumes + oci-configuration-verbose? + + oci-extension + oci-extension? + oci-extension-fields + oci-extension-containers + oci-extension-networks + oci-extension-volumes + + oci-networks-shepherd-name + oci-volumes-shepherd-name + oci-container-shepherd-service - %oci-container-accounts)) + oci-objects-merge-lst + oci-service-type + oci-service-accounts + oci-service-profile + oci-service-subids + oci-state->shepherd-services + oci-configuration->shepherd-services)) (define (gexp-or-string? value) (or (gexp? value) @@ -294,9 +360,42 @@ (define rootless-podman-service-type ;;; -;;; OCI container. +;;; OCI provisioning service. ;;; +(define %oci-supported-runtimes + '(docker podman)) + +(define (oci-runtime-system-requirement runtime) + "Return a list of Shepherd service names required by a given OCI runtime, +before it is able to run containers." + (if (eq? 'podman runtime) + '(cgroups2-fs-owner cgroups2-limits + rootless-podman-shared-root-fs user-processes) + '(dockerd user-processes))) + +(define (oci-runtime-name runtime) + "Return a human readable name for a given OCI runtime." + (if (eq? 'podman runtime) + "Podman" "Docker")) + +(define (oci-runtime-group runtime maybe-group) + "Implement the logic behind selection of the group that is to be used by +Shepherd to execute OCI commands." + (if (maybe-value-set? maybe-group) + maybe-group + (if (eq? 'podman runtime) + "cgroup" + "docker"))) + +(define (oci-sanitize-runtime value) + (unless (member value %oci-supported-runtimes) + (raise + (formatted-message + (G_ "OCI runtime must be a symbol and one of ~a, +but ~a was found") %oci-supported-runtimes value))) + value) + (define (oci-sanitize-pair pair delimiter) (define (valid? member) (or (string? member) @@ -345,6 +444,11 @@ (define (oci-sanitize-volumes value) ;; '(("/mnt/dir" . "/dir") "/run/current-system/profile:/java") (oci-sanitize-mixed-list "volumes" value ":")) +(define (oci-sanitize-labels value) + ;; Expected spec format: + ;; '(("foo" . "bar") "foo=bar") + (oci-sanitize-mixed-list "labels" value "=")) + (define (oci-sanitize-shepherd-actions value) (map (lambda (el) @@ -372,10 +476,15 @@ (define (oci-sanitize-extra-arguments value) value)) (define (oci-image-reference image) - (if (string? image) - image - (string-append (oci-image-repository image) - ":" (oci-image-tag image)))) + "Return a string OCI image reference representing IMAGE." + (define reference + (if (string? image) + image + (string-append (oci-image-repository image) + ":" (oci-image-tag image)))) + (if (> (length (string-split reference #\/)) 1) + reference + (string-append "localhost/" reference))) (define (oci-lowerable-image? image) (or (manifest? image) @@ -390,7 +499,19 @@ (define (string-or-oci-image? image) (define list-of-symbols? (list-of symbol?)) +(define (list-of-oci-records? name predicate value) + (map + (lambda (el) + (if (predicate el) + el + (raise + (formatted-message + (G_ "~a contains an illegal value: ~a") name el)))) + value)) + (define-maybe/no-serialization string) +(define-maybe/no-serialization package) +(define-maybe/no-serialization subid-range) (define-configuration/no-serialization oci-image (repository @@ -435,11 +556,15 @@ (define-configuration/no-serialization oci-image (define-configuration/no-serialization oci-container-configuration (user - (string "oci-container") - "The user under whose authority docker commands will be run.") + (maybe-string) + "The user name under whose authority OCI commands will be run. This field will +override the @code{user} field of @code{oci-configuration}.") (group - (string "docker") - "The group under whose authority docker commands will be run.") + (maybe-string) + "The group name under whose authority OCI commands will be run. When +using the @code{'podman} OCI runtime, this field will be ignored and the +default group of the user configured in the @code{user} field will be used. +This field will override the @code{group} field of @code{oci-configuration}.") (command (list-of-strings '()) "Overwrite the default command (@code{CMD}) of the image.") @@ -449,9 +574,9 @@ (define-configuration/no-serialization oci-container-configuration (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 +or @command{podman run} are invoked. This is especially useful to pass secrets +from the host to the container without having them on the OCI runtime command line, +for example: by setting the @code{MYSQL_PASSWORD} on the host and by passing @code{--env MYSQL_PASSWORD} through the @code{extra-arguments} field, it is possible to securely set values in the container environment. This field's value can be a list of pairs or strings, even mixed: @@ -475,15 +600,16 @@ (define-configuration/no-serialization oci-container-configuration @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." +directly to the OCI runtime CLI. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run/#env,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#env-e-env,Podman} +upstream documentation for semantics." (sanitizer oci-sanitize-environment)) (image (string-or-oci-image) "The image used to build the container. It can be a string or an -@code{oci-image} record. Strings are resolved by the Docker -Engine, and follow the usual format +@code{oci-image} record. Strings are resolved by the OCI runtime, +and follow the usual format @code{myregistry.local:5000/testing/test-image:tag}.") (provision (maybe-string) @@ -512,7 +638,7 @@ (define-configuration/no-serialization oci-container-configuration (sanitizer oci-sanitize-shepherd-actions)) (network (maybe-string) - "Set a Docker network for the spawned container.") + "Set an OCI network for the spawned container.") (ports (list '()) "Set the port or port ranges to expose from the spawned container. This can @@ -524,9 +650,10 @@ (define-configuration/no-serialization oci-container-configuration @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." +directly to the OCI runtime CLI. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run/#publish,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#publish-p-ip-hostport-containerport-protocol,Podman} +upstream documentation for semantics." (sanitizer oci-sanitize-ports)) (volumes (list '()) @@ -539,71 +666,331 @@ (define-configuration/no-serialization oci-container-configuration @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." +directly to the OCI runtime CLI. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run/#volume,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#volume-v-source-volume-host-dir-container-dir-options,Podman} +upstream documentation for semantics." (sanitizer oci-sanitize-volumes)) (container-user (maybe-string) "Set the current user inside the spawned container. You can refer to the -@url{https://docs.docker.com/engine/reference/run/#user,upstream} -documentation for semantics.") +@url{https://docs.docker.com/engine/reference/run/#user,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#user-u-user-group,Podman} +upstream documentation for semantics.") (workdir (maybe-string) - "Set the current working for the spawned Shepherd service. + "Set the current working directory for the spawned Shepherd service. You can refer to the -@url{https://docs.docker.com/engine/reference/run/#workdir,upstream} -documentation for semantics.") +@url{https://docs.docker.com/engine/reference/run/#workdir,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#workdir-w-dir,Podman} +upstream documentation for semantics.") (extra-arguments (list '()) "A list of strings, gexps or file-like objects that will be directly passed -to the @command{docker run} invokation." +to the @command{docker run} or @command{podman 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 (list-of-oci-containers? value) + (list-of-oci-records? "containers" oci-container-configuration? value)) + +(define-configuration/no-serialization oci-volume-configuration + (name + (string) + "The name of the OCI volume to provision.") + (labels + (list '()) + "The list of labels that will be used to tag the current volume." + (sanitizer oci-sanitize-labels)) + (extra-arguments + (list '()) + "A list of strings, gexps or file-like objects that will be directly passed +to the @command{docker volume create} or @command{podman volume create} +invokation." + (sanitizer oci-sanitize-extra-arguments))) + +(define (list-of-oci-volumes? value) + (list-of-oci-records? "volumes" oci-volume-configuration? value)) + +(define-configuration/no-serialization oci-network-configuration + (name + (string) + "The name of the OCI network to provision.") + (driver + (maybe-string) + "The driver to manage the network.") + (gateway + (maybe-string) + "IPv4 or IPv6 gateway for the subnet.") + (internal? + (boolean #f) + "Restrict external access to the network") + (ip-range + (maybe-string) + "Allocate container ip from a sub-range in CIDR format.") + (ipam-driver + (maybe-string) + "IP Address Management Driver.") + (ipv6? + (boolean #f) + "Enable IPv6 networking.") + (subnet + (maybe-string) + "Subnet in CIDR format that represents a network segment.") + (labels + (list '()) + "The list of labels that will be used to tag the current volume." + (sanitizer oci-sanitize-labels)) + (extra-arguments + (list '()) + "A list of strings, gexps or file-like objects that will be directly passed +to the @command{docker network create} or @command{podman network create} +invokation." + (sanitizer oci-sanitize-extra-arguments))) + +(define (list-of-oci-networks? value) + (list-of-oci-records? "networks" oci-network-configuration? value)) + +(define-configuration/no-serialization oci-configuration + (runtime + (symbol 'docker) + "The OCI runtime to use to run commands. It can be either @code{'docker} or +@code{'podman}." + (sanitizer oci-sanitize-runtime)) + (runtime-cli + (maybe-package) + "The OCI runtime command line to be installed in the system profile and used +to provision OCI resources. When unset it will default to @code{docker-cli} +package for the @code{'docker} runtime or to @code{podman} package for the +@code{'podman} runtime.") + (runtime-extra-arguments + (list '()) + "A list of strings, gexps or file-like objects that will be placed +after each @command{docker} or @command{podman} invokation.") + (user + (string "oci-container") + "The user name under whose authority OCI runtime commands will be run.") + (group + (maybe-string) + "The group name under whose authority OCI commands will be run. When +using the @code{'podman} OCI runtime, this field will be ignored and the +default group of the user configured in the @code{user} field will be used.") + (subuids-range + (maybe-subid-range) + "An optional @code{subid-range} record allocating subuids for the user from +the @code{user} field. When unset, with the rootless Podman OCI runtime, it +defaults to @code{(subid-range (name \"oci-container\"))}.") + (subgids-range + (maybe-subid-range) + "An optional @code{subid-range} record allocating subgids for the user from +the @code{user} field. When unset, with the rootless Podman OCI runtime, it +defaults to @code{(subid-range (name \"oci-container\"))}.") + (containers + (list-of-oci-containers '()) + "The list of @code{oci-container-configuration} records representing the +containers to provision. Most users are supposed not to use this field and use +the @code{oci-extension} record instead.") + (networks + (list-of-oci-networks '()) + "The list of @code{oci-network-configuration} records representing the +networks to provision. Most users are supposed not to use this field and use +the @code{oci-extension} record instead.") + (volumes + (list-of-oci-volumes '()) + "The list of @code{oci-volume-configuration} records representing the +volumes to provision. Most users are supposed not to use this field and use +the @code{oci-extension} record instead.") + (verbose? + (boolean #f) + "When true, additional output will be printed, allowing to better follow the +flow of execution.")) + +(define (oci-runtime-system-environment runtime user) + (if (eq? runtime 'podman) + (list + #~(string-append + "HOME=" (passwd:dir (getpwnam #$user)))) + #~())) + +(define (oci-runtime-system-group runtime user group) + (if (eq? runtime 'podman) + #~(group:name + (getgrgid + (passwd:gid + (getpwnam #$user)))) + group)) + +(define (oci-runtime-cli runtime runtime-cli path) + "Return a gexp that, when lowered, evaluates to the file system path of the OCI +runtime command requested by the user." + (if (string? runtime-cli) + ;; It is a user defined absolute path + runtime-cli + #~(string-append + #$(if (maybe-value-set? runtime-cli) + runtime-cli + path) + #$(if (eq? 'podman runtime) + "/bin/podman" + "/bin/docker")))) + +(define* (oci-runtime-system-cli config #:key (path "/run/current-system/profile")) + (let ((runtime-cli + (oci-configuration-runtime-cli config)) + (runtime + (oci-configuration-runtime config))) + (oci-runtime-cli runtime runtime-cli path))) + +(define-configuration/no-serialization oci-extension + (containers + (list-of-oci-containers '()) + "The list of @code{oci-container-configuration} records representing the +containers to add.") + (networks + (list-of-oci-networks '()) + "The list of @code{oci-network-configuration} records representing the +networks to add.") + (volumes + (list-of-oci-volumes '()) + "The list of @code{oci-volume-configuration} records representing the +volumes to add.")) + +(define (oci-image->container-name image) + "Infer the name of an OCI backed Shepherd service from its OCI image." + (basename + (if (string? image) + (first (string-split image #\:)) + (oci-image-repository image)))) + +(define (oci-object-command-shepherd-action object-name invokation) + "Return a Shepherd action printing a given INVOKATION of an OCI command for the +given OBJECT-NAME." + (shepherd-action + (name 'command-line) + (documentation + (format #f "Prints ~a's OCI runtime command line invokation." + object-name)) + (procedure + #~(lambda _ + (format #t "~a~%" #$invokation))))) + +(define (oci-container-shepherd-name runtime config) + "Return the name of an OCI backed Shepherd service based on CONFIG. +The name configured in the configuration record is returned when +CONFIG's name field has a value, otherwise a name is inferred from CONFIG's +image field." + (define name (oci-container-configuration-provision config)) + (define image (oci-container-configuration-image config)) + + (if (maybe-value-set? name) + name + (string-append (symbol->string runtime) "-" + (oci-image->container-name image)))) + +(define (oci-networks-shepherd-name runtime) + "Return the name of the OCI networks provisioning Shepherd service based on +RUNTIME." + (string-append (symbol->string runtime) "-networks")) + +(define (oci-volumes-shepherd-name runtime) + "Return the name of the OCI volumes provisioning Shepherd service based on +RUNTIME." + (string-append (symbol->string runtime) "-volumes")) + +(define (oci-container-configuration->options config) + "Map CONFIG, an oci-container-configuration record, to a gexp that, upon +lowering, will be evaluated to a list of strings containing command line options +for the OCI runtime run command." + (let ((entrypoint + (oci-container-configuration-entrypoint config)) + (network + (oci-container-configuration-network config)) + (user + (oci-container-configuration-container-user config)) + (workdir + (oci-container-configuration-workdir config))) + (apply append + (filter (compose not unspecified?) + `(,(if (maybe-value-set? entrypoint) + `("--entrypoint" ,entrypoint) + '()) + ,(append-map + (lambda (spec) + (list "--env" spec)) + (oci-container-configuration-environment config)) + ,(if (maybe-value-set? network) + `("--network" ,network) + '()) + ,(if (maybe-value-set? user) + `("--user" ,user) + '()) + ,(if (maybe-value-set? workdir) + `("--workdir" ,workdir) + '()) + ,(append-map + (lambda (spec) + (list "-p" spec)) + (oci-container-configuration-ports config)) + ,(append-map + (lambda (spec) + (list "-v" spec)) + (oci-container-configuration-volumes config))))))) + +(define (oci-network-configuration->options config) + "Map CONFIG, an oci-network-configuration record, to a gexp that, upon +lowering, will be evaluated to a list of strings containing command line options +for the OCI runtime network create command." + (let ((driver (oci-network-configuration-driver config)) + (gateway + (oci-network-configuration-gateway config)) + (internal? + (oci-network-configuration-internal? config)) + (ip-range + (oci-network-configuration-ip-range config)) + (ipam-driver + (oci-network-configuration-ipam-driver config)) + (ipv6? + (oci-network-configuration-ipv6? config)) + (subnet + (oci-network-configuration-subnet config))) + (apply append + (filter (compose not unspecified?) + `(,(if (maybe-value-set? driver) + `("--driver" ,driver) + '()) + ,(if (maybe-value-set? gateway) + `("--gateway" ,gateway) + '()) + ,(if internal? + `("--internal") + '()) + ,(if (maybe-value-set? ip-range) + `("--ip-range" ,ip-range) + '()) + ,(if (maybe-value-set? ipam-driver) + `("--ipam-driver" ,ipam-driver) + '()) + ,(if ipv6? + `("--ipv6") + '()) + ,(if (maybe-value-set? subnet) + `("--subnet" ,subnet) + '()) + ,(append-map + (lambda (spec) + (list "--label" spec)) + (oci-network-configuration-labels config))))))) + +(define (oci-volume-configuration->options config) + "Map CONFIG, an oci-volume-configuration record, to a gexp that, upon +lowering, will be evaluated to a list of strings containing command line options +for the OCI runtime volume create command." + (append-map + (lambda (spec) + (list "--label" spec)) + (oci-volume-configuration-labels config))) (define (lower-operating-system os target system) + "Lower OS, an operating-system record, into a tarball containing an OCI image." (mlet* %store-monad ((tarball (lower-object @@ -612,24 +999,11 @@ (define (lower-operating-system os target 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))))) - +(define (lower-manifest name value options image-reference + target system grafts?) + "Lower VALUE, a manifest record, into a tarball containing an OCI image." (mlet* %store-monad - ((_ (set-grafting - (oci-image-grafts? image))) + ((_ (set-grafting grafts?)) (guile (set-guile-for-build (default-guile))) (profile (profile-derivation value @@ -640,14 +1014,11 @@ (define (lower-manifest name image target system) (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 (lower-oci-image-state name value options reference + image-target image-system grafts?) (define target (if (maybe-value-set? image-target) image-target @@ -660,7 +1031,8 @@ (define (lower-oci-image name image) (run-with-store store (match value ((? manifest? value) - (lower-manifest name image target system)) + (lower-manifest name value options reference + target system grafts?)) ((? operating-system? value) (lower-operating-system value target system)) ((or (? gexp? value) @@ -675,113 +1047,622 @@ (define (lower-oci-image name image) #: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))) +(define (lower-oci-image name image) + "Lower IMAGE, a oci-image record, into a tarball containing an OCI image." + (lower-oci-image-state + name + (oci-image-value image) + (oci-image-pack-options image) + (oci-image-reference image) + (oci-image-target image) + (oci-image-system image) + (oci-image-grafts? image))) + +(define (oci-object-exists? runtime runtime-cli object verbose?) + #~(lambda* (name #:key (format-string "{{.Name}}")) + (use-modules (ice-9 format) + (ice-9 match) + (ice-9 popen) + (ice-9 rdelim) + (srfi srfi-1)) + + (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))) + + #$(if (eq? runtime 'podman) + #~(let ((command + (list #$runtime-cli + #$object "exists" name))) + (when #$verbose? + (format #t "Running~{ ~a~}~%" command)) + (define exit-code (status:exit-val (apply system* command))) + (when #$verbose? + (format #t "Exit code: ~a~%" exit-code)) + (equal? EXIT_SUCCESS exit-code)) + #~(let ((command + (string-append #$runtime-cli + " " #$object " ls --format " + "\"" format-string "\""))) + (when #$verbose? + (format #t "Running ~a~%" command)) + (member name (read-lines (open-input-pipe command))))))) + +(define* (oci-image-loader runtime runtime-cli name image tag #:key (verbose? #f)) + "Return a file-like object that, once lowered, will evaluate to a program able +to load IMAGE through RUNTIME-CLI and to tag it with TAG afterwards." + (let ((tarball (lower-oci-image name image))) (with-imported-modules '((guix build utils)) - (program-file (format #f "~a-image-loader" name) + (program-file + (format #f "~a-image-loader" name) #~(begin (use-modules (guix build utils) + (ice-9 match) (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)) + (ice-9 rdelim) + (srfi srfi-1)) + (define object-exists? + #$(oci-object-exists? runtime runtime-cli "image" verbose?)) + (define load-command + (string-append #$runtime-cli + " load -i " #$tarball)) + + (if (object-exists? #$tag #:format-string "{{.Repository}}:{{.Tag}}") + (format #t "~a image already exists, skipping.~%" #$tag) + (begin + (format #t "Loading image for ~a from ~a...~%" #$name #$tarball) + (when #$verbose? + (format #t "Running ~a~%" load-command)) + (let ((line (read-line + (open-input-pipe load-command)))) + (unless (or (eof-object? line) + (string-null? line)) + (format #t "~a~%" line) + (let* ((repository&tag + (string-drop line + (string-length + "Loaded image: "))) + (tag-command + (list #$runtime-cli "tag" repository&tag #$tag)) + (drop-old-tag-command + (list #$runtime-cli "image" "rm" "-f" repository&tag))) + + (unless (string=? repository&tag #$tag) + (when #$verbose? + (format #t "Running~{ ~a~}~%" tag-command)) + + (let ((exit-code + (status:exit-val (apply system* tag-command)))) + (format #t "Tagged ~a with ~a...~%" #$tarball #$tag) + + (when #$verbose? + (format #t "Exit code: ~a~%" exit-code)) + + (when (equal? EXIT_SUCCESS exit-code) + (when #$verbose? + (format #t "Running~{ ~a~}~%" drop-old-tag-command)) + (let ((drop-exit-code + (status:exit-val (apply system* drop-old-tag-command)))) + (when #$verbose? + (format #t "Exit code: ~a~%" drop-exit-code)))))))))))))))) + +(define (oci-container-run-invokation runtime-cli name command image-reference + options runtime-extra-arguments run-extra-arguments) + "Return a list representing the OCI runtime +invokation for running containers." + ;; run [OPTIONS] IMAGE [COMMAND] [ARG...] + `(,runtime-cli ,@runtime-extra-arguments "run" + "--rm" "--name" ,name + ,@options ,@run-extra-arguments + ,image-reference ,@command)) + +(define* (oci-container-entrypoint runtime runtime-cli name image image-reference + invokation #:key (verbose? #f)) + "Return a file-like object that, once lowered, will evaluate to the entrypoint +for the Shepherd service that will run IMAGE through RUNTIME-CLI." + (program-file + (string-append "oci-entrypoint-" name) + #~(begin + (use-modules (ice-9 format) + (srfi srfi-1)) + (when #$verbose? + (format #t "Running in verbose mode...~%")) + (define invokation (list #$@invokation)) + #$@(if (oci-image? image) + #~((system* + #$(oci-image-loader + runtime runtime-cli name image + image-reference #:verbose? verbose?))) + #~()) + (when #$verbose? + (format #t "Running~{ ~a~}~%" invokation)) + (apply execlp `(,(first invokation) ,@invokation))))) + +(define* (oci-container-shepherd-service runtime runtime-cli config + #:key + (runtime-environment #~()) + (runtime-extra-arguments '()) + (oci-requirement '()) + (user #f) + (group #f) + (verbose? #f)) + "Return a Shepherd service object that will run the OCI container represented +by CONFIG through RUNTIME-CLI." + (let* ((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)) + (maybe-user (oci-container-configuration-user config)) + (maybe-group (oci-container-configuration-group config)) + (user (if (maybe-value-set? maybe-user) + maybe-user + user)) + (group (if (maybe-value-set? maybe-group) + maybe-group + group)) (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)) + (name + (oci-container-shepherd-name runtime config)) (extra-arguments - (oci-container-configuration-extra-arguments config))) + (oci-container-configuration-extra-arguments config)) + (invokation + (oci-container-run-invokation + runtime-cli name command image-reference + options runtime-extra-arguments extra-arguments))) (shepherd-service (provision `(,(string->symbol name))) - (requirement `(dockerd user-processes ,@requirement)) + (requirement `(,@oci-requirement + ,@requirement)) (respawn? respawn?) (auto-start? auto-start?) (documentation (string-append - "Docker backed Shepherd service for " + (oci-runtime-name runtime) " 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 + (list + #$(oci-container-entrypoint + runtime runtime-cli name image image-reference + invokation #:verbose? verbose?)) + #$@(if user (list #:user user) '()) + #$@(if group (list #:group group) '()) #$@(if (maybe-value-set? log-file) (list #:log-file log-file) '()) + #$@(if (and user (eq? runtime 'podman)) + (list #:directory + #~(passwd:dir (getpwnam #$user))) + '()) #:environment-variables - (list #$@host-environment)))) + (append + (list #$@host-environment) + (list #$@runtime-environment))))) (stop #~(lambda _ - (invoke #$docker "rm" "-f" #$name))) + (invoke #$runtime-cli "rm" "-f" #$name))) (actions - (if (oci-image? image) - '() - (append + (append + (list + (oci-object-command-shepherd-action + name #~(string-join (list #$@invokation) " "))) + (if (oci-image? image) + '() (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 + (let ((service-name name)) + (shepherd-action + (name 'pull) + (documentation + (format #f "Pull ~a's image (~a)." + service-name image)) + (procedure + #~(lambda _ + (invoke #$runtime-cli "pull" #$image))))))) + actions))))) + +(define (oci-object-create-invokation object runtime-cli name options + runtime-extra-arguments + create-extra-arguments) + "Return a gexp that, upon lowering, will evaluate to the OCI runtime +invokation for creating networks and volumes." + ;; network|volume create [options] [NAME] + #~(list #$runtime-cli #$@runtime-extra-arguments #$object "create" + #$@options #$@create-extra-arguments #$name)) + +(define (format-oci-invokations invokations) + "Return a gexp that, upon lowering, will evaluate to a formatted message +containing the INVOKATIONS that the OCI runtime will execute to provision +networks or volumes." + #~(string-join (map (lambda (i) (string-join i " ")) + (list #$@invokations)) + "\n")) + +(define* (oci-object-create-script object runtime runtime-cli invokations + #:key (verbose? #f)) + "Return a file-like object that, once lowered, will evaluate to a program able +to create OCI networks and volumes through RUNTIME-CLI." + (define runtime-string (symbol->string runtime)) + (program-file + (string-append runtime-string "-" object "s-create.scm") + #~(begin + (use-modules (ice-9 format) + (ice-9 match) + (ice-9 popen) + (ice-9 rdelim) + (srfi srfi-1)) + + (define object-exists? + #$(oci-object-exists? runtime runtime-cli object verbose?)) + + (for-each + (lambda (invokation) + (define name (last invokation)) + (if (object-exists? name) + (format #t "~a ~a ~a already exists, skipping creation.~%" + #$(oci-runtime-name runtime) name #$object) + (begin + (when #$verbose? + (format #t "Running~{ ~a~}~%" invokation)) + (let ((exit-code (status:exit-val (apply system* invokation)))) + (when #$verbose? + (format #t "Exit code: ~a~%" exit-code)))))) + (list #$@invokations))))) + +(define* (oci-object-shepherd-service object runtime runtime-cli name requirement invokations + #:key + (runtime-environment #~()) + (user #f) + (group #f) + (verbose? #f)) + "Return a Shepherd service object that will create the OBJECTs represented +by INVOKATIONS through RUNTIME-CLI." + (shepherd-service (provision `(,(string->symbol name))) + (requirement requirement) + (one-shot? #t) + (documentation + (string-append + (oci-runtime-name runtime) " " object + " provisioning service")) + (start + #~(lambda _ + (fork+exec-command + (list + #$(oci-object-create-script + object runtime runtime-cli + invokations + #:verbose? verbose?)) + #$@(if user (list #:user user) '()) + #$@(if group (list #:group group) '()) + #:environment-variables + (list #$@runtime-environment)))) + (actions + (list + (oci-object-command-shepherd-action + name (format-oci-invokations invokations)))))) + +(define* (oci-networks-shepherd-service runtime runtime-cli name networks + #:key (user #f) (group #f) (verbose? #f) + (runtime-extra-arguments '()) + (runtime-environment #~()) + (runtime-requirement '())) + "Return a Shepherd service object that will create the networks represented +in CONFIG." + (let ((invokations + (map + (lambda (network) + (oci-object-create-invokation + "network" runtime-cli + (oci-network-configuration-name network) + (oci-network-configuration->options network) + runtime-extra-arguments + (oci-network-configuration-extra-arguments network))) + networks))) + + (oci-object-shepherd-service + "network" runtime runtime-cli name + runtime-requirement invokations + #:user user #:group group #:runtime-environment runtime-environment + #:verbose? verbose?))) + +(define* (oci-volumes-shepherd-service runtime runtime-cli name volumes + #:key (user #f) (group #f) (verbose? #f) + (runtime-extra-arguments '()) + (runtime-environment #~()) + (runtime-requirement '())) + "Return a Shepherd service object that will create the volumes represented +in CONFIG." + (let ((invokations + (map + (lambda (volume) + (oci-object-create-invokation + "volume" runtime-cli + (oci-volume-configuration-name volume) + (oci-volume-configuration->options volume) + runtime-extra-arguments + (oci-volume-configuration-extra-arguments volume))) + volumes))) + + (oci-object-shepherd-service + "volume" runtime runtime-cli name runtime-requirement invokations + #:user user #:group group #:runtime-environment runtime-environment + #:verbose? verbose?))) + +(define (oci-service-accounts config) + (define user (oci-configuration-user config)) + (define maybe-group (oci-configuration-group config)) + (define runtime (oci-configuration-runtime config)) (list (user-account - (name "oci-container") + (name user) (comment "OCI services account") - (group "docker") - (system? #t) - (home-directory "/var/empty") + (group "users") + (supplementary-groups + (list (oci-runtime-group runtime maybe-group))) + (system? (eq? 'docker runtime)) + (home-directory (if (eq? 'podman runtime) + (string-append "/home/" user) + "/var/empty")) + (create-home-directory? (eq? 'podman runtime)) (shell (file-append shadow "/sbin/nologin"))))) + +(define* (oci-state->shepherd-services runtime runtime-cli containers networks volumes + #:key (user #f) (group #f) (verbose? #f) + (networks-name #f) (volumes-name #f) + (runtime-extra-arguments '()) + (runtime-environment #~()) + (runtime-requirement '()) + (containers-requirement '()) + (networks-requirement '()) + (volumes-requirement '())) + (let* ((networks? + (> (length networks) 0)) + (networks-service + (if networks? + (list + (string->symbol + (oci-networks-shepherd-name runtime))) + '())) + (volumes? + (> (length volumes) 0)) + (volumes-service + (if volumes? + (list + (string->symbol + (oci-volumes-shepherd-name runtime))) + '()))) + (append + (map + (lambda (c) + (oci-container-shepherd-service + runtime runtime-cli c + #:user user + #:group group + #:runtime-environment runtime-environment + #:runtime-extra-arguments runtime-extra-arguments + #:oci-requirement + (append containers-requirement + runtime-requirement + networks-service + volumes-service) + #:verbose? verbose?)) + containers) + (if networks? + (list + (oci-networks-shepherd-service + runtime runtime-cli + (if (string? networks-name) + networks-name + (oci-networks-shepherd-name runtime)) + networks + #:user user #:group group + #:runtime-extra-arguments runtime-extra-arguments + #:runtime-environment runtime-environment + #:runtime-requirement (append networks-requirement + runtime-requirement) + #:verbose? verbose?)) + '()) + (if volumes? + (list + (oci-volumes-shepherd-service + runtime runtime-cli + (if (string? volumes-name) + volumes-name + (oci-volumes-shepherd-name runtime)) + volumes + #:user user #:group group + #:runtime-extra-arguments runtime-extra-arguments + #:runtime-environment runtime-environment + #:runtime-requirement (append runtime-requirement + volumes-requirement) + #:verbose? verbose?)) + '())))) + +(define (oci-configuration->shepherd-services config) + (let* ((runtime (oci-configuration-runtime config)) + (runtime-cli + (oci-runtime-system-cli config)) + (runtime-extra-arguments + (oci-configuration-runtime-extra-arguments config)) + (containers (oci-configuration-containers config)) + (networks (oci-configuration-networks config)) + (volumes (oci-configuration-volumes config)) + (user (oci-configuration-user config)) + (group (oci-runtime-group + runtime (oci-configuration-group config))) + (verbose? (oci-configuration-verbose? config))) + (oci-state->shepherd-services runtime runtime-cli containers networks volumes + #:user user + #:group + (oci-runtime-system-group runtime user group) + #:verbose? verbose? + #:runtime-extra-arguments + runtime-extra-arguments + #:runtime-environment + (oci-runtime-system-environment runtime user) + #:runtime-requirement + (oci-runtime-system-requirement runtime) + #:networks-requirement '(networking)))) + +(define (oci-service-subids config) + "Return a subids-extension record representing subuids and subgids required by +the rootless Podman backend." + (define (delete-duplicate-ranges ranges) + (delete-duplicates ranges + (lambda args + (apply string=? (map subid-range-name ranges))))) + (define runtime + (oci-configuration-runtime config)) + (define user + (oci-configuration-user config)) + (define subgids (oci-configuration-subgids-range config)) + (define subuids (oci-configuration-subuids-range config)) + (define container-users + (filter (lambda (range) + (and (maybe-value-set? + (subid-range-name range)) + (not (string=? (subid-range-name range) user)))) + (map (lambda (container) + (subid-range + (name + (oci-container-configuration-user container)))) + (oci-configuration-containers config)))) + (define subgid-ranges + (delete-duplicate-ranges + (cons + (if (maybe-value-set? subgids) + subgids + (subid-range (name user))) + container-users))) + (define subuid-ranges + (delete-duplicate-ranges + (cons + (if (maybe-value-set? subuids) + subuids + (subid-range (name user))) + container-users))) + + (if (eq? 'podman runtime) + (subids-extension + (subgids + subgid-ranges) + (subuids + subuid-ranges)) + (subids-extension))) + +(define (oci-objects-merge-lst a b object get-name) + (define (contains? value lst) + (member value (map get-name lst))) + (let loop ((merged '()) + (lst (append a b))) + (if (null? lst) + merged + (loop + (let ((element (car lst))) + (when (contains? element merged) + (raise + (formatted-message + (G_ "Duplicated ~a: ~a. ~as names should be unique, please +remove the duplicate.") object (get-name element) object))) + (cons element merged)) + (cdr lst))))) + +(define (oci-extension-merge a b) + (oci-extension + (containers (oci-objects-merge-lst + (oci-extension-containers a) + (oci-extension-containers b) + "container" + (lambda (config) + (define maybe-name (oci-container-configuration-provision config)) + (if (maybe-value-set? maybe-name) + maybe-name + (oci-image->container-name + (oci-container-configuration-image config)))))) + (networks (oci-objects-merge-lst + (oci-extension-networks a) + (oci-extension-networks b) + "network" + oci-network-configuration-name)) + (volumes (oci-objects-merge-lst + (oci-extension-volumes a) + (oci-extension-volumes b) + "volume" + oci-volume-configuration-name)))) + +(define (oci-service-profile runtime runtime-cli) + (list bash-minimal + (cond + ((maybe-value-set? runtime-cli) + runtime-cli) + ((eq? 'podman runtime) + podman) + (else + docker-cli)))) + +(define oci-service-type + (service-type (name 'oci) + (extensions + (list + (service-extension profile-service-type + (lambda (config) + (let ((runtime-cli + (oci-configuration-runtime-cli config)) + (runtime + (oci-configuration-runtime config))) + (oci-service-profile runtime runtime-cli)))) + (service-extension subids-service-type + oci-service-subids) + (service-extension account-service-type + oci-service-accounts) + (service-extension shepherd-root-service-type + oci-configuration->shepherd-services))) + ;; Concatenate OCI object lists. + (compose (lambda (args) + (fold oci-extension-merge + (oci-extension) + args))) + (extend + (lambda (config extension) + (oci-configuration + (inherit config) + (containers + (oci-objects-merge-lst + (oci-configuration-containers config) + (oci-extension-containers extension) + "container" + (lambda (oci-config) + (define runtime + (oci-configuration-runtime config)) + (oci-container-shepherd-name runtime oci-config)))) + (networks (oci-objects-merge-lst + (oci-configuration-networks config) + (oci-extension-networks extension) + "network" + oci-network-configuration-name)) + (volumes (oci-objects-merge-lst + (oci-configuration-volumes config) + (oci-extension-volumes extension) + "volume" + oci-volume-configuration-name))))) + (default-value (oci-configuration)) + (description + "This service implements the provisioning of OCI object such +as containers, networks and volumes."))) diff --git a/gnu/services/docker.scm b/gnu/services/docker.scm index 69ff9f1d9e4..98ee175873d 100644 --- a/gnu/services/docker.scm +++ b/gnu/services/docker.scm @@ -31,7 +31,10 @@ (define-module (gnu services docker) #:use-module (gnu system shadow) #:use-module (gnu packages docker) #:use-module (gnu packages linux) ;singularity + #:use-module (guix deprecation) + #:use-module (guix diagnostics) #:use-module (guix gexp) + #:use-module (guix i18n) #:use-module (guix records) #:use-module (srfi srfi-1) #:use-module (ice-9 format) @@ -67,16 +70,18 @@ (define-module (gnu services docker) 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) + oci-container-configuration-extra-arguments) #:export (containerd-configuration containerd-service-type docker-configuration docker-service-type singularity-service-type - oci-container-service-type)) + ;; for backwards compatibility, until the + ;; oci-container-service-type is fully deprecated + oci-container-shepherd-service + oci-container-service-type + %oci-container-accounts)) (define-maybe file-like) @@ -295,17 +300,25 @@ (define singularity-service-type ;;; OCI container. ;;; -(define (configs->shepherd-services configs) - (map oci-container-shepherd-service configs)) +;; for backwards compatibility, until the +;; oci-container-service-type is fully deprecated +(define-deprecated (oci-container-shepherd-service config) + oci-service-type + ((@ (gnu services containers) oci-container-shepherd-service) + 'docker config)) +(define %oci-container-accounts + (filter user-account? (oci-service-accounts (oci-configuration)))) (define oci-container-service-type (service-type (name 'oci-container) - (extensions (list (service-extension profile-service-type - (lambda _ (list docker-cli))) - (service-extension account-service-type - (const %oci-container-accounts)) - (service-extension shepherd-root-service-type - configs->shepherd-services))) + (extensions + (list (service-extension oci-service-type + (lambda (containers) + (warning + (G_ + "'oci-container-service-type' is deprecated, use 'oci-service-type' instead~%")) + (oci-extension + (containers containers)))))) (default-value '()) (extend append) (compose concatenate) diff --git a/gnu/tests/containers.scm b/gnu/tests/containers.scm index 0ecc8ddb126..bac1f47bd34 100644 --- a/gnu/tests/containers.scm +++ b/gnu/tests/containers.scm @@ -27,6 +27,9 @@ (define-module (gnu tests containers) #: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 @@ (define-module (gnu tests containers) #: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 @@ -345,3 +350,995 @@ (define %test-rootless-podman (name "rootless-podman") (description "Test rootless Podman service.") (value (build-tarball&run-rootless-podman-test)))) + + +(define %oci-rootless-podman-os + (simple-operating-system + (service dhcp-client-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-configuration (name "my-network")))) + (volumes + (list (oci-volume-configuration (name "my-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)(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 services herd) + (guix combinators)))) + + (define vm + (virtual-machine + (operating-system os) + (volatile? #f) + (memory-size 1024) + (disk-image-size (* 3000 (expt 2 20))) + (port-forwardings '()))) + + (define test + (with-imported-modules '((gnu build marionette)) + #~(begin + (use-modules (srfi srfi-11) (srfi srfi-64) + (gnu build marionette)) + + (define marionette + ;; Relax timeout to accommodate older systems and + ;; allow for pulling the image. + (make-marionette (list #$vm) #:timeout 60)) + (define out-dir "/tmp") + + (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 "rootless-podman services started successfully" + (begin + (define (run-test) + (marionette-eval + `(begin + (use-modules (ice-9 popen) + (ice-9 match) + (ice-9 rdelim)) + + (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 slurp + (lambda args + (let* ((port (apply open-pipe* OPEN_READ args)) + (output (read-lines port)) + (status (close-pipe port))) + output))) + (let* ((bash + ,(string-append #$bash "/bin/bash")) + (response1 + (slurp bash "-c" + (string-append "ls -la /sys/fs/cgroup | " + "grep -E ' \\./?$' | awk '{ print $4 }'"))) + (response2 (slurp bash "-c" + (string-append "ls -l /sys/fs/cgroup/cgroup" + ".{procs,subtree_control,threads} | " + "awk '{ print $4 }' | sort -u")))) + (list (string-join response1 "\n") (string-join response2 "\n")))) + marionette)) + ;; Allow services to come up on slower machines + (let loop ((attempts 0)) + (if (= attempts 60) + (error "Services didn't come up after more than 60 seconds") + (if (equal? '("cgroup" "cgroup") + (run-test)) + #t + (begin + (sleep 1) + (format #t "Services didn't come up yet, retrying with attempt ~a~%" + (+ 1 attempts)) + (loop (+ 1 attempts)))))))) + + (test-assert "podman-volumes running" + (begin + (define (run-test) + (marionette-eval + `(begin + (use-modules (srfi srfi-1) + (ice-9 popen) + (ice-9 match) + (ice-9 rdelim)) + + (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 (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 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))) + + (match (primitive-fork) + (0 + (dynamic-wind + (const #f) + (lambda () + (setgid (passwd:gid (getpwnam "oci-container"))) + (setuid (passwd:uid (getpw "oci-container"))) + + (let ((response (slurp + "/run/current-system/profile/bin/podman" + "volume" "ls" "-n" "--format" "\"{{.Name}}\"" + "|" "tr" "' '" "'\n'"))) + + (call-with-output-file (string-append ,out-dir "/response") + (lambda (port) + (display (string-join response "\n") port))))) + (lambda () + (primitive-exit 127)))) + (pid + (cdr (waitpid pid)))) + + (wait-for-file (string-append ,out-dir "/response")) + + (stable-sort + (slurp "cat" (string-append ,out-dir "/response")) + string<=?)) + marionette)) + ;; Allow services to come up on slower machines + (let loop ((attempts 0)) + (if (= attempts 80) + (error "Service didn't come up after more than 80 seconds") + (if (equal? '("my-volume") + (run-test)) + #t + (begin + (sleep 1) + (loop (+ 1 attempts)))))))) + + (test-assert "podman-networks running" + (begin + (define (run-test) + (marionette-eval + `(begin + (use-modules (srfi srfi-1) + (ice-9 popen) + (ice-9 match) + (ice-9 rdelim)) + + (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 (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 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))) + + (match (primitive-fork) + (0 + (dynamic-wind + (const #f) + (lambda () + (setgid (passwd:gid (getpwnam "oci-container"))) + (setuid (passwd:uid (getpw "oci-container"))) + + (let ((response (slurp + "/run/current-system/profile/bin/podman" + "network" "ls" "-n" "--format" "\"{{.Name}}\"" + "|" "tr" "' '" "'\n'"))) + + (call-with-output-file (string-append ,out-dir "/response") + (lambda (port) + (display (string-join response "\n") port))))) + (lambda () + (primitive-exit 127)))) + (pid + (cdr (waitpid pid)))) + + (wait-for-file (string-append ,out-dir "/response")) + + (stable-sort + (slurp "cat" (string-append ,out-dir "/response")) + string<=?)) + marionette)) + ;; Allow services to come up on slower machines + (let loop ((attempts 0)) + (if (= attempts 80) + (error "Service didn't come up after more than 80 seconds") + (if (equal? '("my-network" "podman") + (run-test)) + #t + (begin + (sleep 1) + (loop (+ 1 attempts)))))))) + + (test-assert "first container running" + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (wait-for-service 'first #:timeout 120) + #t) + marionette)) + + (test-assert "second container running" + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (wait-for-service 'second #:timeout 120) + #t) + marionette)) + + (test-assert "passing host environment variables" + (begin + (define (run-test) + (marionette-eval + `(begin + (use-modules (srfi srfi-1) + (ice-9 popen) + (ice-9 match) + (ice-9 rdelim)) + + (define (wait-for-file file) + ;; Wait until FILE shows up. + (let loop ((i 60)) + (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 (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 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))) + + (match (primitive-fork) + (0 + (dynamic-wind + (const #f) + (lambda () + (setgid (passwd:gid (getpwnam "oci-container"))) + (setuid (passwd:uid (getpw "oci-container"))) + + (let ((response (slurp + "/run/current-system/profile/bin/podman" + "exec" "first" + "/bin/guile" "-c" "'(display (getenv \"VARIABLE\"))'"))) + (call-with-output-file (string-append ,out-dir "/response") + (lambda (port) + (display (string-join response "\n") port))))) + (lambda () + (primitive-exit 127)))) + (pid + (cdr (waitpid pid)))) + + (wait-for-file (string-append ,out-dir "/response")) + (slurp "cat" (string-append ,out-dir "/response"))) + marionette)) + ;; Allow image to be loaded on slower machines + (let loop ((attempts 0)) + (if (= attempts 180) + (error "Service didn't come up after more than 180 seconds") + (if (equal? (list "value") + (run-test)) + #t + (begin + (sleep 1) + (loop (+ 1 attempts)))))))) + + (test-equal "mounting host files" + '("hello") + (marionette-eval + `(begin + (use-modules (srfi srfi-1) + (ice-9 popen) + (ice-9 match) + (ice-9 rdelim)) + + (define (wait-for-file file) + ;; Wait until FILE shows up. + (let loop ((i 60)) + (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 (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 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))) + + (match (primitive-fork) + (0 + (dynamic-wind + (const #f) + (lambda () + (setgid (passwd:gid (getpwnam "oci-container"))) + (setuid (passwd:uid (getpw "oci-container"))) + + (let ((response (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)))'"))) + (call-with-output-file (string-append ,out-dir "/response") + (lambda (port) + (display (string-join response " ") port))))) + (lambda () + (primitive-exit 127)))) + (pid + (cdr (waitpid pid)))) + + (wait-for-file (string-append ,out-dir "/response")) + (slurp "cat" (string-append ,out-dir "/response"))) + marionette)) + + (test-equal "write to volumes" + '("world") + (marionette-eval + `(begin + (use-modules (srfi srfi-1) + (ice-9 popen) + (ice-9 match) + (ice-9 rdelim)) + + (define (wait-for-file file) + ;; Wait until FILE shows up. + (let loop ((i 60)) + (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 (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 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))) + + (match (primitive-fork) + (0 + (dynamic-wind + (const #f) + (lambda () + (setgid (passwd:gid (getpwnam "oci-container"))) + (setuid (passwd:uid (getpw "oci-container"))) + + (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))))'") + + (let ((response (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)))'"))) + (call-with-output-file (string-append ,out-dir "/response") + (lambda (port) + (display (string-join response " ") port))))) + (lambda () + (primitive-exit 127)))) + (pid + (cdr (waitpid pid)))) + + (wait-for-file (string-append ,out-dir "/response")) + (slurp "cat" (string-append ,out-dir "/response"))) + marionette)) + + (test-equal "can read ports over network" + '("out of office") + (marionette-eval + `(begin + (use-modules (srfi srfi-1) + (ice-9 popen) + (ice-9 match) + (ice-9 rdelim)) + + (define (wait-for-file file) + ;; Wait until FILE shows up. + (let loop ((i 60)) + (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 (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 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))) + + (match (primitive-fork) + (0 + (dynamic-wind + (const #f) + (lambda () + (setgid (passwd:gid (getpwnam "oci-container"))) + (setuid (passwd:uid (getpw "oci-container"))) + + (let ((response (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))'"))) + (call-with-output-file (string-append ,out-dir "/response") + (lambda (port) + (display (string-join response " ") port))))) + (lambda () + (primitive-exit 127)))) + (pid + (cdr (waitpid pid)))) + + (wait-for-file (string-append ,out-dir "/response")) + (slurp "cat" (string-append ,out-dir "/response"))) + 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-os + (simple-operating-system + (service dhcp-client-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-configuration (name "my-network")))) + (volumes + (list (oci-volume-configuration (name "my-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)(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 services herd) + (guix combinators)))) + + (define vm + (virtual-machine + (operating-system os) + (volatile? #f) + (memory-size 1024) + (disk-image-size (* 3000 (expt 2 20))) + (port-forwardings '()))) + + (define test + (with-imported-modules '((gnu build marionette)) + #~(begin + (use-modules (srfi srfi-11) (srfi srfi-64) + (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) + (marionette-eval + `(begin + (use-modules (ice-9 popen) + (ice-9 rdelim)) + + (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 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))) + + (stable-sort + (slurp + "/run/current-system/profile/bin/docker" + "volume" "ls" "--format" "\"{{.Name}}\"") + string<=?)) + + marionette)) + ;; Allow services to come up on slower machines + (let loop ((attempts 0)) + (if (= attempts 80) + (error "Service didn't come up after more than 80 seconds") + (if (equal? '("my-volume") + (run-test)) + #t + (begin + (sleep 1) + (loop (+ 1 attempts)))))))) + + (test-assert "docker-networks running" + (begin + (define (run-test) + (marionette-eval + `(begin + (use-modules (ice-9 popen) + (ice-9 rdelim)) + + (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 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))) + + (stable-sort + (slurp + "/run/current-system/profile/bin/docker" + "network" "ls" "--format" "\"{{.Name}}\"") + string<=?)) + + marionette)) + ;; Allow services to come up on slower machines + (let loop ((attempts 0)) + (if (= attempts 80) + (error "Service didn't come up after more than 80 seconds") + (if (equal? '("bridge" "host" "my-network" "none") + (run-test)) + #t + (begin + (sleep 1) + (loop (+ 1 attempts)))))))) + + (test-assert "first container running" + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (wait-for-service 'first #:timeout 120) + #t) + marionette)) + + (test-assert "second container running" + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (wait-for-service 'second #:timeout 120) + #t) + marionette)) + + (test-assert "passing host environment variables" + (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))) + + (slurp + "/run/current-system/profile/bin/docker" + "exec" "first" + "/bin/guile" "-c" "(display (getenv \"VARIABLE\"))")) + marionette)) + ;; Allow image to be loaded on slower machines + (let loop ((attempts 0)) + (if (= attempts 180) + (error "Service didn't come up after more than 180 seconds") + (if (equal? "value" + (run-test)) + #t + (begin + (sleep 1) + (loop (+ 1 attempts)))))))) + + (test-equal "mounting host files" + "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))) + + (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 \"/shared.txt\" read-line)))")) + marionette)) + + (test-equal "write to volumes" + "world" + (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))) + + (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 ports over network" + "out of office" + (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))) + + (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)))) -- 2.48.1 From unknown Fri Jun 13 11:55:10 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#76081] [PATCH v4 4/4] tests: Use lower-oci-image-state in container tests. Resent-From: Giacomo Leidi Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Wed, 12 Feb 2025 01:11:03 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 76081 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 76081@debbugs.gnu.org Cc: Giacomo Leidi Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.173932265632396 (code B ref 76081); Wed, 12 Feb 2025 01:11:03 +0000 Received: (at 76081) by debbugs.gnu.org; 12 Feb 2025 01:10:56 +0000 Received: from localhost ([127.0.0.1]:59705 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ti1HD-0008QQ-3n for submit@debbugs.gnu.org; Tue, 11 Feb 2025 20:10:55 -0500 Received: from confino.investici.org ([93.190.126.19]:46585) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1ti1H6-0008Pn-Dq for 76081@debbugs.gnu.org; Tue, 11 Feb 2025 20:10:49 -0500 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org; s=stigmate; t=1739322647; bh=HMW90ejxBeH5UYDjCNV/eguiuFUBPfKqWYkFSGGNlzI=; h=From:To:Cc:Subject:Date:In-Reply-To:References:From; b=VwdgjMHxOKB1GjaIz4CNPaWHzyhgVOwFV8dWAvjMgf8Tf4fOM0rut8ILsNUHvxcFg sBlVAmEB1x7c02k2f6iNmvizqIEqiXd5vQQMIdy+9QQosnp7AUc/ypI7WKBsVQnb/5 iOhVWc9a1konNr0fwF8vAoU6byRQO3g2Qs8UkqlY= Received: from mx1.investici.org (unknown [127.0.0.1]) by confino.investici.org (Postfix) with ESMTP id 4Yt0cR3jfRz1123; Wed, 12 Feb 2025 01:10:47 +0000 (UTC) Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19]) (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with ESMTPSA id 4Yt0cR2mwGz110r; Wed, 12 Feb 2025 01:10:47 +0000 (UTC) From: Giacomo Leidi Date: Wed, 12 Feb 2025 02:10:37 +0100 Message-ID: X-Mailer: git-send-email 2.48.1 In-Reply-To: <3e199fa3b6b15d853ea1887ad0c518c7cb4f4b25.1739322637.git.goodoldpaul@autistici.org> References: <3e199fa3b6b15d853ea1887ad0c518c7cb4f4b25.1739322637.git.goodoldpaul@autistici.org> MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Spam-Score: -0.7 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.7 (-) This patch replaces boilerplate in container related tests with oci-image plumbing from (gnu services containers). * gnu/services/containers.scm: Export lower-oci-image-state. * gnu/tests/containers.scm (%oci-tarball): New variable; (run-rootless-podman-test): use %oci-tarball; (build-tarball&run-rootless-podman-test): drop procedure. * gnu/tests/docker.scm (%docker-tarball): New variable; (build-tarball&run-docker-test): use %docker-tarball; (%docker-system-tarball): New variable; (build-tarball&run-docker-system-test): new procedure. Change-Id: Iad6f0704aee188d89464c83722dea0bb7adb084a --- gnu/services/containers.scm | 2 + gnu/tests/containers.scm | 80 ++++++++++++++--------------- gnu/tests/docker.scm | 100 ++++++++++++++++++++---------------- 3 files changed, 95 insertions(+), 87 deletions(-) diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm index 018dfa60f48..63e9cb37b53 100644 --- a/gnu/services/containers.scm +++ b/gnu/services/containers.scm @@ -74,6 +74,8 @@ (define-module (gnu services containers) oci-image-system oci-image-grafts? + lower-oci-image-state + oci-container-configuration oci-container-configuration? oci-container-configuration-fields diff --git a/gnu/tests/containers.scm b/gnu/tests/containers.scm index bac1f47bd34..1fcf6be7ace 100644 --- a/gnu/tests/containers.scm +++ b/gnu/tests/containers.scm @@ -69,13 +69,47 @@ (define %rootless-podman-os (supplementary-groups '("wheel" "netdev" "cgroup" "audio" "video"))))))) -(define (run-rootless-podman-test oci-tarball) +(define %oci-tarball + (lower-oci-image-state + "guile-guest" + (packages->manifest + (list + guile-3.0 guile-json-3 + (package + (name "guest-script") + (version "0") + (source #f) + (build-system trivial-build-system) + (arguments `(#:guile ,guile-3.0 + #:builder + (let ((out (assoc-ref %outputs "out"))) + (mkdir out) + (call-with-output-file (string-append out "/a.scm") + (lambda (port) + (display "(display \"hello world\n\")" port))) + #t))) + (synopsis "Display hello world using Guile") + (description "This package displays the text \"hello world\" on the +standard output device and then enters a new line.") + (home-page #f) + (license license:public-domain)))) + '(#:entry-point "bin/guile" + #:localstatedir? #t + #:extra-options (#:image-tag "guile-guest") + #:symlinks (("/bin/Guile" -> "bin/guile") + ("aa.scm" -> "a.scm"))) + "guile-guest" + (%current-target-system) + (%current-system) + #f)) + +(define (run-rootless-podman-test) (define os (marionette-operating-system (operating-system-with-gc-roots %rootless-podman-os - (list oci-tarball)) + (list %oci-tarball)) #:imported-modules '((gnu services herd) (guix combinators)))) @@ -254,7 +288,7 @@ (define (run-rootless-podman-test oci-tarball) (let* ((loaded (slurp ,(string-append #$podman "/bin/podman") "load" "-i" - ,#$oci-tarball)) + ,#$%oci-tarball)) (repository&tag "localhost/guile-guest:latest") (response1 (slurp ,(string-append #$podman "/bin/podman") @@ -307,49 +341,11 @@ (define (run-rootless-podman-test oci-tarball) (gexp->derivation "rootless-podman-test" test)) -(define (build-tarball&run-rootless-podman-test) - (mlet* %store-monad - ((_ (set-grafting #f)) - (guile (set-guile-for-build (default-guile))) - (guest-script-package -> - (package - (name "guest-script") - (version "0") - (source #f) - (build-system trivial-build-system) - (arguments `(#:guile ,guile-3.0 - #:builder - (let ((out (assoc-ref %outputs "out"))) - (mkdir out) - (call-with-output-file (string-append out "/a.scm") - (lambda (port) - (display "(display \"hello world\n\")" port))) - #t))) - (synopsis "Display hello world using Guile") - (description "This package displays the text \"hello world\" on the -standard output device and then enters a new line.") - (home-page #f) - (license license:public-domain))) - (profile (profile-derivation (packages->manifest - (list guile-3.0 guile-json-3 - guest-script-package)) - #:hooks '() - #:locales? #f)) - (tarball (pack:docker-image - "docker-pack" profile - #:symlinks '(("/bin/Guile" -> "bin/guile") - ("aa.scm" -> "a.scm")) - #:extra-options - '(#:image-tag "guile-guest") - #:entry-point "bin/guile" - #:localstatedir? #t))) - (run-rootless-podman-test tarball))) - (define %test-rootless-podman (system-test (name "rootless-podman") (description "Test rootless Podman service.") - (value (build-tarball&run-rootless-podman-test)))) + (value (run-rootless-podman-test)))) (define %oci-rootless-podman-os diff --git a/gnu/tests/docker.scm b/gnu/tests/docker.scm index 5dcf05a17e3..07edd9d5341 100644 --- a/gnu/tests/docker.scm +++ b/gnu/tests/docker.scm @@ -26,6 +26,7 @@ (define-module (gnu tests docker) #:use-module (gnu system image) #:use-module (gnu system vm) #:use-module (gnu services) + #:use-module (gnu services containers) #:use-module (gnu services dbus) #:use-module (gnu services networking) #:use-module (gnu services docker) @@ -57,6 +58,40 @@ (define %docker-os (service containerd-service-type) (service docker-service-type))) +(define %docker-tarball + (lower-oci-image-state + "guile-guest" + (packages->manifest + (list + guile-3.0 guile-json-3 + (package + (name "guest-script") + (version "0") + (source #f) + (build-system trivial-build-system) + (arguments `(#:guile ,guile-3.0 + #:builder + (let ((out (assoc-ref %outputs "out"))) + (mkdir out) + (call-with-output-file (string-append out "/a.scm") + (lambda (port) + (display "(display \"hello world\n\")" port))) + #t))) + (synopsis "Display hello world using Guile") + (description "This package displays the text \"hello world\" on the +standard output device and then enters a new line.") + (home-page #f) + (license license:public-domain)))) + '(#:entry-point "bin/guile" + #:localstatedir? #t + #:extra-options (#:image-tag "guile-guest") + #:symlinks (("/bin/Guile" -> "bin/guile") + ("aa.scm" -> "a.scm"))) + "guile-guest" + (%current-target-system) + (%current-system) + #f)) + (define (run-docker-test docker-tarball) "Load DOCKER-TARBALL as Docker image and run it in a Docker container, inside %DOCKER-OS." @@ -173,40 +208,7 @@ (define (run-docker-test docker-tarball) (gexp->derivation "docker-test" test)) (define (build-tarball&run-docker-test) - (mlet* %store-monad - ((_ (set-grafting #f)) - (guile (set-guile-for-build (default-guile))) - (guest-script-package -> - (package - (name "guest-script") - (version "0") - (source #f) - (build-system trivial-build-system) - (arguments `(#:guile ,guile-3.0 - #:builder - (let ((out (assoc-ref %outputs "out"))) - (mkdir out) - (call-with-output-file (string-append out "/a.scm") - (lambda (port) - (display "(display \"hello world\n\")" port))) - #t))) - (synopsis "Display hello world using Guile") - (description "This package displays the text \"hello world\" on the -standard output device and then enters a new line.") - (home-page #f) - (license license:public-domain))) - (profile (profile-derivation (packages->manifest - (list guile-3.0 guile-json-3 - guest-script-package)) - #:hooks '() - #:locales? #f)) - (tarball (pack:docker-image - "docker-pack" profile - #:symlinks '(("/bin/Guile" -> "bin/guile") - ("aa.scm" -> "a.scm")) - #:entry-point "bin/guile" - #:localstatedir? #t))) - (run-docker-test tarball))) + (run-docker-test %docker-tarball)) (define %test-docker (system-test @@ -215,8 +217,22 @@ (define %test-docker (value (build-tarball&run-docker-test)))) +(define %docker-system-tarball + (lower-oci-image-state + "guix-system-guest" + (operating-system + (inherit (simple-operating-system)) + ;; Use locales for a single libc to + ;; reduce space requirements. + (locale-libcs (list glibc))) + '() + "guix-system-guest" + (%current-target-system) + (%current-system) + #f)) + (define (run-docker-system-test tarball) - "Load DOCKER-TARBALL as Docker image and run it in a Docker container, + "Load TARBALL as Docker image and run it in a Docker container, inside %DOCKER-OS." (define os (marionette-operating-system @@ -333,21 +349,15 @@ (define (run-docker-system-test tarball) (gexp->derivation "docker-system-test" test)) +(define (build-tarball&run-docker-system-test) + (run-docker-system-test %docker-system-tarball)) + (define %test-docker-system (system-test (name "docker-system") (description "Run a system image as produced by @command{guix system docker-image} inside Docker.") - (value (with-monad %store-monad - (>>= (lower-object - (system-image (os->image - (operating-system - (inherit (simple-operating-system)) - ;; Use locales for a single libc to - ;; reduce space requirements. - (locale-libcs (list glibc))) - #:type docker-image-type))) - run-docker-system-test))))) + (value (build-tarball&run-docker-system-test)))) (define %oci-os -- 2.48.1 From unknown Fri Jun 13 11:55:10 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#76081] [PATCH v4 1/4] services: rootless-podman: Use login shell. References: <2f43e635-508c-407a-8309-06e75d492d89@autistici.org> In-Reply-To: <2f43e635-508c-407a-8309-06e75d492d89@autistici.org> Resent-From: Giacomo Leidi Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Wed, 12 Feb 2025 01:11:03 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 76081 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 76081@debbugs.gnu.org Cc: Giacomo Leidi Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.173932265632405 (code B ref 76081); Wed, 12 Feb 2025 01:11:03 +0000 Received: (at 76081) by debbugs.gnu.org; 12 Feb 2025 01:10:56 +0000 Received: from localhost ([127.0.0.1]:59707 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ti1HE-0008Qa-52 for submit@debbugs.gnu.org; Tue, 11 Feb 2025 20:10:56 -0500 Received: from confino.investici.org ([2a11:7980:1::2:0]:56991) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1ti1H7-0008Pj-4w for 76081@debbugs.gnu.org; Tue, 11 Feb 2025 20:10:49 -0500 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org; s=stigmate; t=1739322646; bh=DYecIs2DDQmcg9DDiyTdZ/3TSj9SQGRkZLq3/7QxiFk=; h=From:To:Cc:Subject:Date:From; b=cHvqoIqwjUmD5xY/KdvEaGtY4ys4a4rERrlgwsnvh997uEfgZtKjr6+dak67Cjm6m 3snWhVJthn5EWarR+QC1U0xYrgvspDyuabDjn9XgraFWavOYE0WSfVyBwiKJyAVWKg Ccsp4Lfo/z+0lTJBj7LA+QtYepa5YXbhQdgpPFG0= Received: from mx1.investici.org (unknown [127.0.0.1]) by confino.investici.org (Postfix) with ESMTP id 4Yt0cQ2PvMz110q; Wed, 12 Feb 2025 01:10:46 +0000 (UTC) Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19]) (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with ESMTPSA id 4Yt0cQ1SHPz111Z; Wed, 12 Feb 2025 01:10:46 +0000 (UTC) From: Giacomo Leidi Date: Wed, 12 Feb 2025 02:10:34 +0100 Message-ID: <3e199fa3b6b15d853ea1887ad0c518c7cb4f4b25.1739322637.git.goodoldpaul@autistici.org> X-Mailer: git-send-email 2.48.1 MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Spam-Score: -0.0 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) This commit allows for having PATH set when changing the owner of /sys/fs/group. * gnu/services/containers.scm (crgroups-fs-owner): Use login shell. Change-Id: I9510c637a5332325e05ca5ebc9dfd4de32685c50 --- gnu/services/containers.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm index 19d35ccbcb6..dc66ac4f967 100644 --- a/gnu/services/containers.scm +++ b/gnu/services/containers.scm @@ -140,7 +140,7 @@ (define (cgroups-fs-owner-entrypoint config) (rootless-podman-configuration-group-name config)) (program-file "cgroups2-fs-owner-entrypoint" #~(system* - (string-append #+bash-minimal "/bin/bash") "-c" + (string-append #+bash-minimal "/bin/bash") "-l" "-c" (string-append "echo Setting /sys/fs/cgroup " "group ownership to " #$group " && chown -v " "root:" #$group " /sys/fs/cgroup && " base-commit: f650fc3e15e0ba04b3998daf13db8666fcfd9627 -- 2.48.1 From unknown Fri Jun 13 11:55:10 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#76081] [PATCH v4 2/4] services: oci-container-configuration: Move to (gnu services containers). Resent-From: Giacomo Leidi Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Wed, 12 Feb 2025 01:11:04 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 76081 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 76081@debbugs.gnu.org Cc: Giacomo Leidi Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.173932265932413 (code B ref 76081); Wed, 12 Feb 2025 01:11:04 +0000 Received: (at 76081) by debbugs.gnu.org; 12 Feb 2025 01:10:59 +0000 Received: from localhost ([127.0.0.1]:59709 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ti1HE-0008Qi-RT for submit@debbugs.gnu.org; Tue, 11 Feb 2025 20:10:59 -0500 Received: from confino.investici.org ([2a11:7980:1::2:0]:50425) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1ti1H7-0008Pk-HR for 76081@debbugs.gnu.org; Tue, 11 Feb 2025 20:10:52 -0500 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org; s=stigmate; t=1739322646; bh=C6uHhY9S9WpgPkIaaAgAOz8vooJK2RfngRRsEihvD9o=; h=From:To:Cc:Subject:Date:In-Reply-To:References:From; b=eZLrg0VhR1XMzVfVBENPbKgsQccHcuiQ6tBwTvnZJOIdVkjZks0dzD1//YjfBu+vP abuObaNITFI8LTfBIvU+CYtj05EoWaFx7/PgmJ0Y1sjIQmScYv121yfDKMIQy2NYP7 e3EcIh81yHctJsOgaHp6d9WeR6wweP5vN0iIYPaA= Received: from mx1.investici.org (unknown [127.0.0.1]) by confino.investici.org (Postfix) with ESMTP id 4Yt0cQ5D8Cz111X; Wed, 12 Feb 2025 01:10:46 +0000 (UTC) Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19]) (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with ESMTPSA id 4Yt0cQ3yfpz110r; Wed, 12 Feb 2025 01:10:46 +0000 (UTC) From: Giacomo Leidi Date: Wed, 12 Feb 2025 02:10:35 +0100 Message-ID: <77229c8777b0b074a44bd848b60140a49b621ac6.1739322637.git.goodoldpaul@autistici.org> X-Mailer: git-send-email 2.48.1 In-Reply-To: <3e199fa3b6b15d853ea1887ad0c518c7cb4f4b25.1739322637.git.goodoldpaul@autistici.org> References: <3e199fa3b6b15d853ea1887ad0c518c7cb4f4b25.1739322637.git.goodoldpaul@autistici.org> MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit X-Spam-Score: -0.0 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) 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 dc66ac4f967..50bf6c05549 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 +;;; Copyright © 2024, 2025 Giacomo Leidi ;;; ;;; This file is part of GNU Guix. ;;; @@ -17,19 +17,31 @@ ;;; along with GNU Guix. If not, see . (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) @@ -188,7 +237,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 @@ -242,3 +291,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 3af0f792701..69ff9f1d9e4 100644 --- a/gnu/services/docker.scm +++ b/gnu/services/docker.scm @@ -5,7 +5,7 @@ ;;; Copyright © 2020 Efraim Flashner ;;; Copyright © 2020 Jesse Dowell ;;; Copyright © 2021 Brice Waegeneire -;;; Copyright © 2023, 2024 Giacomo Leidi +;;; Copyright © 2023, 2024, 2025 Giacomo Leidi ;;; ;;; This file is part of GNU Guix. ;;; @@ -23,72 +23,60 @@ ;;; along with GNU Guix. If not, see . (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) @@ -307,495 +295,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} 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"))))) - (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 ;;; Copyright © 2019-2023 Ludovic Courtès -;;; Copyright © 2024 Giacomo Leidi +;;; Copyright © 2024, 2025 Giacomo Leidi ;;; ;;; 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 From unknown Fri Jun 13 11:55:10 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#76081] OCI provisioning service Resent-From: paul Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Tue, 18 Feb 2025 01:21:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 76081 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 76081@debbugs.gnu.org Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.173984162026668 (code B ref 76081); Tue, 18 Feb 2025 01:21:01 +0000 Received: (at 76081) by debbugs.gnu.org; 18 Feb 2025 01:20:20 +0000 Received: from localhost ([127.0.0.1]:51706 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tkCHb-0006w2-II for submit@debbugs.gnu.org; Mon, 17 Feb 2025 20:20:20 -0500 Received: from confino.investici.org ([2a11:7980:1::2:0]:40445) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1tkCHY-0006vl-Vv for 76081@debbugs.gnu.org; Mon, 17 Feb 2025 20:20:18 -0500 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org; s=stigmate; t=1739841613; bh=bwl29Q9kAgjn0YN55v/Axxmnk25Kq11SvA9YVZ1yZmE=; h=Date:Subject:From:To:References:In-Reply-To:From; b=sndP5/G7csVWJPmdmUnESvpPjDF7Hbj2QPqrd5KRc6Fnn/RxJI+1Ds6K7Zsn8mtYW GRg4Z39BrOtq3X0i1NwBkYDxEsFMEQKoAfEv1LneZHEtcPar8VxZA/pbBZPQ63gegv /ItqnvUj5fLo7ZVrow87RT/a8onGCngJRSUSBbSY= Received: from mx1.investici.org (unknown [127.0.0.1]) by confino.investici.org (Postfix) with ESMTP id 4YxhXY2s94z111D for <76081@debbugs.gnu.org>; Tue, 18 Feb 2025 01:20:13 +0000 (UTC) Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19]) (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with ESMTPSA id 4YxhXY2KFFz1119 for <76081@debbugs.gnu.org>; Tue, 18 Feb 2025 01:20:13 +0000 (UTC) Message-ID: Date: Tue, 18 Feb 2025 02:20:12 +0100 MIME-Version: 1.0 User-Agent: Icedove Daily From: paul References: <274b98ea-1af9-4f0f-af58-8fa755feb73b@autistici.org> Content-Language: en-US In-Reply-To: <274b98ea-1af9-4f0f-af58-8fa755feb73b@autistici.org> Content-Type: text/plain; charset=UTF-8; format=flowed Content-Transfer-Encoding: 7bit X-Spam-Score: -0.0 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) Hi, On 2/12/25 02:09, paul wrote: > Hi guix, > > On 2/9/25 21:38, paul wrote: >> I'm sending a v3 fixing a bug in the merge algorithm for volumes and >> networks. >> >> On 2/9/25 20:14, paul wrote: >>> Hi, >>> >>> I'm about to send a v2. v2 compared to the first revision features: >>> >>> >>> - it actually compiles all the times :) (rev 1 referenced oci-image >>> too early for it to be working and generated a compile time error, >>> if you recompiled it sometimes went away so I thought it was a >>> problem of my setup. CI caught this) >>> - it allows more values to be overridden by eventual users of the >>> Scheme API >>> - it allows passing extra arguments directly after each podman or >>> docker invokation, allowing for example for overriding podman --root >>> and similar options. >>> >>> All of these tests should pass: >>> >>> guix shell -D guix -CPW -- make check-system TESTS="oci-container >>> oci-service-rootless-podman docker docker-system rootless-podman >>> oci-service-docker" >>> > I'm sending a v4 changing slightly the image loader, the same tests as > before are supposed to pass. Now the Home service [0] is working for > me with rootless podman. I'll try it on different distros if I manage to. I'm sending a v5 implementing a Home service. The changes compared to v4 are pretty trivial as the plumbing was already there, the only downside is that I'm not able to use for-home? in define-configuration, so I had to reimplement oci-configuration with (guix records) and had to reimplement some validation (gnu services configuration) would figure out magically. Thank you for your work and time, cheers giacomo From unknown Fri Jun 13 11:55:10 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#76081] [PATCH v5 3/5] services: Add oci-service-type. Resent-From: Giacomo Leidi Original-Sender: "Debbugs-submit" Resent-CC: ludo@gnu.org, maxim.cournoyer@gmail.com, guix-patches@gnu.org Resent-Date: Wed, 19 Feb 2025 00:10:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 76081 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 76081@debbugs.gnu.org Cc: Giacomo Leidi , Ludovic =?UTF-8?Q?Court=C3=A8s?= , Maxim Cournoyer X-Debbugs-Original-Xcc: Ludovic =?UTF-8?Q?Court=C3=A8s?= , Maxim Cournoyer Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.17399237835445 (code B ref 76081); Wed, 19 Feb 2025 00:10:02 +0000 Received: (at 76081) by debbugs.gnu.org; 19 Feb 2025 00:09:43 +0000 Received: from localhost ([127.0.0.1]:36265 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tkXeo-0001Pi-Oo for submit@debbugs.gnu.org; Tue, 18 Feb 2025 19:09:42 -0500 Received: from confino.investici.org ([2a11:7980:1::2:0]:46549) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1tkXel-0001Or-WF for 76081@debbugs.gnu.org; Tue, 18 Feb 2025 19:09:40 -0500 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org; s=stigmate; t=1739923778; bh=QyhhODzAfom/nmalVB1vs4ijsSh9GdUnM5Z3Zv2yCAA=; h=From:To:Cc:Subject:Date:In-Reply-To:References:From; b=Pk0WSmaX7DvEWuf+f1MHECe9YA9kDKUNObKBelziRJ3rJ31HDZ7ABK5kXi4A+UKQr 96YWGVWO0EF7vvRAm4HVN0dCOMKvQoMsOtL6EzsEUyLx0AF2a3p3GRF3S+ZycWTR8u TvhJC7G/PYWIWD0z8jnRQ9eOp6sp9NSV7jmRLiug= Received: from mx1.investici.org (unknown [127.0.0.1]) by confino.investici.org (Postfix) with ESMTP id 4YyGwf1nK5z1112; Wed, 19 Feb 2025 00:09:38 +0000 (UTC) Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19]) (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with ESMTPSA id 4YyGwd6mXQz10yt; Wed, 19 Feb 2025 00:09:37 +0000 (UTC) From: Giacomo Leidi Date: Wed, 19 Feb 2025 01:09:20 +0100 Message-ID: X-Mailer: git-send-email 2.48.1 In-Reply-To: <6d774afae43df08bf52f7ecb8900d35f501280d8.1739923762.git.goodoldpaul@autistici.org> References: <6d774afae43df08bf52f7ecb8900d35f501280d8.1739923762.git.goodoldpaul@autistici.org> MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" 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/services/containers.scm (%oci-supported-runtimes): New variable; (oci-runtime-cli): new variable; (oci-runtime-name): new variable; (oci-network-configuration): new variable; (oci-volume-configuration): new variable; (oci-configuration): new variable; (oci-extension): new variable; (oci-networks-shepherd-name): new variable; (oci-service-type): new variable; (oci-state->shepherd-services): new variable. * doc/guix.texi: Document it. * gnu/tests/containers.scm: Test it. * gnu/services/docker.scm: Deprecate the oci-container-service-type. Change-Id: I656b3db85832e42d53072fcbfb91d1226f39ef38 --- doc/guix.texi | 306 +++++++-- gnu/services/containers.scm | 1283 ++++++++++++++++++++++++++++++----- gnu/services/docker.scm | 37 +- gnu/tests/containers.scm | 999 ++++++++++++++++++++++++++- 4 files changed, 2380 insertions(+), 245 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index 54a736c518c..0dfec66a52b 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -42282,59 +42282,162 @@ Miscellaneous Services @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: given an -@acronym{Open Container Initiative, OCI} container image, it will run it in a +Should you wish to manage your @acronym{Open Container Initiative, OCI} containers +with the same consistent interface you use for your other Shepherd services, +@var{oci-service-type} is the tool to use: given an +OCI container image, it will run it in a Shepherd service. One example where this is useful: it lets you run services -that are available as Docker/OCI images but not yet packaged for Guix. +that are available as OCI images but not yet packaged for Guix. -@defvar oci-container-service-type +@defvar oci-service-type -This is a thin wrapper around Docker's CLI that executes OCI images backed +This is a thin wrapper around Docker's or Podman's CLI that executes OCI images backed processes as Shepherd Services. @lisp -(service oci-container-service-type - (list - (oci-container-configuration - (network "host") - (image - (oci-image - (repository "guile") - (tag "3") - (value (specifications->manifest '("guile"))) - (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile")) - #:max-layers 2)))) - (entrypoint "/bin/guile") - (command - '("-c" "(display \"hello!\n\")"))) - (oci-container-configuration - (image "prom/prometheus") - (ports - '(("9000" . "9000") - ("9090" . "9090")))) - (oci-container-configuration - (image "grafana/grafana:10.0.1") - (network "host") - (volumes - '("/var/lib/grafana:/var/lib/grafana"))))) +(simple-service 'oci-provisioning + oci-service-type + (oci-extension + (networks + (list + (oci-network-configuration (name "monitoring")))) + (containers + (list + (oci-container-configuration + (network "monitoring") + (image + (oci-image + (repository "guile") + (tag "3") + (value (specifications->manifest '("guile"))) + (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile")) + #:max-layers 2)))) + (entrypoint "/bin/guile") + (command + '("-c" "(display \"hello!\n\")"))) + (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 In this example three different Shepherd services are going to be added to the system. Each @code{oci-container-configuration} record translates to a -@code{docker run} invocation and its fields directly map to options. You can -refer to the -@url{https://docs.docker.com/engine/reference/commandline/run,upstream} -documentation for the semantics of each value. If the images are not found, -they will be -@url{https://docs.docker.com/engine/reference/commandline/pull/,pulled}. The +@command{docker run} or @command{podman run} invocation and its fields directly +map to options. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html,Podman} +upstream documentation for semantics of each value. If the images are not found, +they will be pulled. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/pull/,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-pull.1.html,Podman} +upstream documentation for semantics. The services with @code{(network "host")} are going to be attached to the host network and are supposed to behave like native processes with regard to networking. @end defvar +@c %start of fragment + +@deftp {Data Type} oci-configuration +Available @code{oci-configuration} fields are: + +@table @asis +@item @code{runtime} (default: @code{'docker}) (type: symbol) +The OCI runtime to use to run commands. It can be either @code{'docker} or +@code{'podman}. + +@item @code{runtime-cli} (type: maybe-package-or-string) +The OCI runtime command line to be installed in the system profile and used +to provision OCI resources. When unset it will default to @code{docker-cli} +package for the @code{'docker} runtime or to @code{podman} package for the +@code{'podman} runtime. When a string is passed it will be interpreted as the +absolute file-system path of the selected OCI runtime command. + +@item @code{runtime-extra-arguments} (default: @code{'()}) (type: list) +A list of strings, gexps or file-like objects that will be placed +after each @command{docker} or @command{podman} invokation. + +@item @code{user} (type: maybe-string) +The user name under whose authority OCI commands will be run. This field will +override the @code{user} field of @code{oci-configuration}. + +@item @code{group} (type: maybe-string) +The group name under whose authority OCI commands will be run. When +using the @code{'podman} OCI runtime, this field will be ignored and the +default group of the user configured in the @code{user} field will be used. +This field will override the @code{group} field of @code{oci-configuration}. + +@item @code{subuids-range} (type: maybe-subid-range) +An optional @code{subid-range} record allocating subuids for the user from +the @code{user} field. When unset, with the rootless Podman OCI runtime, it +defaults to @code{(subid-range (name "oci-container"))}. + +@item @code{subgids-range} (type: maybe-subid-range) +An optional @code{subid-range} record allocating subgids for the user from +the @code{user} field. When unset, with the rootless Podman OCI runtime, it +defaults to @code{(subid-range (name "oci-container"))}. + +@item @code{containers} (default: @code{'()}) (type: list-of-oci-containers) +The list of @code{oci-container-configuration} records representing the +containers to provision. Most users are supposed not to use this field and use +the @code{oci-extension} record instead. + +@item @code{networks} (default: @code{'()}) (type: list-of-oci-networks) +The list of @code{oci-network-configuration} records representing the +containers to provision. Most users are supposed not to use this field and use +the @code{oci-extension} record instead. + +@item @code{volumes} (default: @code{'()}) (type: list-of-oci-volumes) +The list of @code{oci-volumes-configuration} records representing the +containers to provision. Most users are supposed not to use this field and use +the @code{oci-extension} record instead. + +@item @code{verbose?} (default: @code{#f}) (type: boolean) +When true, additional output will be printed, allowing to better follow the +flow of execution. + +@end table + +@end deftp + + +@c %end of fragment + +@c %start of fragment + +@deftp {Data Type} oci-extension +Available @code{oci-extension} fields are: + +@table @asis +@item @code{containers} (default: @code{'()}) (type: list-of-oci-containers) +The list of @code{oci-container-configuration} records representing the +containers to provision. + +@item @code{networks} (default: @code{'()}) (type: list-of-oci-networks) +The list of @code{oci-network-configuration} records representing the +containers to provision. + +@item @code{volumes} (default: @code{'()}) (type: list-of-oci-volumes) +The list of @code{oci-volumes-configuration} records representing the +containers to provision. + +@end table + +@end deftp + + +@c %end of fragment + + @c %start of fragment @deftp {Data Type} oci-container-configuration @@ -42354,16 +42457,16 @@ Miscellaneous Services Overwrite the default entrypoint (@code{ENTRYPOINT}) of the image. @item @code{host-environment} (default: @code{'()}) (type: 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 +Set environment variables in the host environment where @command{docker run} +or @command{podman run} are invoked. This is especially useful to pass secrets +from the host to the container without having them on the OCI runtime command line, +for example: by setting the @code{MYSQL_PASSWORD} on the host and by passing @code{--env MYSQL_PASSWORD} through the @code{extra-arguments} field, it is possible to securely set values in the container environment. This field's value can be a list of pairs or strings, even mixed: @lisp -(list '("LANGUAGE\" . "eo:ca:eu") +(list '("LANGUAGE" . "eo:ca:eu") "JAVA_HOME=/opt/java") @end lisp @@ -42371,22 +42474,24 @@ Miscellaneous Services directly to @code{make-forkexec-constructor}. @item @code{environment} (default: @code{'()}) (type: list) -Set environment variables. This can be a list of pairs or strings, even mixed: +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 -@uref{https://docs.docker.com/engine/reference/commandline/run/#env,upstream} -documentation for semantics. +Pair members can be strings, gexps or file-like objects. Strings are passed +directly to the OCI runtime CLI. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run/#env,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#env-e-env,Podman} +upstream documentation for semantics. @item @code{image} (type: 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{oci-image} record. Strings are resolved by the OCI runtime, +and follow the usual format @code{myregistry.local:5000/testing/test-image:tag}. @item @code{provision} (default: @code{""}) (type: string) @@ -42414,7 +42519,7 @@ Miscellaneous Services by the service. @item @code{network} (default: @code{""}) (type: string) -Set a Docker network for the spawned container. +Set an OCI 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 @@ -42425,10 +42530,11 @@ Miscellaneous Services "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 -@uref{https://docs.docker.com/engine/reference/commandline/run/#publish,upstream} -documentation for semantics. +Pair members can be strings, gexps or file-like objects. Strings are passed +directly to the OCI runtime CLI. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run/#publish,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#publish-p-ip-hostport-containerport-protocol,Podman} +upstream documentation for semantics. @item @code{volumes} (default: @code{'()}) (type: list) Set volume mappings for the spawned container. This can be a @@ -42439,25 +42545,97 @@ Miscellaneous Services "/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 -@uref{https://docs.docker.com/engine/reference/commandline/run/#volume,upstream} -documentation for semantics. +Pair members can be strings, gexps or file-like objects. Strings are passed +directly to the OCI runtime CLI. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run/#volume,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#volume-v-source-volume-host-dir-container-dir-options,Podman} +upstream documentation for semantics. @item @code{container-user} (default: @code{""}) (type: 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. +@url{https://docs.docker.com/engine/reference/run/#user,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#user-u-user-group,Podman} +upstream documentation for semantics. @item @code{workdir} (default: @code{""}) (type: string) Set the current working directory for the spawned Shepherd service. You can refer to the -@url{https://docs.docker.com/engine/reference/run/#workdir,upstream} -documentation for semantics. +@url{https://docs.docker.com/engine/reference/run/#workdir,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#workdir-w-dir,Podman} +upstream documentation for semantics. @item @code{extra-arguments} (default: @code{'()}) (type: list) -A list of strings, gexps or file-like objects that will be directly -passed to the @command{docker run} invocation. +A list of strings, gexps or file-like objects that will be directly passed +to the @command{docker run} or @command{podman run} invokation. + +@end table + +@end deftp + + +@c %end of fragment + +@c %start of fragment + +@deftp {Data Type} oci-network-configuration +Available @code{oci-network-configuration} fields are: + +@table @asis +@item @code{name} (type: string) +The name of the OCI network to provision. + +@item @code{driver} (type: maybe-string) +The driver to manage the network. + +@item @code{gateway} (type: maybe-string) +IPv4 or IPv6 gateway for the subnet. + +@item @code{internal?} (default: @code{#f}) (type: boolean) +Restrict external access to the network + +@item @code{ip-range} (type: maybe-string) +Allocate container ip from a sub-range in CIDR format. + +@item @code{ipam-driver} (type: maybe-string) +IP Address Management Driver. + +@item @code{ipv6?} (default: @code{#f}) (type: boolean) +Enable IPv6 networking. + +@item @code{subnet} (type: maybe-string) +Subnet in CIDR format that represents a network segment. + +@item @code{labels} (default: @code{'()}) (type: list) +The list of labels that will be used to tag the current volume. + +@item @code{extra-arguments} (default: @code{'()}) (type: list) +A list of strings, gexps or file-like objects that will be directly passed +to the @command{docker network create} or @command{podman network create} +invokation. + +@end table + +@end deftp + + +@c %end of fragment + +@c %start of fragment + +@deftp {Data Type} oci-volume-configuration +Available @code{oci-volume-configuration} fields are: + +@table @asis +@item @code{name} (type: string) +The name of the OCI volume to provision. + +@item @code{labels} (default: @code{'()}) (type: list) +The list of labels that will be used to tag the current volume. + +@item @code{extra-arguments} (default: @code{'()}) (type: list) +A list of strings, gexps or file-like objects that will be directly passed +to the @command{docker volume create} or @command{podman volume create} +invokation. @end table diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm index 50bf6c05549..bd1b6f14356 100644 --- a/gnu/services/containers.scm +++ b/gnu/services/containers.scm @@ -39,8 +39,10 @@ (define-module (gnu services containers) #:use-module (guix packages) #:use-module (guix profiles) #:use-module ((guix scripts pack) #:prefix pack:) + #:use-module (guix records) #:use-module (guix store) #:use-module (srfi srfi-1) + #:use-module (ice-9 format) #:use-module (ice-9 match) #:export (rootless-podman-configuration rootless-podman-configuration? @@ -96,8 +98,80 @@ (define-module (gnu services containers) oci-container-configuration-workdir oci-container-configuration-extra-arguments + list-of-oci-containers? + list-of-oci-networks? + list-of-oci-volumes? + + %oci-supported-runtimes + oci-sanitize-runtime + oci-runtime-system-environment + oci-runtime-system-extra-arguments + oci-runtime-system-group + oci-runtime-system-requirement + oci-runtime-cli + oci-runtime-system-cli + oci-runtime-home-cli + oci-runtime-name + oci-runtime-group + + oci-network-configuration + oci-network-configuration? + oci-network-configuration-fields + oci-network-configuration-name + oci-network-configuration-driver + oci-network-configuration-gateway + oci-network-configuration-internal? + oci-network-configuration-ip-range + oci-network-configuration-ipam-driver + oci-network-configuration-ipv6? + oci-network-configuration-subnet + oci-network-configuration-labels + oci-network-configuration-extra-arguments + + oci-volume-configuration + oci-volume-configuration? + oci-volume-configuration-fields + oci-volume-configuration-name + oci-volume-configuration-labels + oci-volume-configuration-extra-arguments + + oci-configuration + oci-configuration? + oci-configuration-runtime + oci-configuration-runtime-cli + oci-configuration-runtime-extra-arguments + oci-configuration-user + oci-configuration-group + oci-configuration-containers + oci-configuration-networks + oci-configuration-volumes + oci-configuration-verbose? + oci-configuration-valid? + + oci-extension + oci-extension? + oci-extension-fields + oci-extension-containers + oci-extension-networks + oci-extension-volumes + + oci-container-shepherd-name + oci-networks-shepherd-name + oci-networks-home-shepherd-name + oci-volumes-shepherd-name + oci-volumes-home-shepherd-name + oci-container-shepherd-service - %oci-container-accounts)) + oci-objects-merge-lst + oci-extension-merge + oci-service-extension-wrap-validate + oci-service-type + oci-service-accounts + oci-service-profile + oci-service-subids + oci-state->shepherd-services + oci-configuration->shepherd-services + oci-configuration-extend)) (define (gexp-or-string? value) (or (gexp? value) @@ -294,9 +368,42 @@ (define rootless-podman-service-type ;;; -;;; OCI container. +;;; OCI provisioning service. ;;; +(define %oci-supported-runtimes + '(docker podman)) + +(define (oci-runtime-system-requirement runtime) + "Return a list of Shepherd service names required by a given OCI runtime, +before it is able to run containers." + (if (eq? 'podman runtime) + '(cgroups2-fs-owner cgroups2-limits + rootless-podman-shared-root-fs user-processes) + '(dockerd user-processes))) + +(define (oci-runtime-name runtime) + "Return a human readable name for a given OCI runtime." + (if (eq? 'podman runtime) + "Podman" "Docker")) + +(define (oci-runtime-group runtime maybe-group) + "Implement the logic behind selection of the group that is to be used by +Shepherd to execute OCI commands." + (if (eq? maybe-group #f) + (if (eq? 'podman runtime) + "cgroup" + "docker") + maybe-group)) + +(define (oci-sanitize-runtime value) + (unless (member value %oci-supported-runtimes) + (raise + (formatted-message + (G_ "OCI runtime must be a symbol and one of ~a, +but ~a was found") %oci-supported-runtimes value))) + value) + (define (oci-sanitize-pair pair delimiter) (define (valid? member) (or (string? member) @@ -345,6 +452,11 @@ (define (oci-sanitize-volumes value) ;; '(("/mnt/dir" . "/dir") "/run/current-system/profile:/java") (oci-sanitize-mixed-list "volumes" value ":")) +(define (oci-sanitize-labels value) + ;; Expected spec format: + ;; '(("foo" . "bar") "foo=bar") + (oci-sanitize-mixed-list "labels" value "=")) + (define (oci-sanitize-shepherd-actions value) (map (lambda (el) @@ -372,10 +484,15 @@ (define (oci-sanitize-extra-arguments value) value)) (define (oci-image-reference image) - (if (string? image) - image - (string-append (oci-image-repository image) - ":" (oci-image-tag image)))) + "Return a string OCI image reference representing IMAGE." + (define reference + (if (string? image) + image + (string-append (oci-image-repository image) + ":" (oci-image-tag image)))) + (if (> (length (string-split reference #\/)) 1) + reference + (string-append "localhost/" reference))) (define (oci-lowerable-image? image) (or (manifest? image) @@ -390,7 +507,19 @@ (define (string-or-oci-image? image) (define list-of-symbols? (list-of symbol?)) +(define (list-of-oci-records? name predicate value) + (map + (lambda (el) + (if (predicate el) + el + (raise + (formatted-message + (G_ "~a contains an illegal value: ~a") name el)))) + value)) + (define-maybe/no-serialization string) +(define-maybe/no-serialization package) +(define-maybe/no-serialization subid-range) (define-configuration/no-serialization oci-image (repository @@ -435,11 +564,15 @@ (define-configuration/no-serialization oci-image (define-configuration/no-serialization oci-container-configuration (user - (string "oci-container") - "The user under whose authority docker commands will be run.") + (maybe-string) + "The user name under whose authority OCI commands will be run. This field will +override the @code{user} field of @code{oci-configuration}.") (group - (string "docker") - "The group under whose authority docker commands will be run.") + (maybe-string) + "The group name under whose authority OCI commands will be run. When +using the @code{'podman} OCI runtime, this field will be ignored and the +default group of the user configured in the @code{user} field will be used. +This field will override the @code{group} field of @code{oci-configuration}.") (command (list-of-strings '()) "Overwrite the default command (@code{CMD}) of the image.") @@ -449,9 +582,9 @@ (define-configuration/no-serialization oci-container-configuration (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 +or @command{podman run} are invoked. This is especially useful to pass secrets +from the host to the container without having them on the OCI runtime command line, +for example: by setting the @code{MYSQL_PASSWORD} on the host and by passing @code{--env MYSQL_PASSWORD} through the @code{extra-arguments} field, it is possible to securely set values in the container environment. This field's value can be a list of pairs or strings, even mixed: @@ -475,15 +608,16 @@ (define-configuration/no-serialization oci-container-configuration @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." +directly to the OCI runtime CLI. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run/#env,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#env-e-env,Podman} +upstream documentation for semantics." (sanitizer oci-sanitize-environment)) (image (string-or-oci-image) "The image used to build the container. It can be a string or an -@code{oci-image} record. Strings are resolved by the Docker -Engine, and follow the usual format +@code{oci-image} record. Strings are resolved by the OCI runtime, +and follow the usual format @code{myregistry.local:5000/testing/test-image:tag}.") (provision (maybe-string) @@ -512,7 +646,7 @@ (define-configuration/no-serialization oci-container-configuration (sanitizer oci-sanitize-shepherd-actions)) (network (maybe-string) - "Set a Docker network for the spawned container.") + "Set an OCI network for the spawned container.") (ports (list '()) "Set the port or port ranges to expose from the spawned container. This can @@ -524,9 +658,10 @@ (define-configuration/no-serialization oci-container-configuration @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." +directly to the OCI runtime CLI. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run/#publish,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#publish-p-ip-hostport-containerport-protocol,Podman} +upstream documentation for semantics." (sanitizer oci-sanitize-ports)) (volumes (list '()) @@ -539,71 +674,363 @@ (define-configuration/no-serialization oci-container-configuration @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." +directly to the OCI runtime CLI. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run/#volume,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#volume-v-source-volume-host-dir-container-dir-options,Podman} +upstream documentation for semantics." (sanitizer oci-sanitize-volumes)) (container-user (maybe-string) "Set the current user inside the spawned container. You can refer to the -@url{https://docs.docker.com/engine/reference/run/#user,upstream} -documentation for semantics.") +@url{https://docs.docker.com/engine/reference/run/#user,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#user-u-user-group,Podman} +upstream documentation for semantics.") (workdir (maybe-string) - "Set the current working for the spawned Shepherd service. + "Set the current working directory for the spawned Shepherd service. You can refer to the -@url{https://docs.docker.com/engine/reference/run/#workdir,upstream} -documentation for semantics.") +@url{https://docs.docker.com/engine/reference/run/#workdir,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#workdir-w-dir,Podman} +upstream documentation for semantics.") (extra-arguments (list '()) "A list of strings, gexps or file-like objects that will be directly passed -to the @command{docker run} invokation." +to the @command{docker run} or @command{podman 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 (list-of-oci-containers? value) + (list-of-oci-records? "containers" oci-container-configuration? value)) + +(define-configuration/no-serialization oci-volume-configuration + (name + (string) + "The name of the OCI volume to provision.") + (labels + (list '()) + "The list of labels that will be used to tag the current volume." + (sanitizer oci-sanitize-labels)) + (extra-arguments + (list '()) + "A list of strings, gexps or file-like objects that will be directly passed +to the @command{docker volume create} or @command{podman volume create} +invokation." + (sanitizer oci-sanitize-extra-arguments))) + +(define (list-of-oci-volumes? value) + (list-of-oci-records? "volumes" oci-volume-configuration? value)) + +(define-configuration/no-serialization oci-network-configuration + (name + (string) + "The name of the OCI network to provision.") + (driver + (maybe-string) + "The driver to manage the network.") + (gateway + (maybe-string) + "IPv4 or IPv6 gateway for the subnet.") + (internal? + (boolean #f) + "Restrict external access to the network") + (ip-range + (maybe-string) + "Allocate container ip from a sub-range in CIDR format.") + (ipam-driver + (maybe-string) + "IP Address Management Driver.") + (ipv6? + (boolean #f) + "Enable IPv6 networking.") + (subnet + (maybe-string) + "Subnet in CIDR format that represents a network segment.") + (labels + (list '()) + "The list of labels that will be used to tag the current volume." + (sanitizer oci-sanitize-labels)) + (extra-arguments + (list '()) + "A list of strings, gexps or file-like objects that will be directly passed +to the @command{docker network create} or @command{podman network create} +invokation." + (sanitizer oci-sanitize-extra-arguments))) + +(define (list-of-oci-networks? value) + (list-of-oci-records? "networks" oci-network-configuration? value)) + +(define-record-type* + oci-configuration + make-oci-configuration + oci-configuration? + this-oci-configuration + + (runtime oci-configuration-runtime + (default 'docker)) + (runtime-cli oci-configuration-runtime-cli + (default #f)) ; package or string + (runtime-extra-arguments oci-configuration-runtime-extra-arguments ; strings or gexps + (default '())) ; or file-like objects + (user oci-configuration-user + (default "oci-container")) + (group oci-configuration-group ; string + (default #f)) + (subuids-range oci-configuration-subuids-range ; subid-range + (default #f)) + (subgids-range oci-configuration-subgids-range ; subid-range + (default #f)) + (containers oci-configuration-containers ; oci-container-configurations + (default '())) + (networks oci-configuration-networks ; oci-network-configurations + (default '())) + (volumes oci-configuration-volumes ; oci-volume-configurations + (default '())) + (verbose? oci-configuration-verbose? + (default #f)) + (home-service? oci-configuration-home-service? + (default for-home?) (innate))) + +(define (package-or-string? value) + (or (package? value) (string? value))) + +(define (oci-configuration-valid? config) + (define runtime-cli + (oci-configuration-runtime-cli config)) + (define group + (oci-configuration-group config)) + (define subuids-range + (oci-configuration-subuids-range config)) + (define subgids-range + (oci-configuration-subgids-range config)) + (and + (symbol? + (oci-sanitize-runtime (oci-configuration-runtime config))) + (or (eq? runtime-cli #f) + (package-or-string? runtime-cli)) + (list? (oci-configuration-runtime-extra-arguments config)) + (string? (oci-configuration-user config)) + (or (eq? group #f) + (string? group)) + (or (eq? subuids-range #f) + (subid-range? subuids-range)) + (or (eq? subgids-range #f) + (subid-range? subgids-range)) + (list-of-oci-containers? + (oci-configuration-containers config)) + (list-of-oci-networks? + (oci-configuration-networks config)) + (list-of-oci-volumes? + (oci-configuration-volumes config)) + (boolean? + (oci-configuration-verbose? config)) + (boolean? + (oci-configuration-home-service? config)))) + +(define (oci-runtime-system-environment runtime user) + (if (eq? runtime 'podman) + (list + #~(string-append + "HOME=" (passwd:dir (getpwnam #$user)))) + #~())) + +(define (oci-runtime-system-group runtime user group) + (if (eq? runtime 'podman) + #~(group:name + (getgrgid + (passwd:gid + (getpwnam #$user)))) + group)) + +(define (oci-runtime-cli runtime runtime-cli path) + "Return a gexp that, when lowered, evaluates to the file system path of the OCI +runtime command requested by the user." + (if (string? runtime-cli) + ;; It is a user defined absolute path + runtime-cli + #~(string-append + #$(if (eq? runtime-cli #f) + path + runtime-cli) + #$(if (eq? 'podman runtime) + "/bin/podman" + "/bin/docker")))) + +(define* (oci-runtime-system-cli config #:key (path "/run/current-system/profile")) + (let ((runtime-cli + (oci-configuration-runtime-cli config)) + (runtime + (oci-configuration-runtime config))) + (oci-runtime-cli runtime runtime-cli path))) + +(define (oci-runtime-home-cli config) + (let ((runtime-cli + (oci-configuration-runtime-cli config)) + (runtime + (oci-configuration-runtime config))) + (oci-runtime-cli runtime runtime-cli + (string-append (getenv "HOME") + "/.guix-home/profile")))) + +(define-configuration/no-serialization oci-extension + (containers + (list-of-oci-containers '()) + "The list of @code{oci-container-configuration} records representing the +containers to add.") + (networks + (list-of-oci-networks '()) + "The list of @code{oci-network-configuration} records representing the +networks to add.") + (volumes + (list-of-oci-volumes '()) + "The list of @code{oci-volume-configuration} records representing the +volumes to add.")) + +(define (oci-image->container-name image) + "Infer the name of an OCI backed Shepherd service from its OCI image." + (basename + (if (string? image) + (first (string-split image #\:)) + (oci-image-repository image)))) + +(define (oci-object-command-shepherd-action object-name invokation) + "Return a Shepherd action printing a given INVOKATION of an OCI command for the +given OBJECT-NAME." + (shepherd-action + (name 'command-line) + (documentation + (format #f "Prints ~a's OCI runtime command line invokation." + object-name)) + (procedure + #~(lambda _ + (format #t "~a~%" #$invokation))))) + +(define (oci-container-shepherd-name runtime config) + "Return the name of an OCI backed Shepherd service based on CONFIG. +The name configured in the configuration record is returned when +CONFIG's name field has a value, otherwise a name is inferred from CONFIG's +image field." + (define name (oci-container-configuration-provision config)) + (define image (oci-container-configuration-image config)) + + (if (maybe-value-set? name) + name + (string-append (symbol->string runtime) "-" + (oci-image->container-name image)))) + +(define (oci-networks-shepherd-name runtime) + "Return the name of the OCI networks provisioning Shepherd service based on +RUNTIME." + (string-append (symbol->string runtime) "-networks")) + +(define (oci-volumes-shepherd-name runtime) + "Return the name of the OCI volumes provisioning Shepherd service based on +RUNTIME." + (string-append (symbol->string runtime) "-volumes")) + +(define (oci-networks-home-shepherd-name runtime) + "Return the name of the OCI volumes provisioning Home Shepherd service based on +RUNTIME." + (string-append "home-" (oci-networks-shepherd-name runtime))) + +(define (oci-volumes-home-shepherd-name runtime) + "Return the name of the OCI volumes provisioning Home Shepherd service based on +RUNTIME." + (string-append "home-" (oci-volumes-shepherd-name runtime))) + +(define (oci-container-configuration->options config) + "Map CONFIG, an oci-container-configuration record, to a gexp that, upon +lowering, will be evaluated to a list of strings containing command line options +for the OCI runtime run command." + (let ((entrypoint + (oci-container-configuration-entrypoint config)) + (network + (oci-container-configuration-network config)) + (user + (oci-container-configuration-container-user config)) + (workdir + (oci-container-configuration-workdir config))) + (apply append + (filter (compose not unspecified?) + `(,(if (maybe-value-set? entrypoint) + `("--entrypoint" ,entrypoint) + '()) + ,(append-map + (lambda (spec) + (list "--env" spec)) + (oci-container-configuration-environment config)) + ,(if (maybe-value-set? network) + `("--network" ,network) + '()) + ,(if (maybe-value-set? user) + `("--user" ,user) + '()) + ,(if (maybe-value-set? workdir) + `("--workdir" ,workdir) + '()) + ,(append-map + (lambda (spec) + (list "-p" spec)) + (oci-container-configuration-ports config)) + ,(append-map + (lambda (spec) + (list "-v" spec)) + (oci-container-configuration-volumes config))))))) + +(define (oci-network-configuration->options config) + "Map CONFIG, an oci-network-configuration record, to a gexp that, upon +lowering, will be evaluated to a list of strings containing command line options +for the OCI runtime network create command." + (let ((driver (oci-network-configuration-driver config)) + (gateway + (oci-network-configuration-gateway config)) + (internal? + (oci-network-configuration-internal? config)) + (ip-range + (oci-network-configuration-ip-range config)) + (ipam-driver + (oci-network-configuration-ipam-driver config)) + (ipv6? + (oci-network-configuration-ipv6? config)) + (subnet + (oci-network-configuration-subnet config))) + (apply append + (filter (compose not unspecified?) + `(,(if (maybe-value-set? driver) + `("--driver" ,driver) + '()) + ,(if (maybe-value-set? gateway) + `("--gateway" ,gateway) + '()) + ,(if internal? + `("--internal") + '()) + ,(if (maybe-value-set? ip-range) + `("--ip-range" ,ip-range) + '()) + ,(if (maybe-value-set? ipam-driver) + `("--ipam-driver" ,ipam-driver) + '()) + ,(if ipv6? + `("--ipv6") + '()) + ,(if (maybe-value-set? subnet) + `("--subnet" ,subnet) + '()) + ,(append-map + (lambda (spec) + (list "--label" spec)) + (oci-network-configuration-labels config))))))) + +(define (oci-volume-configuration->options config) + "Map CONFIG, an oci-volume-configuration record, to a gexp that, upon +lowering, will be evaluated to a list of strings containing command line options +for the OCI runtime volume create command." + (append-map + (lambda (spec) + (list "--label" spec)) + (oci-volume-configuration-labels config))) (define (lower-operating-system os target system) + "Lower OS, an operating-system record, into a tarball containing an OCI image." (mlet* %store-monad ((tarball (lower-object @@ -612,24 +1039,11 @@ (define (lower-operating-system os target 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))))) - +(define (lower-manifest name value options image-reference + target system grafts?) + "Lower VALUE, a manifest record, into a tarball containing an OCI image." (mlet* %store-monad - ((_ (set-grafting - (oci-image-grafts? image))) + ((_ (set-grafting grafts?)) (guile (set-guile-for-build (default-guile))) (profile (profile-derivation value @@ -640,14 +1054,11 @@ (define (lower-manifest name image target system) (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 (lower-oci-image-state name value options reference + image-target image-system grafts?) (define target (if (maybe-value-set? image-target) image-target @@ -660,7 +1071,8 @@ (define (lower-oci-image name image) (run-with-store store (match value ((? manifest? value) - (lower-manifest name image target system)) + (lower-manifest name value options reference + target system grafts?)) ((? operating-system? value) (lower-operating-system value target system)) ((or (? gexp? value) @@ -675,113 +1087,648 @@ (define (lower-oci-image name image) #: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))) +(define (lower-oci-image name image) + "Lower IMAGE, a oci-image record, into a tarball containing an OCI image." + (lower-oci-image-state + name + (oci-image-value image) + (oci-image-pack-options image) + (oci-image-reference image) + (oci-image-target image) + (oci-image-system image) + (oci-image-grafts? image))) + +(define (oci-object-exists? runtime runtime-cli object verbose?) + #~(lambda* (name #:key (format-string "{{.Name}}")) + (use-modules (ice-9 format) + (ice-9 match) + (ice-9 popen) + (ice-9 rdelim) + (srfi srfi-1)) + + (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))) + + #$(if (eq? runtime 'podman) + #~(let ((command + (list #$runtime-cli + #$object "exists" name))) + (when #$verbose? + (format #t "Running~{ ~a~}~%" command)) + (define exit-code (status:exit-val (apply system* command))) + (when #$verbose? + (format #t "Exit code: ~a~%" exit-code)) + (equal? EXIT_SUCCESS exit-code)) + #~(let ((command + (string-append #$runtime-cli + " " #$object " ls --format " + "\"" format-string "\""))) + (when #$verbose? + (format #t "Running ~a~%" command)) + (member name (read-lines (open-input-pipe command))))))) + +(define* (oci-image-loader runtime runtime-cli name image tag #:key (verbose? #f)) + "Return a file-like object that, once lowered, will evaluate to a program able +to load IMAGE through RUNTIME-CLI and to tag it with TAG afterwards." + (let ((tarball (lower-oci-image name image))) (with-imported-modules '((guix build utils)) - (program-file (format #f "~a-image-loader" name) + (program-file + (format #f "~a-image-loader" name) #~(begin (use-modules (guix build utils) + (ice-9 match) (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)) + (ice-9 rdelim) + (srfi srfi-1)) + (define object-exists? + #$(oci-object-exists? runtime runtime-cli "image" verbose?)) + (define load-command + (string-append #$runtime-cli + " load -i " #$tarball)) + + (if (object-exists? #$tag #:format-string "{{.Repository}}:{{.Tag}}") + (format #t "~a image already exists, skipping.~%" #$tag) + (begin + (format #t "Loading image for ~a from ~a...~%" #$name #$tarball) + (when #$verbose? + (format #t "Running ~a~%" load-command)) + (let ((line (read-line + (open-input-pipe load-command)))) + (unless (or (eof-object? line) + (string-null? line)) + (format #t "~a~%" line) + (let* ((repository&tag + (string-drop line + (string-length + "Loaded image: "))) + (tag-command + (list #$runtime-cli "tag" repository&tag #$tag)) + (drop-old-tag-command + (list #$runtime-cli "image" "rm" "-f" repository&tag))) + + (unless (string=? repository&tag #$tag) + (when #$verbose? + (format #t "Running~{ ~a~}~%" tag-command)) + + (let ((exit-code + (status:exit-val (apply system* tag-command)))) + (format #t "Tagged ~a with ~a...~%" #$tarball #$tag) + + (when #$verbose? + (format #t "Exit code: ~a~%" exit-code)) + + (when (equal? EXIT_SUCCESS exit-code) + (when #$verbose? + (format #t "Running~{ ~a~}~%" drop-old-tag-command)) + (let ((drop-exit-code + (status:exit-val (apply system* drop-old-tag-command)))) + (when #$verbose? + (format #t "Exit code: ~a~%" drop-exit-code)))))))))))))))) + +(define (oci-container-run-invokation runtime-cli name command image-reference + options runtime-extra-arguments run-extra-arguments) + "Return a list representing the OCI runtime +invokation for running containers." + ;; run [OPTIONS] IMAGE [COMMAND] [ARG...] + `(,runtime-cli ,@runtime-extra-arguments "run" + "--rm" "--name" ,name + ,@options ,@run-extra-arguments + ,image-reference ,@command)) + +(define* (oci-container-entrypoint runtime runtime-cli name image image-reference + invokation #:key (verbose? #f)) + "Return a file-like object that, once lowered, will evaluate to the entrypoint +for the Shepherd service that will run IMAGE through RUNTIME-CLI." + (program-file + (string-append "oci-entrypoint-" name) + #~(begin + (use-modules (ice-9 format) + (srfi srfi-1)) + (when #$verbose? + (format #t "Running in verbose mode...~%")) + (define invokation (list #$@invokation)) + #$@(if (oci-image? image) + #~((system* + #$(oci-image-loader + runtime runtime-cli name image + image-reference #:verbose? verbose?))) + #~()) + (when #$verbose? + (format #t "Running~{ ~a~}~%" invokation)) + (apply execlp `(,(first invokation) ,@invokation))))) + +(define* (oci-container-shepherd-service runtime runtime-cli config + #:key + (runtime-environment #~()) + (runtime-extra-arguments '()) + (oci-requirement '()) + (user #f) + (group #f) + (verbose? #f)) + "Return a Shepherd service object that will run the OCI container represented +by CONFIG through RUNTIME-CLI." + (let* ((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)) + (maybe-user (oci-container-configuration-user config)) + (maybe-group (oci-container-configuration-group config)) + (user (if (maybe-value-set? maybe-user) + maybe-user + user)) + (group (if (maybe-value-set? maybe-group) + maybe-group + group)) (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)) + (name + (oci-container-shepherd-name runtime config)) (extra-arguments - (oci-container-configuration-extra-arguments config))) + (oci-container-configuration-extra-arguments config)) + (invokation + (oci-container-run-invokation + runtime-cli name command image-reference + options runtime-extra-arguments extra-arguments))) (shepherd-service (provision `(,(string->symbol name))) - (requirement `(dockerd user-processes ,@requirement)) + (requirement `(,@oci-requirement + ,@requirement)) (respawn? respawn?) (auto-start? auto-start?) (documentation (string-append - "Docker backed Shepherd service for " + (oci-runtime-name runtime) " 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 + (list + #$(oci-container-entrypoint + runtime runtime-cli name image image-reference + invokation #:verbose? verbose?)) + #$@(if user (list #:user user) '()) + #$@(if group (list #:group group) '()) #$@(if (maybe-value-set? log-file) (list #:log-file log-file) '()) + #$@(if (and user (eq? runtime 'podman)) + (list #:directory + #~(passwd:dir (getpwnam #$user))) + '()) #:environment-variables - (list #$@host-environment)))) + (append + (list #$@host-environment) + (list #$@runtime-environment))))) (stop #~(lambda _ - (invoke #$docker "rm" "-f" #$name))) + (invoke #$runtime-cli "rm" "-f" #$name))) (actions - (if (oci-image? image) - '() - (append + (append + (list + (oci-object-command-shepherd-action + name #~(string-join (list #$@invokation) " "))) + (if (oci-image? image) + '() (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 + (let ((service-name name)) + (shepherd-action + (name 'pull) + (documentation + (format #f "Pull ~a's image (~a)." + service-name image)) + (procedure + #~(lambda _ + (invoke #$runtime-cli "pull" #$image))))))) + actions))))) + +(define (oci-object-create-invokation object runtime-cli name options + runtime-extra-arguments + create-extra-arguments) + "Return a gexp that, upon lowering, will evaluate to the OCI runtime +invokation for creating networks and volumes." + ;; network|volume create [options] [NAME] + #~(list #$runtime-cli #$@runtime-extra-arguments #$object "create" + #$@options #$@create-extra-arguments #$name)) + +(define (format-oci-invokations invokations) + "Return a gexp that, upon lowering, will evaluate to a formatted message +containing the INVOKATIONS that the OCI runtime will execute to provision +networks or volumes." + #~(string-join (map (lambda (i) (string-join i " ")) + (list #$@invokations)) + "\n")) + +(define* (oci-object-create-script object runtime runtime-cli invokations + #:key (verbose? #f)) + "Return a file-like object that, once lowered, will evaluate to a program able +to create OCI networks and volumes through RUNTIME-CLI." + (define runtime-string (symbol->string runtime)) + (program-file + (string-append runtime-string "-" object "s-create.scm") + #~(begin + (use-modules (ice-9 format) + (ice-9 match) + (ice-9 popen) + (ice-9 rdelim) + (srfi srfi-1)) + + (define object-exists? + #$(oci-object-exists? runtime runtime-cli object verbose?)) + + (for-each + (lambda (invokation) + (define name (last invokation)) + (if (object-exists? name) + (format #t "~a ~a ~a already exists, skipping creation.~%" + #$(oci-runtime-name runtime) name #$object) + (begin + (when #$verbose? + (format #t "Running~{ ~a~}~%" invokation)) + (let ((exit-code (status:exit-val (apply system* invokation)))) + (when #$verbose? + (format #t "Exit code: ~a~%" exit-code)))))) + (list #$@invokations))))) + +(define* (oci-object-shepherd-service object runtime runtime-cli name requirement invokations + #:key + (runtime-environment #~()) + (user #f) + (group #f) + (verbose? #f)) + "Return a Shepherd service object that will create the OBJECTs represented +by INVOKATIONS through RUNTIME-CLI." + (shepherd-service (provision `(,(string->symbol name))) + (requirement requirement) + (one-shot? #t) + (documentation + (string-append + (oci-runtime-name runtime) " " object + " provisioning service")) + (start + #~(lambda _ + (fork+exec-command + (list + #$(oci-object-create-script + object runtime runtime-cli + invokations + #:verbose? verbose?)) + #$@(if user (list #:user user) '()) + #$@(if group (list #:group group) '()) + #:environment-variables + (list #$@runtime-environment)))) + (actions + (list + (oci-object-command-shepherd-action + name (format-oci-invokations invokations)))))) + +(define* (oci-networks-shepherd-service runtime runtime-cli name networks + #:key (user #f) (group #f) (verbose? #f) + (runtime-extra-arguments '()) + (runtime-environment #~()) + (runtime-requirement '())) + "Return a Shepherd service object that will create the networks represented +in CONFIG." + (let ((invokations + (map + (lambda (network) + (oci-object-create-invokation + "network" runtime-cli + (oci-network-configuration-name network) + (oci-network-configuration->options network) + runtime-extra-arguments + (oci-network-configuration-extra-arguments network))) + networks))) + + (oci-object-shepherd-service + "network" runtime runtime-cli name + runtime-requirement invokations + #:user user #:group group #:runtime-environment runtime-environment + #:verbose? verbose?))) + +(define* (oci-volumes-shepherd-service runtime runtime-cli name volumes + #:key (user #f) (group #f) (verbose? #f) + (runtime-extra-arguments '()) + (runtime-environment #~()) + (runtime-requirement '())) + "Return a Shepherd service object that will create the volumes represented +in CONFIG." + (let ((invokations + (map + (lambda (volume) + (oci-object-create-invokation + "volume" runtime-cli + (oci-volume-configuration-name volume) + (oci-volume-configuration->options volume) + runtime-extra-arguments + (oci-volume-configuration-extra-arguments volume))) + volumes))) + + (oci-object-shepherd-service + "volume" runtime runtime-cli name runtime-requirement invokations + #:user user #:group group #:runtime-environment runtime-environment + #:verbose? verbose?))) + +(define (oci-service-accounts config) + (define user (oci-configuration-user config)) + (define maybe-group (oci-configuration-group config)) + (define runtime (oci-configuration-runtime config)) (list (user-account - (name "oci-container") + (name user) (comment "OCI services account") - (group "docker") - (system? #t) - (home-directory "/var/empty") + (group "users") + (supplementary-groups + (list (oci-runtime-group runtime maybe-group))) + (system? (eq? 'docker runtime)) + (home-directory (if (eq? 'podman runtime) + (string-append "/home/" user) + "/var/empty")) + (create-home-directory? (eq? 'podman runtime)) (shell (file-append shadow "/sbin/nologin"))))) + +(define* (oci-state->shepherd-services runtime runtime-cli containers networks volumes + #:key (user #f) (group #f) (verbose? #f) + (networks-name #f) (volumes-name #f) + (runtime-extra-arguments '()) + (runtime-environment #~()) + (runtime-requirement '()) + (containers-requirement '()) + (networks-requirement '()) + (volumes-requirement '())) + (let* ((networks-name + (if (string? networks-name) + networks-name + (oci-networks-shepherd-name runtime))) + (networks? + (> (length networks) 0)) + (networks-service + (if networks? + (list + (string->symbol networks-name)) + '())) + (volumes-name + (if (string? volumes-name) + volumes-name + (oci-volumes-shepherd-name runtime))) + (volumes? + (> (length volumes) 0)) + (volumes-service + (if volumes? + (list (string->symbol volumes-name)) + '()))) + (append + (map + (lambda (c) + (oci-container-shepherd-service + runtime runtime-cli c + #:user user + #:group group + #:runtime-environment runtime-environment + #:runtime-extra-arguments runtime-extra-arguments + #:oci-requirement + (append containers-requirement + runtime-requirement + networks-service + volumes-service) + #:verbose? verbose?)) + containers) + (if networks? + (list + (oci-networks-shepherd-service + runtime runtime-cli + networks-name networks + #:user user #:group group + #:runtime-extra-arguments runtime-extra-arguments + #:runtime-environment runtime-environment + #:runtime-requirement (append networks-requirement + runtime-requirement) + #:verbose? verbose?)) + '()) + (if volumes? + (list + (oci-volumes-shepherd-service + runtime runtime-cli + volumes-name volumes + #:user user #:group group + #:runtime-extra-arguments runtime-extra-arguments + #:runtime-environment runtime-environment + #:runtime-requirement (append runtime-requirement + volumes-requirement) + #:verbose? verbose?)) + '())))) + +(define (oci-configuration->shepherd-services config) + (let* ((runtime (oci-configuration-runtime config)) + (system-runtime-cli + (oci-runtime-system-cli config)) + (home-runtime-cli + (oci-runtime-home-cli config)) + (runtime-extra-arguments + (oci-configuration-runtime-extra-arguments config)) + (containers (oci-configuration-containers config)) + (networks (oci-configuration-networks config)) + (volumes (oci-configuration-volumes config)) + (user (oci-configuration-user config)) + (group (oci-runtime-group + runtime (oci-configuration-group config))) + (verbose? (oci-configuration-verbose? config)) + (home-service? + (oci-configuration-home-service? config))) + (if home-service? + (oci-state->shepherd-services runtime home-runtime-cli containers networks volumes + #:verbose? verbose? + #:networks-name + (oci-networks-home-shepherd-name runtime) + #:volumes-name + (oci-volumes-home-shepherd-name runtime)) + (oci-state->shepherd-services runtime system-runtime-cli containers networks volumes + #:user user + #:group + (oci-runtime-system-group runtime user group) + #:verbose? verbose? + #:runtime-extra-arguments + runtime-extra-arguments + #:runtime-environment + (oci-runtime-system-environment runtime user) + #:runtime-requirement + (oci-runtime-system-requirement runtime) + #:networks-requirement '(networking))))) + +(define (oci-service-subids config) + "Return a subids-extension record representing subuids and subgids required by +the rootless Podman backend." + (define (delete-duplicate-ranges ranges) + (delete-duplicates ranges + (lambda args + (apply string=? (map subid-range-name ranges))))) + (define runtime + (oci-configuration-runtime config)) + (define user + (oci-configuration-user config)) + (define subgids (oci-configuration-subgids-range config)) + (define subuids (oci-configuration-subuids-range config)) + (define container-users + (filter (lambda (range) + (and (maybe-value-set? + (subid-range-name range)) + (not (string=? (subid-range-name range) user)))) + (map (lambda (container) + (subid-range + (name + (oci-container-configuration-user container)))) + (oci-configuration-containers config)))) + (define subgid-ranges + (delete-duplicate-ranges + (cons + (if (eq? subgids #f) + (subid-range (name user)) + subgids) + container-users))) + (define subuid-ranges + (delete-duplicate-ranges + (cons + (if (eq? subuids #f) + (subid-range (name user)) + subuids) + container-users))) + + (if (eq? 'podman runtime) + (subids-extension + (subgids + subgid-ranges) + (subuids + subuid-ranges)) + (subids-extension))) + +(define (oci-objects-merge-lst a b object get-name) + (define (contains? value lst) + (member value (map get-name lst))) + (let loop ((merged '()) + (lst (append a b))) + (if (null? lst) + merged + (loop + (let ((element (car lst))) + (when (contains? element merged) + (raise + (formatted-message + (G_ "Duplicated ~a: ~a. ~as names should be unique, please +remove the duplicate.") object (get-name element) object))) + (cons element merged)) + (cdr lst))))) + +(define (oci-extension-merge a b) + (oci-extension + (containers (oci-objects-merge-lst + (oci-extension-containers a) + (oci-extension-containers b) + "container" + (lambda (config) + (define maybe-name (oci-container-configuration-provision config)) + (if (maybe-value-set? maybe-name) + maybe-name + (oci-image->container-name + (oci-container-configuration-image config)))))) + (networks (oci-objects-merge-lst + (oci-extension-networks a) + (oci-extension-networks b) + "network" + oci-network-configuration-name)) + (volumes (oci-objects-merge-lst + (oci-extension-volumes a) + (oci-extension-volumes b) + "volume" + oci-volume-configuration-name)))) + +(define (oci-service-profile runtime runtime-cli) + `(,bash-minimal + ,@(if (string? runtime-cli) + '() + (list + (cond + ((not (eq? runtime-cli #f)) + runtime-cli) + ((eq? 'podman runtime) + podman) + (else + docker-cli)))))) + +(define (oci-service-extension-wrap-validate extension) + (lambda (config) + (if (oci-configuration-valid? config) + (extension config) + (raise + (formatted-message + (G_ "Invalide oci-configuration ~a.") config))))) + +(define (oci-configuration-extend config extension) + (oci-configuration + (inherit config) + (containers + (oci-objects-merge-lst + (oci-configuration-containers config) + (oci-extension-containers extension) + "container" + (lambda (oci-config) + (define runtime + (oci-configuration-runtime config)) + (oci-container-shepherd-name runtime oci-config)))) + (networks (oci-objects-merge-lst + (oci-configuration-networks config) + (oci-extension-networks extension) + "network" + oci-network-configuration-name)) + (volumes (oci-objects-merge-lst + (oci-configuration-volumes config) + (oci-extension-volumes extension) + "volume" + oci-volume-configuration-name)))) + +(define oci-service-type + (service-type (name 'oci) + (extensions + (list + (service-extension profile-service-type + (oci-service-extension-wrap-validate + (lambda (config) + (let ((runtime-cli + (oci-configuration-runtime-cli config)) + (runtime + (oci-configuration-runtime config))) + (oci-service-profile runtime runtime-cli))))) + (service-extension subids-service-type + (oci-service-extension-wrap-validate + oci-service-subids)) + (service-extension account-service-type + (oci-service-extension-wrap-validate + oci-service-accounts)) + (service-extension shepherd-root-service-type + (oci-service-extension-wrap-validate + oci-configuration->shepherd-services)))) + ;; Concatenate OCI object lists. + (compose (lambda (args) + (fold oci-extension-merge + (oci-extension) + args))) + (extend oci-configuration-extend) + (default-value (oci-configuration)) + (description + "This service implements the provisioning of OCI object such +as containers, networks and volumes."))) diff --git a/gnu/services/docker.scm b/gnu/services/docker.scm index 69ff9f1d9e4..98ee175873d 100644 --- a/gnu/services/docker.scm +++ b/gnu/services/docker.scm @@ -31,7 +31,10 @@ (define-module (gnu services docker) #:use-module (gnu system shadow) #:use-module (gnu packages docker) #:use-module (gnu packages linux) ;singularity + #:use-module (guix deprecation) + #:use-module (guix diagnostics) #:use-module (guix gexp) + #:use-module (guix i18n) #:use-module (guix records) #:use-module (srfi srfi-1) #:use-module (ice-9 format) @@ -67,16 +70,18 @@ (define-module (gnu services docker) 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) + oci-container-configuration-extra-arguments) #:export (containerd-configuration containerd-service-type docker-configuration docker-service-type singularity-service-type - oci-container-service-type)) + ;; for backwards compatibility, until the + ;; oci-container-service-type is fully deprecated + oci-container-shepherd-service + oci-container-service-type + %oci-container-accounts)) (define-maybe file-like) @@ -295,17 +300,25 @@ (define singularity-service-type ;;; OCI container. ;;; -(define (configs->shepherd-services configs) - (map oci-container-shepherd-service configs)) +;; for backwards compatibility, until the +;; oci-container-service-type is fully deprecated +(define-deprecated (oci-container-shepherd-service config) + oci-service-type + ((@ (gnu services containers) oci-container-shepherd-service) + 'docker config)) +(define %oci-container-accounts + (filter user-account? (oci-service-accounts (oci-configuration)))) (define oci-container-service-type (service-type (name 'oci-container) - (extensions (list (service-extension profile-service-type - (lambda _ (list docker-cli))) - (service-extension account-service-type - (const %oci-container-accounts)) - (service-extension shepherd-root-service-type - configs->shepherd-services))) + (extensions + (list (service-extension oci-service-type + (lambda (containers) + (warning + (G_ + "'oci-container-service-type' is deprecated, use 'oci-service-type' instead~%")) + (oci-extension + (containers containers)))))) (default-value '()) (extend append) (compose concatenate) diff --git a/gnu/tests/containers.scm b/gnu/tests/containers.scm index 0ecc8ddb126..5e6f39387e7 100644 --- a/gnu/tests/containers.scm +++ b/gnu/tests/containers.scm @@ -27,6 +27,9 @@ (define-module (gnu tests containers) #: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 @@ (define-module (gnu tests containers) #: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 @@ -345,3 +350,995 @@ (define %test-rootless-podman (name "rootless-podman") (description "Test rootless Podman service.") (value (build-tarball&run-rootless-podman-test)))) + + +(define %oci-rootless-podman-os + (simple-operating-system + (service dhcp-client-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-configuration (name "my-network")))) + (volumes + (list (oci-volume-configuration (name "my-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)(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 services herd) + (guix combinators)))) + + (define vm + (virtual-machine + (operating-system os) + (volatile? #f) + (memory-size 1024) + (disk-image-size (* 3000 (expt 2 20))) + (port-forwardings '()))) + + (define test + (with-imported-modules '((gnu build marionette)) + #~(begin + (use-modules (srfi srfi-11) (srfi srfi-64) + (gnu build marionette)) + + (define marionette + ;; Relax timeout to accommodate older systems and + ;; allow for pulling the image. + (make-marionette (list #$vm) #:timeout 60)) + (define out-dir "/tmp") + + (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 "rootless-podman services started successfully" + (begin + (define (run-test) + (marionette-eval + `(begin + (use-modules (ice-9 popen) + (ice-9 match) + (ice-9 rdelim)) + + (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 slurp + (lambda args + (let* ((port (apply open-pipe* OPEN_READ args)) + (output (read-lines port)) + (status (close-pipe port))) + output))) + (let* ((bash + ,(string-append #$bash "/bin/bash")) + (response1 + (slurp bash "-c" + (string-append "ls -la /sys/fs/cgroup | " + "grep -E ' \\./?$' | awk '{ print $4 }'"))) + (response2 (slurp bash "-c" + (string-append "ls -l /sys/fs/cgroup/cgroup" + ".{procs,subtree_control,threads} | " + "awk '{ print $4 }' | sort -u")))) + (list (string-join response1 "\n") (string-join response2 "\n")))) + marionette)) + ;; Allow services to come up on slower machines + (let loop ((attempts 0)) + (if (= attempts 60) + (error "Services didn't come up after more than 60 seconds") + (if (equal? '("cgroup" "cgroup") + (run-test)) + #t + (begin + (sleep 1) + (format #t "Services didn't come up yet, retrying with attempt ~a~%" + (+ 1 attempts)) + (loop (+ 1 attempts)))))))) + + (test-assert "podman-volumes running" + (begin + (define (run-test) + (marionette-eval + `(begin + (use-modules (srfi srfi-1) + (ice-9 popen) + (ice-9 match) + (ice-9 rdelim)) + + (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 (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 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))) + + (match (primitive-fork) + (0 + (dynamic-wind + (const #f) + (lambda () + (setgid (passwd:gid (getpwnam "oci-container"))) + (setuid (passwd:uid (getpw "oci-container"))) + + (let ((response (slurp + "/run/current-system/profile/bin/podman" + "volume" "ls" "-n" "--format" "\"{{.Name}}\"" + "|" "tr" "' '" "'\n'"))) + + (call-with-output-file (string-append ,out-dir "/response") + (lambda (port) + (display (string-join response "\n") port))))) + (lambda () + (primitive-exit 127)))) + (pid + (cdr (waitpid pid)))) + + (wait-for-file (string-append ,out-dir "/response")) + + (stable-sort + (slurp "cat" (string-append ,out-dir "/response")) + string<=?)) + marionette)) + ;; Allow services to come up on slower machines + (let loop ((attempts 0)) + (if (= attempts 80) + (error "Service didn't come up after more than 80 seconds") + (if (equal? '("my-volume") + (run-test)) + #t + (begin + (sleep 1) + (loop (+ 1 attempts)))))))) + + (test-assert "podman-networks running" + (begin + (define (run-test) + (marionette-eval + `(begin + (use-modules (srfi srfi-1) + (ice-9 popen) + (ice-9 match) + (ice-9 rdelim)) + + (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 (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 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))) + + (match (primitive-fork) + (0 + (dynamic-wind + (const #f) + (lambda () + (setgid (passwd:gid (getpwnam "oci-container"))) + (setuid (passwd:uid (getpw "oci-container"))) + + (let ((response (slurp + "/run/current-system/profile/bin/podman" + "network" "ls" "-n" "--format" "\"{{.Name}}\"" + "|" "tr" "' '" "'\n'"))) + + (call-with-output-file (string-append ,out-dir "/response") + (lambda (port) + (display (string-join response "\n") port))))) + (lambda () + (primitive-exit 127)))) + (pid + (cdr (waitpid pid)))) + + (wait-for-file (string-append ,out-dir "/response")) + + (stable-sort + (slurp "cat" (string-append ,out-dir "/response")) + string<=?)) + marionette)) + ;; Allow services to come up on slower machines + (let loop ((attempts 0)) + (if (= attempts 80) + (error "Service didn't come up after more than 80 seconds") + (if (equal? '("my-network" "podman") + (run-test)) + #t + (begin + (sleep 1) + (loop (+ 1 attempts)))))))) + + (test-assert "first container running" + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (wait-for-service 'first #:timeout 120) + #t) + marionette)) + + (test-assert "second container running" + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (wait-for-service 'second #:timeout 120) + #t) + marionette)) + + (test-assert "passing host environment variables" + (begin + (define (run-test) + (marionette-eval + `(begin + (use-modules (srfi srfi-1) + (ice-9 popen) + (ice-9 match) + (ice-9 rdelim)) + + (define (wait-for-file file) + ;; Wait until FILE shows up. + (let loop ((i 60)) + (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 (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 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))) + + (match (primitive-fork) + (0 + (dynamic-wind + (const #f) + (lambda () + (setgid (passwd:gid (getpwnam "oci-container"))) + (setuid (passwd:uid (getpw "oci-container"))) + + (let ((response (slurp + "/run/current-system/profile/bin/podman" + "exec" "first" + "/bin/guile" "-c" "'(display (getenv \"VARIABLE\"))'"))) + (call-with-output-file (string-append ,out-dir "/response") + (lambda (port) + (display (string-join response "\n") port))))) + (lambda () + (primitive-exit 127)))) + (pid + (cdr (waitpid pid)))) + + (wait-for-file (string-append ,out-dir "/response")) + (slurp "cat" (string-append ,out-dir "/response"))) + marionette)) + ;; Allow image to be loaded on slower machines + (let loop ((attempts 0)) + (if (= attempts 180) + (error "Service didn't come up after more than 180 seconds") + (if (equal? (list "value") + (run-test)) + #t + (begin + (sleep 1) + (loop (+ 1 attempts)))))))) + + (test-equal "mounting host files" + '("hello") + (marionette-eval + `(begin + (use-modules (srfi srfi-1) + (ice-9 popen) + (ice-9 match) + (ice-9 rdelim)) + + (define (wait-for-file file) + ;; Wait until FILE shows up. + (let loop ((i 60)) + (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 (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 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))) + + (match (primitive-fork) + (0 + (dynamic-wind + (const #f) + (lambda () + (setgid (passwd:gid (getpwnam "oci-container"))) + (setuid (passwd:uid (getpw "oci-container"))) + + (let ((response (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)))'"))) + (call-with-output-file (string-append ,out-dir "/response") + (lambda (port) + (display (string-join response " ") port))))) + (lambda () + (primitive-exit 127)))) + (pid + (cdr (waitpid pid)))) + + (wait-for-file (string-append ,out-dir "/response")) + (slurp "cat" (string-append ,out-dir "/response"))) + marionette)) + + (test-equal "write to volumes" + '("world") + (marionette-eval + `(begin + (use-modules (srfi srfi-1) + (ice-9 popen) + (ice-9 match) + (ice-9 rdelim)) + + (define (wait-for-file file) + ;; Wait until FILE shows up. + (let loop ((i 60)) + (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 (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 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))) + + (match (primitive-fork) + (0 + (dynamic-wind + (const #f) + (lambda () + (setgid (passwd:gid (getpwnam "oci-container"))) + (setuid (passwd:uid (getpw "oci-container"))) + + (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))))'") + + (let ((response (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)))'"))) + (call-with-output-file (string-append ,out-dir "/response") + (lambda (port) + (display (string-join response " ") port))))) + (lambda () + (primitive-exit 127)))) + (pid + (cdr (waitpid pid)))) + + (wait-for-file (string-append ,out-dir "/response")) + (slurp "cat" (string-append ,out-dir "/response"))) + marionette)) + + (test-equal "can read ports over network" + '("out of office") + (marionette-eval + `(begin + (use-modules (srfi srfi-1) + (ice-9 popen) + (ice-9 match) + (ice-9 rdelim)) + + (define (wait-for-file file) + ;; Wait until FILE shows up. + (let loop ((i 60)) + (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 (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 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))) + + (match (primitive-fork) + (0 + (dynamic-wind + (const #f) + (lambda () + (setgid (passwd:gid (getpwnam "oci-container"))) + (setuid (passwd:uid (getpw "oci-container"))) + + (let ((response (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))'"))) + (call-with-output-file (string-append ,out-dir "/response") + (lambda (port) + (display (string-join response " ") port))))) + (lambda () + (primitive-exit 127)))) + (pid + (cdr (waitpid pid)))) + + (wait-for-file (string-append ,out-dir "/response")) + (slurp "cat" (string-append ,out-dir "/response"))) + 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-os + (simple-operating-system + (service dhcp-client-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-configuration (name "my-network")))) + (volumes + (list (oci-volume-configuration (name "my-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)(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 services herd) + (guix combinators)))) + + (define vm + (virtual-machine + (operating-system os) + (volatile? #f) + (memory-size 1024) + (disk-image-size (* 3000 (expt 2 20))) + (port-forwardings '()))) + + (define test + (with-imported-modules '((gnu build marionette)) + #~(begin + (use-modules (srfi srfi-11) (srfi srfi-64) + (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) + (marionette-eval + `(begin + (use-modules (ice-9 popen) + (ice-9 rdelim)) + + (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 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))) + + (stable-sort + (slurp + "/run/current-system/profile/bin/docker" + "volume" "ls" "--format" "\"{{.Name}}\"") + string<=?)) + + marionette)) + ;; Allow services to come up on slower machines + (let loop ((attempts 0)) + (if (= attempts 80) + (error "Service didn't come up after more than 80 seconds") + (if (equal? '("my-volume") + (run-test)) + #t + (begin + (sleep 1) + (loop (+ 1 attempts)))))))) + + (test-assert "docker-networks running" + (begin + (define (run-test) + (marionette-eval + `(begin + (use-modules (ice-9 popen) + (ice-9 rdelim)) + + (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 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))) + + (stable-sort + (slurp + "/run/current-system/profile/bin/docker" + "network" "ls" "--format" "\"{{.Name}}\"") + string<=?)) + + marionette)) + ;; Allow services to come up on slower machines + (let loop ((attempts 0)) + (if (= attempts 80) + (error "Service didn't come up after more than 80 seconds") + (if (equal? '("bridge" "host" "my-network" "none") + (run-test)) + #t + (begin + (sleep 1) + (loop (+ 1 attempts)))))))) + + (test-assert "first container running" + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (wait-for-service 'first #:timeout 120) + #t) + marionette)) + + (test-assert "second container running" + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (wait-for-service 'second #:timeout 120) + #t) + marionette)) + + (test-assert "passing host environment variables" + (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))) + + (slurp + "/run/current-system/profile/bin/docker" + "exec" "first" + "/bin/guile" "-c" "(display (getenv \"VARIABLE\"))")) + marionette)) + ;; Allow image to be loaded on slower machines + (let loop ((attempts 0)) + (if (= attempts 180) + (error "Service didn't come up after more than 180 seconds") + (if (equal? "value" + (run-test)) + #t + (begin + (sleep 1) + (loop (+ 1 attempts)))))))) + + (test-equal "mounting host files" + "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))) + + (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 \"/shared.txt\" read-line)))")) + marionette)) + + (test-equal "write to volumes" + "world" + (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))) + + (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 ports over network" + "out of office" + (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))) + + (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)))) -- 2.48.1 From unknown Fri Jun 13 11:55:10 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#76081] [PATCH v5 1/5] services: rootless-podman: Use login shell. References: <2f43e635-508c-407a-8309-06e75d492d89@autistici.org> In-Reply-To: <2f43e635-508c-407a-8309-06e75d492d89@autistici.org> Resent-From: Giacomo Leidi Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Wed, 19 Feb 2025 00:10:03 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 76081 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 76081@debbugs.gnu.org Cc: Giacomo Leidi Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.17399237845462 (code B ref 76081); Wed, 19 Feb 2025 00:10:03 +0000 Received: (at 76081) by debbugs.gnu.org; 19 Feb 2025 00:09:44 +0000 Received: from localhost ([127.0.0.1]:36266 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tkXeo-0001Pm-U0 for submit@debbugs.gnu.org; Tue, 18 Feb 2025 19:09:44 -0500 Received: from confino.investici.org ([93.190.126.19]:31491) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1tkXel-0001On-7w for 76081@debbugs.gnu.org; Tue, 18 Feb 2025 19:09:40 -0500 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org; s=stigmate; t=1739923777; bh=j21R+eL7G7bstOL1dDr/h5ZqTwKB6M0H90ec7qezBbQ=; h=From:To:Cc:Subject:Date:From; b=hn0IWfcTncp7U1z7vTRv+nnwZmWsD12xBd0sSRqzYvqMbYZZCGc5KO543QHkO8R2F zQVd/rE2AJyxH4gHq8i+mAwGbW3Rl2PGIOeA1CrWJ8/Ye1rAvcUXa5YxWd9jI3tG8h djkdM09EDBF4rcas+XBg4hD9RJEH8VbYitnCiQww= Received: from mx1.investici.org (unknown [127.0.0.1]) by confino.investici.org (Postfix) with ESMTP id 4YyGwd1gT7z1107; Wed, 19 Feb 2025 00:09:37 +0000 (UTC) Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19]) (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with ESMTPSA id 4YyGwd0hkvz10yt; Wed, 19 Feb 2025 00:09:37 +0000 (UTC) From: Giacomo Leidi Date: Wed, 19 Feb 2025 01:09:18 +0100 Message-ID: <6d774afae43df08bf52f7ecb8900d35f501280d8.1739923762.git.goodoldpaul@autistici.org> X-Mailer: git-send-email 2.48.1 MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Spam-Score: -0.7 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.7 (-) This commit allows for having PATH set when changing the owner of /sys/fs/group. * gnu/services/containers.scm (crgroups-fs-owner): Use login shell. Change-Id: I9510c637a5332325e05ca5ebc9dfd4de32685c50 --- gnu/services/containers.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm index 19d35ccbcb6..dc66ac4f967 100644 --- a/gnu/services/containers.scm +++ b/gnu/services/containers.scm @@ -140,7 +140,7 @@ (define (cgroups-fs-owner-entrypoint config) (rootless-podman-configuration-group-name config)) (program-file "cgroups2-fs-owner-entrypoint" #~(system* - (string-append #+bash-minimal "/bin/bash") "-c" + (string-append #+bash-minimal "/bin/bash") "-l" "-c" (string-append "echo Setting /sys/fs/cgroup " "group ownership to " #$group " && chown -v " "root:" #$group " /sys/fs/cgroup && " base-commit: 3dc8026d58f9480547a595450a6483e0f13c1ba4 -- 2.48.1 From unknown Fri Jun 13 11:55:10 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#76081] [PATCH v5 4/5] tests: Use lower-oci-image-state in container tests. Resent-From: Giacomo Leidi Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Wed, 19 Feb 2025 00:10:04 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 76081 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 76081@debbugs.gnu.org Cc: Giacomo Leidi Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.17399237965523 (code B ref 76081); Wed, 19 Feb 2025 00:10:04 +0000 Received: (at 76081) by debbugs.gnu.org; 19 Feb 2025 00:09:56 +0000 Received: from localhost ([127.0.0.1]:36270 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tkXf1-0001Qy-Kc for submit@debbugs.gnu.org; Tue, 18 Feb 2025 19:09:56 -0500 Received: from confino.investici.org ([93.190.126.19]:38953) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1tkXel-0001Ov-Iu for 76081@debbugs.gnu.org; Tue, 18 Feb 2025 19:09:41 -0500 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org; s=stigmate; t=1739923778; bh=Wfjy2Y2ODngRJo5q3H8fRebODJqxLcwsieCh5T5hHoA=; h=From:To:Cc:Subject:Date:In-Reply-To:References:From; b=NO/pbIAEEzb1QQ+zkx6Gdd8+cWNIMTz6rHvI/yFYPNltaPELr1EDj2JxPiMtpnyuS dKAuBNyR2PtBihqzFrfV4UxBD50byvOEythxsvEwTWYMy5cT5sxmqkS4INfvrRL/Zy 6pyXxk2712Rr/2ISS9AJ9ZdkzVSTfZwszl8fN4Eo= Received: from mx1.investici.org (unknown [127.0.0.1]) by confino.investici.org (Postfix) with ESMTP id 4YyGwf4hPDz111d; Wed, 19 Feb 2025 00:09:38 +0000 (UTC) Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19]) (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with ESMTPSA id 4YyGwf3kmqz10yt; Wed, 19 Feb 2025 00:09:38 +0000 (UTC) From: Giacomo Leidi Date: Wed, 19 Feb 2025 01:09:21 +0100 Message-ID: <3fa0aa07079ab537bdd5b214803d56e08c426092.1739923762.git.goodoldpaul@autistici.org> X-Mailer: git-send-email 2.48.1 In-Reply-To: <6d774afae43df08bf52f7ecb8900d35f501280d8.1739923762.git.goodoldpaul@autistici.org> References: <6d774afae43df08bf52f7ecb8900d35f501280d8.1739923762.git.goodoldpaul@autistici.org> MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Spam-Score: -0.7 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.7 (-) This patch replaces boilerplate in container related tests with oci-image plumbing from (gnu services containers). * gnu/services/containers.scm: Export lower-oci-image-state. * gnu/tests/containers.scm (%oci-tarball): New variable; (run-rootless-podman-test): use %oci-tarball; (build-tarball&run-rootless-podman-test): drop procedure. * gnu/tests/docker.scm (%docker-tarball): New variable; (build-tarball&run-docker-test): use %docker-tarball; (%docker-system-tarball): New variable; (build-tarball&run-docker-system-test): new procedure. Change-Id: Iad6f0704aee188d89464c83722dea0bb7adb084a --- gnu/services/containers.scm | 2 + gnu/tests/containers.scm | 80 ++++++++++++++--------------- gnu/tests/docker.scm | 100 ++++++++++++++++++++---------------- 3 files changed, 95 insertions(+), 87 deletions(-) diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm index bd1b6f14356..8b57ac57798 100644 --- a/gnu/services/containers.scm +++ b/gnu/services/containers.scm @@ -75,6 +75,8 @@ (define-module (gnu services containers) oci-image-system oci-image-grafts? + lower-oci-image-state + oci-container-configuration oci-container-configuration? oci-container-configuration-fields diff --git a/gnu/tests/containers.scm b/gnu/tests/containers.scm index 5e6f39387e7..8cdd86e7ae3 100644 --- a/gnu/tests/containers.scm +++ b/gnu/tests/containers.scm @@ -69,13 +69,47 @@ (define %rootless-podman-os (supplementary-groups '("wheel" "netdev" "cgroup" "audio" "video"))))))) -(define (run-rootless-podman-test oci-tarball) +(define %oci-tarball + (lower-oci-image-state + "guile-guest" + (packages->manifest + (list + guile-3.0 guile-json-3 + (package + (name "guest-script") + (version "0") + (source #f) + (build-system trivial-build-system) + (arguments `(#:guile ,guile-3.0 + #:builder + (let ((out (assoc-ref %outputs "out"))) + (mkdir out) + (call-with-output-file (string-append out "/a.scm") + (lambda (port) + (display "(display \"hello world\n\")" port))) + #t))) + (synopsis "Display hello world using Guile") + (description "This package displays the text \"hello world\" on the +standard output device and then enters a new line.") + (home-page #f) + (license license:public-domain)))) + '(#:entry-point "bin/guile" + #:localstatedir? #t + #:extra-options (#:image-tag "guile-guest") + #:symlinks (("/bin/Guile" -> "bin/guile") + ("aa.scm" -> "a.scm"))) + "guile-guest" + (%current-target-system) + (%current-system) + #f)) + +(define (run-rootless-podman-test) (define os (marionette-operating-system (operating-system-with-gc-roots %rootless-podman-os - (list oci-tarball)) + (list %oci-tarball)) #:imported-modules '((gnu services herd) (guix combinators)))) @@ -254,7 +288,7 @@ (define (run-rootless-podman-test oci-tarball) (let* ((loaded (slurp ,(string-append #$podman "/bin/podman") "load" "-i" - ,#$oci-tarball)) + ,#$%oci-tarball)) (repository&tag "localhost/guile-guest:latest") (response1 (slurp ,(string-append #$podman "/bin/podman") @@ -307,49 +341,11 @@ (define (run-rootless-podman-test oci-tarball) (gexp->derivation "rootless-podman-test" test)) -(define (build-tarball&run-rootless-podman-test) - (mlet* %store-monad - ((_ (set-grafting #f)) - (guile (set-guile-for-build (default-guile))) - (guest-script-package -> - (package - (name "guest-script") - (version "0") - (source #f) - (build-system trivial-build-system) - (arguments `(#:guile ,guile-3.0 - #:builder - (let ((out (assoc-ref %outputs "out"))) - (mkdir out) - (call-with-output-file (string-append out "/a.scm") - (lambda (port) - (display "(display \"hello world\n\")" port))) - #t))) - (synopsis "Display hello world using Guile") - (description "This package displays the text \"hello world\" on the -standard output device and then enters a new line.") - (home-page #f) - (license license:public-domain))) - (profile (profile-derivation (packages->manifest - (list guile-3.0 guile-json-3 - guest-script-package)) - #:hooks '() - #:locales? #f)) - (tarball (pack:docker-image - "docker-pack" profile - #:symlinks '(("/bin/Guile" -> "bin/guile") - ("aa.scm" -> "a.scm")) - #:extra-options - '(#:image-tag "guile-guest") - #:entry-point "bin/guile" - #:localstatedir? #t))) - (run-rootless-podman-test tarball))) - (define %test-rootless-podman (system-test (name "rootless-podman") (description "Test rootless Podman service.") - (value (build-tarball&run-rootless-podman-test)))) + (value (run-rootless-podman-test)))) (define %oci-rootless-podman-os diff --git a/gnu/tests/docker.scm b/gnu/tests/docker.scm index 5dcf05a17e3..07edd9d5341 100644 --- a/gnu/tests/docker.scm +++ b/gnu/tests/docker.scm @@ -26,6 +26,7 @@ (define-module (gnu tests docker) #:use-module (gnu system image) #:use-module (gnu system vm) #:use-module (gnu services) + #:use-module (gnu services containers) #:use-module (gnu services dbus) #:use-module (gnu services networking) #:use-module (gnu services docker) @@ -57,6 +58,40 @@ (define %docker-os (service containerd-service-type) (service docker-service-type))) +(define %docker-tarball + (lower-oci-image-state + "guile-guest" + (packages->manifest + (list + guile-3.0 guile-json-3 + (package + (name "guest-script") + (version "0") + (source #f) + (build-system trivial-build-system) + (arguments `(#:guile ,guile-3.0 + #:builder + (let ((out (assoc-ref %outputs "out"))) + (mkdir out) + (call-with-output-file (string-append out "/a.scm") + (lambda (port) + (display "(display \"hello world\n\")" port))) + #t))) + (synopsis "Display hello world using Guile") + (description "This package displays the text \"hello world\" on the +standard output device and then enters a new line.") + (home-page #f) + (license license:public-domain)))) + '(#:entry-point "bin/guile" + #:localstatedir? #t + #:extra-options (#:image-tag "guile-guest") + #:symlinks (("/bin/Guile" -> "bin/guile") + ("aa.scm" -> "a.scm"))) + "guile-guest" + (%current-target-system) + (%current-system) + #f)) + (define (run-docker-test docker-tarball) "Load DOCKER-TARBALL as Docker image and run it in a Docker container, inside %DOCKER-OS." @@ -173,40 +208,7 @@ (define (run-docker-test docker-tarball) (gexp->derivation "docker-test" test)) (define (build-tarball&run-docker-test) - (mlet* %store-monad - ((_ (set-grafting #f)) - (guile (set-guile-for-build (default-guile))) - (guest-script-package -> - (package - (name "guest-script") - (version "0") - (source #f) - (build-system trivial-build-system) - (arguments `(#:guile ,guile-3.0 - #:builder - (let ((out (assoc-ref %outputs "out"))) - (mkdir out) - (call-with-output-file (string-append out "/a.scm") - (lambda (port) - (display "(display \"hello world\n\")" port))) - #t))) - (synopsis "Display hello world using Guile") - (description "This package displays the text \"hello world\" on the -standard output device and then enters a new line.") - (home-page #f) - (license license:public-domain))) - (profile (profile-derivation (packages->manifest - (list guile-3.0 guile-json-3 - guest-script-package)) - #:hooks '() - #:locales? #f)) - (tarball (pack:docker-image - "docker-pack" profile - #:symlinks '(("/bin/Guile" -> "bin/guile") - ("aa.scm" -> "a.scm")) - #:entry-point "bin/guile" - #:localstatedir? #t))) - (run-docker-test tarball))) + (run-docker-test %docker-tarball)) (define %test-docker (system-test @@ -215,8 +217,22 @@ (define %test-docker (value (build-tarball&run-docker-test)))) +(define %docker-system-tarball + (lower-oci-image-state + "guix-system-guest" + (operating-system + (inherit (simple-operating-system)) + ;; Use locales for a single libc to + ;; reduce space requirements. + (locale-libcs (list glibc))) + '() + "guix-system-guest" + (%current-target-system) + (%current-system) + #f)) + (define (run-docker-system-test tarball) - "Load DOCKER-TARBALL as Docker image and run it in a Docker container, + "Load TARBALL as Docker image and run it in a Docker container, inside %DOCKER-OS." (define os (marionette-operating-system @@ -333,21 +349,15 @@ (define (run-docker-system-test tarball) (gexp->derivation "docker-system-test" test)) +(define (build-tarball&run-docker-system-test) + (run-docker-system-test %docker-system-tarball)) + (define %test-docker-system (system-test (name "docker-system") (description "Run a system image as produced by @command{guix system docker-image} inside Docker.") - (value (with-monad %store-monad - (>>= (lower-object - (system-image (os->image - (operating-system - (inherit (simple-operating-system)) - ;; Use locales for a single libc to - ;; reduce space requirements. - (locale-libcs (list glibc))) - #:type docker-image-type))) - run-docker-system-test))))) + (value (build-tarball&run-docker-system-test)))) (define %oci-os -- 2.48.1 From unknown Fri Jun 13 11:55:10 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#76081] [PATCH v5 5/5] home: Add home-oci-service-type. Resent-From: Giacomo Leidi Original-Sender: "Debbugs-submit" Resent-CC: andrew@trop.in, janneke@gnu.org, ludo@gnu.org, maxim.cournoyer@gmail.com, tanguy@bioneland.org, guix-patches@gnu.org Resent-Date: Wed, 19 Feb 2025 00:10:05 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 76081 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 76081@debbugs.gnu.org Cc: Giacomo Leidi , Andrew Tropin , Janneke Nieuwenhuizen , Ludovic =?UTF-8?Q?Court=C3=A8s?= , Maxim Cournoyer , Tanguy Le Carrour X-Debbugs-Original-Xcc: Andrew Tropin , Janneke Nieuwenhuizen , Ludovic =?UTF-8?Q?Court=C3=A8s?= , Maxim Cournoyer , Tanguy Le Carrour Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.17399237975533 (code B ref 76081); Wed, 19 Feb 2025 00:10:05 +0000 Received: (at 76081) by debbugs.gnu.org; 19 Feb 2025 00:09:57 +0000 Received: from localhost ([127.0.0.1]:36272 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tkXf2-0001R7-Ez for submit@debbugs.gnu.org; Tue, 18 Feb 2025 19:09:57 -0500 Received: from confino.investici.org ([93.190.126.19]:49497) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1tkXel-0001Ox-VZ for 76081@debbugs.gnu.org; Tue, 18 Feb 2025 19:09:42 -0500 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org; s=stigmate; t=1739923779; bh=sGIhirA8GRSvDy2Gv6T1Jnf2sTFHuYS1u49lb0uWaSw=; h=From:To:Cc:Subject:Date:In-Reply-To:References:From; b=Gr/AzrFcZGkIwgED2I0J/uM2v+VRK4w5CXcW8MJp49GX15k00C9Kz5/5LTF2jMdKP QuhyFVEikus4h4sa7fPhLuEMavGVB9WMqPncA/S79D5cgV4Cpdzhjh68pPqWR8Z3SH u18mPybA/ljK3YoRzYaEhKMwZvmr0qEPlaJmHvjA= Received: from mx1.investici.org (unknown [127.0.0.1]) by confino.investici.org (Postfix) with ESMTP id 4YyGwg0YkDz111j; Wed, 19 Feb 2025 00:09:39 +0000 (UTC) Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19]) (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with ESMTPSA id 4YyGwf6hycz10yt; Wed, 19 Feb 2025 00:09:38 +0000 (UTC) From: Giacomo Leidi Date: Wed, 19 Feb 2025 01:09:22 +0100 Message-ID: X-Mailer: git-send-email 2.48.1 In-Reply-To: <6d774afae43df08bf52f7ecb8900d35f501280d8.1739923762.git.goodoldpaul@autistici.org> References: <6d774afae43df08bf52f7ecb8900d35f501280d8.1739923762.git.goodoldpaul@autistici.org> MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit X-Spam-Score: -0.7 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.7 (-) * gnu/home/service/containers.scm: New file; * gnu/local.mk (GNU_SYSTEM_MODULES): Add it. * doc/guix.texi (OCI backed services): Document it. Change-Id: I8ce5b301e8032d0a7b2a9ca46752738cdee1f030 --- doc/guix.texi | 114 +++++++++++++++++++++++++++++++ gnu/home/services/containers.scm | 50 ++++++++++++++ gnu/local.mk | 1 + 3 files changed, 165 insertions(+) create mode 100644 gnu/home/services/containers.scm diff --git a/doc/guix.texi b/doc/guix.texi index 0dfec66a52b..eacca409473 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -49826,6 +49826,120 @@ Miscellaneous Home Services (dicod-configuration @dots{}))) @end lisp +@subsubheading OCI backed services + +@cindex OCI-backed, for Home +The @code{(gnu home services containers)} module provides the following service: + +@defvar home-oci-service-type +This is the type of the service that allows to manage your OCI containers with +the same consistent interface you use for your other Home Shepherd services. +@end defvar + +This service is a direct mapping of the @code{oci-service-type} system +service (@pxref{Miscellaneous Services, OCI backed services}). You can +use it like this: + +@lisp +(use-modules (gnu services containers) + (gnu home services containers)) + +(simple-service 'home-oci-provisioning + home-oci-service-type + (oci-extension + (volumes + (list + (oci-volume-configuration (name "prometheus")) + (oci-volume-configuration (name "grafana")))) + (networks + (list + (oci-network-configuration (name "monitoring")))) + (containers + (list + (oci-container-configuration + (network "monitoring") + (image + (oci-image + (repository "guile") + (tag "3") + (value (specifications->manifest '("guile"))) + (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile")) + #:max-layers 2)))) + (entrypoint "/bin/guile") + (command + '("-c" "(display \"hello!\n\")"))) + (oci-container-configuration + (image "prom/prometheus") + (network "monitoring") + (ports + '(("9000" . "9000") + ("9090" . "9090"))) + (volumes + (list + '(("prometheus" . "/var/lib/prometheus"))))) + (oci-container-configuration + (image "grafana/grafana:10.0.1") + (network "monitoring") + (volumes + '(("grafana:/var/lib/grafana")))))))) + +@end lisp + +You may specify a custom configuration by providing a +@code{oci-configuration} record, exactly like for +@code{oci-service-type}, but wrapping it in @code{for-home}: + +@lisp +(use-modules (gnu services) + (gnu services containers) + (gnu home services containers)) + +(service home-oci-service-type + (for-home + (oci-configuration + (runtime 'podman) + (verbose? #t)))) + +(simple-service 'home-oci-provisioning + home-oci-service-type + (oci-extension + (volumes + (list + (oci-volume-configuration (name "prometheus")) + (oci-volume-configuration (name "grafana")))) + (networks + (list + (oci-network-configuration (name "monitoring")))) + (containers + (list + (oci-container-configuration + (network "monitoring") + (image + (oci-image + (repository "guile") + (tag "3") + (value (specifications->manifest '("guile"))) + (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile")) + #:max-layers 2)))) + (entrypoint "/bin/guile") + (command + '("-c" "(display \"hello!\n\")"))) + (oci-container-configuration + (image "prom/prometheus") + (network "monitoring") + (ports + '(("9000" . "9000") + ("9090" . "9090"))) + (volumes + (list + '(("prometheus" . "/var/lib/prometheus"))))) + (oci-container-configuration + (image "grafana/grafana:10.0.1") + (network "monitoring") + (volumes + '(("grafana:/var/lib/grafana")))))))) +@end lisp + @node Invoking guix home @section Invoking @command{guix home} diff --git a/gnu/home/services/containers.scm b/gnu/home/services/containers.scm new file mode 100644 index 00000000000..938dde2f37a --- /dev/null +++ b/gnu/home/services/containers.scm @@ -0,0 +1,50 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2025 Giacomo Leidi +;;; +;;; 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 . + +(define-module (gnu home services containers) + #:use-module (gnu home services) + #:use-module (gnu home services shepherd) + #:use-module (gnu services) + #:use-module (gnu services configuration) + #:use-module (gnu services containers) + #:use-module (guix gexp) + #:use-module (guix packages) + #:use-module (srfi srfi-1) + #:export (home-oci-service-type)) + +(define home-oci-service-type + (service-type (inherit (system->home-service-type oci-service-type)) + (extensions + (list + (service-extension home-profile-service-type + (oci-service-extension-wrap-validate + (lambda (config) + (let ((runtime-cli + (oci-configuration-runtime-cli config)) + (runtime + (oci-configuration-runtime config))) + (oci-service-profile runtime runtime-cli))))) + (service-extension home-shepherd-service-type + (oci-service-extension-wrap-validate + oci-configuration->shepherd-services)))) + (extend + (lambda (config extension) + (for-home + (oci-configuration + (inherit (oci-configuration-extend config extension)))))) + (default-value (for-home (oci-configuration))))) diff --git a/gnu/local.mk b/gnu/local.mk index 01926bb1b8b..37ab59a3ba1 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -102,6 +102,7 @@ GNU_SYSTEM_MODULES = \ %D%/home.scm \ %D%/home/services.scm \ %D%/home/services/admin.scm \ + %D%/home/services/containers.scm \ %D%/home/services/desktop.scm \ %D%/home/services/dict.scm \ %D%/home/services/dotfiles.scm \ -- 2.48.1 From unknown Fri Jun 13 11:55:10 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#76081] [PATCH v5 2/5] services: oci-container-configuration: Move to (gnu services containers). Resent-From: Giacomo Leidi Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Wed, 19 Feb 2025 00:10:06 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 76081 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 76081@debbugs.gnu.org Cc: Giacomo Leidi Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.17399238015557 (code B ref 76081); Wed, 19 Feb 2025 00:10:06 +0000 Received: (at 76081) by debbugs.gnu.org; 19 Feb 2025 00:10:01 +0000 Received: from localhost ([127.0.0.1]:36274 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tkXf3-0001RC-ED for submit@debbugs.gnu.org; Tue, 18 Feb 2025 19:10:00 -0500 Received: from confino.investici.org ([2a11:7980:1::2:0]:27437) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1tkXem-0001Oo-Pg for 76081@debbugs.gnu.org; Tue, 18 Feb 2025 19:09:47 -0500 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org; s=stigmate; t=1739923777; bh=C6uHhY9S9WpgPkIaaAgAOz8vooJK2RfngRRsEihvD9o=; h=From:To:Cc:Subject:Date:In-Reply-To:References:From; b=ELqQ4n5ofrNrD9inocf3DgK2/MlRIcqTCeC85GYYzdWpSOHvUxHfdsf/n0VDUx8Kr VIysE+OPLCYalnW49NabJfABbcTIarUcK0pJbMJqChsd8061BCG9DvNO/z97J4YtsM Bz0ikwxHMG7xuWEjcFEbj96TLzFFaLBMb5S9wovk= Received: from mx1.investici.org (unknown [127.0.0.1]) by confino.investici.org (Postfix) with ESMTP id 4YyGwd4pJgz110J; Wed, 19 Feb 2025 00:09:37 +0000 (UTC) Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19]) (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with ESMTPSA id 4YyGwd3KKkz10yt; Wed, 19 Feb 2025 00:09:37 +0000 (UTC) From: Giacomo Leidi Date: Wed, 19 Feb 2025 01:09:19 +0100 Message-ID: X-Mailer: git-send-email 2.48.1 In-Reply-To: <6d774afae43df08bf52f7ecb8900d35f501280d8.1739923762.git.goodoldpaul@autistici.org> References: <6d774afae43df08bf52f7ecb8900d35f501280d8.1739923762.git.goodoldpaul@autistici.org> MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit X-Spam-Score: -0.0 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) 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 dc66ac4f967..50bf6c05549 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 +;;; Copyright © 2024, 2025 Giacomo Leidi ;;; ;;; This file is part of GNU Guix. ;;; @@ -17,19 +17,31 @@ ;;; along with GNU Guix. If not, see . (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) @@ -188,7 +237,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 @@ -242,3 +291,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 3af0f792701..69ff9f1d9e4 100644 --- a/gnu/services/docker.scm +++ b/gnu/services/docker.scm @@ -5,7 +5,7 @@ ;;; Copyright © 2020 Efraim Flashner ;;; Copyright © 2020 Jesse Dowell ;;; Copyright © 2021 Brice Waegeneire -;;; Copyright © 2023, 2024 Giacomo Leidi +;;; Copyright © 2023, 2024, 2025 Giacomo Leidi ;;; ;;; This file is part of GNU Guix. ;;; @@ -23,72 +23,60 @@ ;;; along with GNU Guix. If not, see . (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) @@ -307,495 +295,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} 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"))))) - (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 ;;; Copyright © 2019-2023 Ludovic Courtès -;;; Copyright © 2024 Giacomo Leidi +;;; Copyright © 2024, 2025 Giacomo Leidi ;;; ;;; 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 From unknown Fri Jun 13 11:55:10 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#76081] OCI provisioning service Resent-From: paul Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Wed, 26 Feb 2025 23:02:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 76081 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 76081@debbugs.gnu.org Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.17406108843566 (code B ref 76081); Wed, 26 Feb 2025 23:02:02 +0000 Received: (at 76081) by debbugs.gnu.org; 26 Feb 2025 23:01:24 +0000 Received: from localhost ([127.0.0.1]:56036 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tnQP6-0000vR-4E for submit@debbugs.gnu.org; Wed, 26 Feb 2025 18:01:24 -0500 Received: from confino.investici.org ([2a11:7980:1::2:0]:28999) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1tnQP2-0000vD-HY for 76081@debbugs.gnu.org; Wed, 26 Feb 2025 18:01:21 -0500 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org; s=stigmate; t=1740610877; bh=BRRJ7N+7EyK+1dKm1svgagZ5hIH13SpuoPh3X+g3lG0=; h=Date:Subject:From:To:References:In-Reply-To:From; b=G8OnlC6+zghRciOw5WhxH2a1W4De9DT825gkR51VIjkOu55EDfSee2mcjgl9Tawdv lauD+HtTd9biJ74XIU7faFHBV2Jyjxl+AQ9yThnCVthY4cB6/mIC2Nne3rV7if6Bz9 IqQinMW5+O8Rq25zyiFf6ooTAQwIrDuyv2YKTFnc= Received: from mx1.investici.org (unknown [127.0.0.1]) by confino.investici.org (Postfix) with ESMTP id 4Z392534zWz11Ct for <76081@debbugs.gnu.org>; Wed, 26 Feb 2025 23:01:17 +0000 (UTC) Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19]) (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with ESMTPSA id 4Z39252XlYz117r for <76081@debbugs.gnu.org>; Wed, 26 Feb 2025 23:01:17 +0000 (UTC) Message-ID: <397afc1f-b638-430a-b9e7-7de4721bca45@autistici.org> Date: Thu, 27 Feb 2025 00:01:16 +0100 MIME-Version: 1.0 User-Agent: Icedove Daily From: paul References: <274b98ea-1af9-4f0f-af58-8fa755feb73b@autistici.org> Content-Language: en-US In-Reply-To: Content-Type: text/plain; charset=UTF-8; format=flowed Content-Transfer-Encoding: 8bit X-Spam-Score: -0.0 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) Hi guix, On 2/18/25 02:20, paul wrote: > Hi, > > On 2/12/25 02:09, paul wrote: >> Hi guix, >> >> On 2/9/25 21:38, paul wrote: >>> I'm sending a v3 fixing a bug in the merge algorithm for volumes and >>> networks. >>> >>> On 2/9/25 20:14, paul wrote: >>>> Hi, >>>> >>>> I'm about to send a v2. v2 compared to the first revision features: >>>> >>>> >>>> - it actually compiles all the times :) (rev 1 referenced oci-image >>>> too early for it to be working and generated a compile time error, >>>> if you recompiled it sometimes went away so I thought it was a >>>> problem of my setup. CI caught this) >>>> - it allows more values to be overridden by eventual users of the >>>> Scheme API >>>> - it allows passing extra arguments directly after each podman or >>>> docker invokation, allowing for example for overriding podman >>>> --root and similar options. >>>> >>>> All of these tests should pass: >>>> >>>> guix shell -D guix -CPW -- make check-system TESTS="oci-container >>>> oci-service-rootless-podman docker docker-system rootless-podman >>>> oci-service-docker" >>>> >> I'm sending a v4 changing slightly the image loader, the same tests >> as before are supposed to pass. Now the Home service [0] is working >> for me with rootless podman. I'll try it on different distros if I >> manage to. > > I'm sending a v5 implementing a Home service. The changes compared to > v4 are pretty trivial as the plumbing was already there, the only > downside is that I'm not able to use for-home? in > define-configuration, so I had to reimplement oci-configuration with > (guix records) and had to reimplement some validation (gnu services > configuration) would figure out magically. I'm sending  a v6. Compared to v5 it resolves the conflicts with master and it should fix the stop action for rootless podman backed services. Thank you for all your work, giacomo From unknown Fri Jun 13 11:55:10 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#76081] [PATCH v6 1/5] services: rootless-podman: Use login shell. References: <2f43e635-508c-407a-8309-06e75d492d89@autistici.org> In-Reply-To: <2f43e635-508c-407a-8309-06e75d492d89@autistici.org> Resent-From: Giacomo Leidi Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Wed, 26 Feb 2025 23:09:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 76081 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 76081@debbugs.gnu.org Cc: Giacomo Leidi Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.17406113074844 (code B ref 76081); Wed, 26 Feb 2025 23:09:01 +0000 Received: (at 76081) by debbugs.gnu.org; 26 Feb 2025 23:08:27 +0000 Received: from localhost ([127.0.0.1]:56072 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tnQVu-0001G4-KH for submit@debbugs.gnu.org; Wed, 26 Feb 2025 18:08:26 -0500 Received: from confino.investici.org ([2a11:7980:1::2:0]:35199) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1tnQVr-0001FV-T6 for 76081@debbugs.gnu.org; Wed, 26 Feb 2025 18:08:24 -0500 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org; s=stigmate; t=1740611301; bh=Q9g4XDsM/Xr0XzSKcV29fTA0IaYoCgcp06lbERRutEA=; h=From:To:Cc:Subject:Date:From; b=NA3tTbXdbNGF+MHeIbEwIrfVV/z9yYR5RE6yO6daf61V1hpTx0fTr7ysvQZDRKeJD fGIbpFf5n7uu5Uxj1ewh+DivURj/iEDDruoEY//N+a5iNW5Df1zRFv1aWL7nbsX/my Jn2vSYgUHNVqRXyQkzBP7fCv1ub6+W2feTMkkggw= Received: from mx1.investici.org (unknown [127.0.0.1]) by confino.investici.org (Postfix) with ESMTP id 4Z39BF5F5Kz113q; Wed, 26 Feb 2025 23:08:21 +0000 (UTC) Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19]) (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with ESMTPSA id 4Z39BF4DbXz111L; Wed, 26 Feb 2025 23:08:21 +0000 (UTC) From: Giacomo Leidi Date: Thu, 27 Feb 2025 00:08:06 +0100 Message-ID: <0ba285c5241f6817250b4af71776072faf248a14.1740611290.git.goodoldpaul@autistici.org> X-Mailer: git-send-email 2.48.1 MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Spam-Score: -0.0 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) This commit allows for having PATH set when changing the owner of /sys/fs/group. * gnu/services/containers.scm (crgroups-fs-owner): Use login shell. Change-Id: I9510c637a5332325e05ca5ebc9dfd4de32685c50 --- gnu/services/containers.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm index b3cd109ce6c..d5a211765a6 100644 --- a/gnu/services/containers.scm +++ b/gnu/services/containers.scm @@ -140,7 +140,7 @@ (define (cgroups-fs-owner-entrypoint config) (rootless-podman-configuration-group-name config)) (program-file "cgroups2-fs-owner-entrypoint" #~(system* - (string-append #+bash-minimal "/bin/bash") "-c" + (string-append #+bash-minimal "/bin/bash") "-l" "-c" (string-append "echo Setting /sys/fs/cgroup " "group ownership to " #$group " && chown -v " "root:" #$group " /sys/fs/cgroup && " base-commit: 4f220482de742c9c03cf6378ab147026a330edd0 -- 2.48.1 From unknown Fri Jun 13 11:55:10 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#76081] [PATCH v6 3/5] services: Add oci-service-type. Resent-From: Giacomo Leidi Original-Sender: "Debbugs-submit" Resent-CC: ludo@gnu.org, maxim.cournoyer@gmail.com, guix-patches@gnu.org Resent-Date: Wed, 26 Feb 2025 23:09:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 76081 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 76081@debbugs.gnu.org Cc: Giacomo Leidi , Ludovic =?UTF-8?Q?Court=C3=A8s?= , Maxim Cournoyer X-Debbugs-Original-Xcc: Ludovic =?UTF-8?Q?Court=C3=A8s?= , Maxim Cournoyer Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.17406113074852 (code B ref 76081); Wed, 26 Feb 2025 23:09:02 +0000 Received: (at 76081) by debbugs.gnu.org; 26 Feb 2025 23:08:27 +0000 Received: from localhost ([127.0.0.1]:56074 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tnQVv-0001GA-31 for submit@debbugs.gnu.org; Wed, 26 Feb 2025 18:08:27 -0500 Received: from confino.investici.org ([93.190.126.19]:24921) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1tnQVr-0001FY-Tk for 76081@debbugs.gnu.org; Wed, 26 Feb 2025 18:08:24 -0500 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org; s=stigmate; t=1740611302; bh=0CJW+7GjjzzwUQp3vizp1adM7ydzLgcz9w4Ey/TZDwg=; h=From:To:Cc:Subject:Date:In-Reply-To:References:From; b=e9lHzaLOahYWE4WHrsUwhmpYM7skHuAiOEvhObsxc7+wXp2uU/a1TwHxsrFBDQ44a ErmUxmgPqZjhjQddiU+AnqvQ0IChIkDr4NGmjxvta9m9buDGCcqXx6L/kvPwJHGCLB PMo924DZPdcL2pApGSk99W0QYiEYuzTgQbI9ULdw= Received: from mx1.investici.org (unknown [127.0.0.1]) by confino.investici.org (Postfix) with ESMTP id 4Z39BG46kBz11D5; Wed, 26 Feb 2025 23:08:22 +0000 (UTC) Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19]) (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with ESMTPSA id 4Z39BG2pscz111L; Wed, 26 Feb 2025 23:08:22 +0000 (UTC) From: Giacomo Leidi Date: Thu, 27 Feb 2025 00:08:08 +0100 Message-ID: <584a7fb04ad1be743e3935ea59aaec8883dbf0f4.1740611290.git.goodoldpaul@autistici.org> X-Mailer: git-send-email 2.48.1 In-Reply-To: <0ba285c5241f6817250b4af71776072faf248a14.1740611290.git.goodoldpaul@autistici.org> References: <0ba285c5241f6817250b4af71776072faf248a14.1740611290.git.goodoldpaul@autistici.org> MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" 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/services/containers.scm (%oci-supported-runtimes): New variable; (oci-runtime-cli): new variable; (oci-runtime-name): new variable; (oci-network-configuration): new variable; (oci-volume-configuration): new variable; (oci-configuration): new variable; (oci-extension): new variable; (oci-networks-shepherd-name): new variable; (oci-service-type): new variable; (oci-state->shepherd-services): new variable. * doc/guix.texi: Document it. * gnu/tests/containers.scm: Test it. * gnu/services/docker.scm: Deprecate the oci-container-service-type. Change-Id: I656b3db85832e42d53072fcbfb91d1226f39ef38 --- doc/guix.texi | 306 ++++++-- gnu/services/containers.scm | 1314 ++++++++++++++++++++++++++++++----- gnu/services/docker.scm | 37 +- gnu/tests/containers.scm | 999 +++++++++++++++++++++++++- 4 files changed, 2404 insertions(+), 252 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index a036c85c31a..fd08261af3b 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -42325,59 +42325,162 @@ Miscellaneous Services @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: given an -@acronym{Open Container Initiative, OCI} container image, it will run it in a +Should you wish to manage your @acronym{Open Container Initiative, OCI} containers +with the same consistent interface you use for your other Shepherd services, +@var{oci-service-type} is the tool to use: given an +OCI container image, it will run it in a Shepherd service. One example where this is useful: it lets you run services -that are available as Docker/OCI images but not yet packaged for Guix. +that are available as OCI images but not yet packaged for Guix. -@defvar oci-container-service-type +@defvar oci-service-type -This is a thin wrapper around Docker's CLI that executes OCI images backed +This is a thin wrapper around Docker's or Podman's CLI that executes OCI images backed processes as Shepherd Services. @lisp -(service oci-container-service-type - (list - (oci-container-configuration - (network "host") - (image - (oci-image - (repository "guile") - (tag "3") - (value (specifications->manifest '("guile"))) - (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile")) - #:max-layers 2)))) - (entrypoint "/bin/guile") - (command - '("-c" "(display \"hello!\n\")"))) - (oci-container-configuration - (image "prom/prometheus") - (ports - '(("9000" . "9000") - ("9090" . "9090")))) - (oci-container-configuration - (image "grafana/grafana:10.0.1") - (network "host") - (volumes - '("/var/lib/grafana:/var/lib/grafana"))))) +(simple-service 'oci-provisioning + oci-service-type + (oci-extension + (networks + (list + (oci-network-configuration (name "monitoring")))) + (containers + (list + (oci-container-configuration + (network "monitoring") + (image + (oci-image + (repository "guile") + (tag "3") + (value (specifications->manifest '("guile"))) + (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile")) + #:max-layers 2)))) + (entrypoint "/bin/guile") + (command + '("-c" "(display \"hello!\n\")"))) + (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 In this example three different Shepherd services are going to be added to the system. Each @code{oci-container-configuration} record translates to a -@code{docker run} invocation and its fields directly map to options. You can -refer to the -@url{https://docs.docker.com/engine/reference/commandline/run,upstream} -documentation for the semantics of each value. If the images are not found, -they will be -@url{https://docs.docker.com/engine/reference/commandline/pull/,pulled}. The +@command{docker run} or @command{podman run} invocation and its fields directly +map to options. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html,Podman} +upstream documentation for semantics of each value. If the images are not found, +they will be pulled. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/pull/,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-pull.1.html,Podman} +upstream documentation for semantics. The services with @code{(network "host")} are going to be attached to the host network and are supposed to behave like native processes with regard to networking. @end defvar +@c %start of fragment + +@deftp {Data Type} oci-configuration +Available @code{oci-configuration} fields are: + +@table @asis +@item @code{runtime} (default: @code{'docker}) (type: symbol) +The OCI runtime to use to run commands. It can be either @code{'docker} or +@code{'podman}. + +@item @code{runtime-cli} (type: maybe-package-or-string) +The OCI runtime command line to be installed in the system profile and used +to provision OCI resources. When unset it will default to @code{docker-cli} +package for the @code{'docker} runtime or to @code{podman} package for the +@code{'podman} runtime. When a string is passed it will be interpreted as the +absolute file-system path of the selected OCI runtime command. + +@item @code{runtime-extra-arguments} (default: @code{'()}) (type: list) +A list of strings, gexps or file-like objects that will be placed +after each @command{docker} or @command{podman} invokation. + +@item @code{user} (type: maybe-string) +The user name under whose authority OCI commands will be run. This field will +override the @code{user} field of @code{oci-configuration}. + +@item @code{group} (type: maybe-string) +The group name under whose authority OCI commands will be run. When +using the @code{'podman} OCI runtime, this field will be ignored and the +default group of the user configured in the @code{user} field will be used. +This field will override the @code{group} field of @code{oci-configuration}. + +@item @code{subuids-range} (type: maybe-subid-range) +An optional @code{subid-range} record allocating subuids for the user from +the @code{user} field. When unset, with the rootless Podman OCI runtime, it +defaults to @code{(subid-range (name "oci-container"))}. + +@item @code{subgids-range} (type: maybe-subid-range) +An optional @code{subid-range} record allocating subgids for the user from +the @code{user} field. When unset, with the rootless Podman OCI runtime, it +defaults to @code{(subid-range (name "oci-container"))}. + +@item @code{containers} (default: @code{'()}) (type: list-of-oci-containers) +The list of @code{oci-container-configuration} records representing the +containers to provision. Most users are supposed not to use this field and use +the @code{oci-extension} record instead. + +@item @code{networks} (default: @code{'()}) (type: list-of-oci-networks) +The list of @code{oci-network-configuration} records representing the +containers to provision. Most users are supposed not to use this field and use +the @code{oci-extension} record instead. + +@item @code{volumes} (default: @code{'()}) (type: list-of-oci-volumes) +The list of @code{oci-volumes-configuration} records representing the +containers to provision. Most users are supposed not to use this field and use +the @code{oci-extension} record instead. + +@item @code{verbose?} (default: @code{#f}) (type: boolean) +When true, additional output will be printed, allowing to better follow the +flow of execution. + +@end table + +@end deftp + + +@c %end of fragment + +@c %start of fragment + +@deftp {Data Type} oci-extension +Available @code{oci-extension} fields are: + +@table @asis +@item @code{containers} (default: @code{'()}) (type: list-of-oci-containers) +The list of @code{oci-container-configuration} records representing the +containers to provision. + +@item @code{networks} (default: @code{'()}) (type: list-of-oci-networks) +The list of @code{oci-network-configuration} records representing the +containers to provision. + +@item @code{volumes} (default: @code{'()}) (type: list-of-oci-volumes) +The list of @code{oci-volumes-configuration} records representing the +containers to provision. + +@end table + +@end deftp + + +@c %end of fragment + + @c %start of fragment @deftp {Data Type} oci-container-configuration @@ -42397,16 +42500,16 @@ Miscellaneous Services Overwrite the default entrypoint (@code{ENTRYPOINT}) of the image. @item @code{host-environment} (default: @code{'()}) (type: 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 +Set environment variables in the host environment where @command{docker run} +or @command{podman run} are invoked. This is especially useful to pass secrets +from the host to the container without having them on the OCI runtime command line, +for example: by setting the @code{MYSQL_PASSWORD} on the host and by passing @code{--env MYSQL_PASSWORD} through the @code{extra-arguments} field, it is possible to securely set values in the container environment. This field's value can be a list of pairs or strings, even mixed: @lisp -(list '("LANGUAGE\" . "eo:ca:eu") +(list '("LANGUAGE" . "eo:ca:eu") "JAVA_HOME=/opt/java") @end lisp @@ -42414,22 +42517,24 @@ Miscellaneous Services directly to @code{make-forkexec-constructor}. @item @code{environment} (default: @code{'()}) (type: list) -Set environment variables. This can be a list of pairs or strings, even mixed: +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 -@uref{https://docs.docker.com/engine/reference/commandline/run/#env,upstream} -documentation for semantics. +Pair members can be strings, gexps or file-like objects. Strings are passed +directly to the OCI runtime CLI. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run/#env,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#env-e-env,Podman} +upstream documentation for semantics. @item @code{image} (type: 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{oci-image} record. Strings are resolved by the OCI runtime, +and follow the usual format @code{myregistry.local:5000/testing/test-image:tag}. @item @code{provision} (default: @code{""}) (type: string) @@ -42457,7 +42562,7 @@ Miscellaneous Services by the service. @item @code{network} (default: @code{""}) (type: string) -Set a Docker network for the spawned container. +Set an OCI 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 @@ -42468,10 +42573,11 @@ Miscellaneous Services "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 -@uref{https://docs.docker.com/engine/reference/commandline/run/#publish,upstream} -documentation for semantics. +Pair members can be strings, gexps or file-like objects. Strings are passed +directly to the OCI runtime CLI. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run/#publish,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#publish-p-ip-hostport-containerport-protocol,Podman} +upstream documentation for semantics. @item @code{volumes} (default: @code{'()}) (type: list) Set volume mappings for the spawned container. This can be a @@ -42482,25 +42588,97 @@ Miscellaneous Services "/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 -@uref{https://docs.docker.com/engine/reference/commandline/run/#volume,upstream} -documentation for semantics. +Pair members can be strings, gexps or file-like objects. Strings are passed +directly to the OCI runtime CLI. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run/#volume,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#volume-v-source-volume-host-dir-container-dir-options,Podman} +upstream documentation for semantics. @item @code{container-user} (default: @code{""}) (type: 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. +@url{https://docs.docker.com/engine/reference/run/#user,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#user-u-user-group,Podman} +upstream documentation for semantics. @item @code{workdir} (default: @code{""}) (type: string) Set the current working directory for the spawned Shepherd service. You can refer to the -@url{https://docs.docker.com/engine/reference/run/#workdir,upstream} -documentation for semantics. +@url{https://docs.docker.com/engine/reference/run/#workdir,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#workdir-w-dir,Podman} +upstream documentation for semantics. + +@item @code{extra-arguments} (default: @code{'()}) (type: list) +A list of strings, gexps or file-like objects that will be directly passed +to the @command{docker run} or @command{podman run} invokation. + +@end table + +@end deftp + + +@c %end of fragment + +@c %start of fragment + +@deftp {Data Type} oci-network-configuration +Available @code{oci-network-configuration} fields are: + +@table @asis +@item @code{name} (type: string) +The name of the OCI network to provision. + +@item @code{driver} (type: maybe-string) +The driver to manage the network. + +@item @code{gateway} (type: maybe-string) +IPv4 or IPv6 gateway for the subnet. + +@item @code{internal?} (default: @code{#f}) (type: boolean) +Restrict external access to the network + +@item @code{ip-range} (type: maybe-string) +Allocate container ip from a sub-range in CIDR format. + +@item @code{ipam-driver} (type: maybe-string) +IP Address Management Driver. + +@item @code{ipv6?} (default: @code{#f}) (type: boolean) +Enable IPv6 networking. + +@item @code{subnet} (type: maybe-string) +Subnet in CIDR format that represents a network segment. + +@item @code{labels} (default: @code{'()}) (type: list) +The list of labels that will be used to tag the current volume. + +@item @code{extra-arguments} (default: @code{'()}) (type: list) +A list of strings, gexps or file-like objects that will be directly passed +to the @command{docker network create} or @command{podman network create} +invokation. + +@end table + +@end deftp + + +@c %end of fragment + +@c %start of fragment + +@deftp {Data Type} oci-volume-configuration +Available @code{oci-volume-configuration} fields are: + +@table @asis +@item @code{name} (type: string) +The name of the OCI volume to provision. + +@item @code{labels} (default: @code{'()}) (type: list) +The list of labels that will be used to tag the current volume. @item @code{extra-arguments} (default: @code{'()}) (type: list) -A list of strings, gexps or file-like objects that will be directly -passed to the @command{docker run} invocation. +A list of strings, gexps or file-like objects that will be directly passed +to the @command{docker volume create} or @command{podman volume create} +invokation. @end table diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm index 24f31c756b8..603eec25e2b 100644 --- a/gnu/services/containers.scm +++ b/gnu/services/containers.scm @@ -39,8 +39,10 @@ (define-module (gnu services containers) #:use-module (guix packages) #:use-module (guix profiles) #:use-module ((guix scripts pack) #:prefix pack:) + #:use-module (guix records) #:use-module (guix store) #:use-module (srfi srfi-1) + #:use-module (ice-9 format) #:use-module (ice-9 match) #:export (rootless-podman-configuration rootless-podman-configuration? @@ -96,8 +98,80 @@ (define-module (gnu services containers) oci-container-configuration-workdir oci-container-configuration-extra-arguments + list-of-oci-containers? + list-of-oci-networks? + list-of-oci-volumes? + + %oci-supported-runtimes + oci-sanitize-runtime + oci-runtime-system-environment + oci-runtime-system-extra-arguments + oci-runtime-system-group + oci-runtime-system-requirement + oci-runtime-cli + oci-runtime-system-cli + oci-runtime-home-cli + oci-runtime-name + oci-runtime-group + + oci-network-configuration + oci-network-configuration? + oci-network-configuration-fields + oci-network-configuration-name + oci-network-configuration-driver + oci-network-configuration-gateway + oci-network-configuration-internal? + oci-network-configuration-ip-range + oci-network-configuration-ipam-driver + oci-network-configuration-ipv6? + oci-network-configuration-subnet + oci-network-configuration-labels + oci-network-configuration-extra-arguments + + oci-volume-configuration + oci-volume-configuration? + oci-volume-configuration-fields + oci-volume-configuration-name + oci-volume-configuration-labels + oci-volume-configuration-extra-arguments + + oci-configuration + oci-configuration? + oci-configuration-runtime + oci-configuration-runtime-cli + oci-configuration-runtime-extra-arguments + oci-configuration-user + oci-configuration-group + oci-configuration-containers + oci-configuration-networks + oci-configuration-volumes + oci-configuration-verbose? + oci-configuration-valid? + + oci-extension + oci-extension? + oci-extension-fields + oci-extension-containers + oci-extension-networks + oci-extension-volumes + + oci-container-shepherd-name + oci-networks-shepherd-name + oci-networks-home-shepherd-name + oci-volumes-shepherd-name + oci-volumes-home-shepherd-name + oci-container-shepherd-service - %oci-container-accounts)) + oci-objects-merge-lst + oci-extension-merge + oci-service-extension-wrap-validate + oci-service-type + oci-service-accounts + oci-service-profile + oci-service-subids + oci-state->shepherd-services + oci-configuration->shepherd-services + oci-configuration-extend)) (define (gexp-or-string? value) (or (gexp? value) @@ -296,9 +370,42 @@ (define rootless-podman-service-type ;;; -;;; OCI container. +;;; OCI provisioning service. ;;; +(define %oci-supported-runtimes + '(docker podman)) + +(define (oci-runtime-system-requirement runtime) + "Return a list of Shepherd service names required by a given OCI runtime, +before it is able to run containers." + (if (eq? 'podman runtime) + '(cgroups2-fs-owner cgroups2-limits + rootless-podman-shared-root-fs user-processes) + '(dockerd user-processes))) + +(define (oci-runtime-name runtime) + "Return a human readable name for a given OCI runtime." + (if (eq? 'podman runtime) + "Podman" "Docker")) + +(define (oci-runtime-group runtime maybe-group) + "Implement the logic behind selection of the group that is to be used by +Shepherd to execute OCI commands." + (if (eq? maybe-group #f) + (if (eq? 'podman runtime) + "cgroup" + "docker") + maybe-group)) + +(define (oci-sanitize-runtime value) + (unless (member value %oci-supported-runtimes) + (raise + (formatted-message + (G_ "OCI runtime must be a symbol and one of ~a, +but ~a was found") %oci-supported-runtimes value))) + value) + (define (oci-sanitize-pair pair delimiter) (define (valid? member) (or (string? member) @@ -347,6 +454,11 @@ (define (oci-sanitize-volumes value) ;; '(("/mnt/dir" . "/dir") "/run/current-system/profile:/java") (oci-sanitize-mixed-list "volumes" value ":")) +(define (oci-sanitize-labels value) + ;; Expected spec format: + ;; '(("foo" . "bar") "foo=bar") + (oci-sanitize-mixed-list "labels" value "=")) + (define (oci-sanitize-shepherd-actions value) (map (lambda (el) @@ -374,10 +486,15 @@ (define (oci-sanitize-extra-arguments value) value)) (define (oci-image-reference image) - (if (string? image) - image - (string-append (oci-image-repository image) - ":" (oci-image-tag image)))) + "Return a string OCI image reference representing IMAGE." + (define reference + (if (string? image) + image + (string-append (oci-image-repository image) + ":" (oci-image-tag image)))) + (if (> (length (string-split reference #\/)) 1) + reference + (string-append "localhost/" reference))) (define (oci-lowerable-image? image) (or (manifest? image) @@ -392,7 +509,19 @@ (define (string-or-oci-image? image) (define list-of-symbols? (list-of symbol?)) +(define (list-of-oci-records? name predicate value) + (map + (lambda (el) + (if (predicate el) + el + (raise + (formatted-message + (G_ "~a contains an illegal value: ~a") name el)))) + value)) + (define-maybe/no-serialization string) +(define-maybe/no-serialization package) +(define-maybe/no-serialization subid-range) (define-configuration/no-serialization oci-image (repository @@ -437,11 +566,15 @@ (define-configuration/no-serialization oci-image (define-configuration/no-serialization oci-container-configuration (user - (string "oci-container") - "The user under whose authority docker commands will be run.") + (maybe-string) + "The user name under whose authority OCI commands will be run. This field will +override the @code{user} field of @code{oci-configuration}.") (group - (string "docker") - "The group under whose authority docker commands will be run.") + (maybe-string) + "The group name under whose authority OCI commands will be run. When +using the @code{'podman} OCI runtime, this field will be ignored and the +default group of the user configured in the @code{user} field will be used. +This field will override the @code{group} field of @code{oci-configuration}.") (command (list-of-strings '()) "Overwrite the default command (@code{CMD}) of the image.") @@ -451,9 +584,9 @@ (define-configuration/no-serialization oci-container-configuration (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 +or @command{podman run} are invoked. This is especially useful to pass secrets +from the host to the container without having them on the OCI runtime command line, +for example: by setting the @code{MYSQL_PASSWORD} on the host and by passing @code{--env MYSQL_PASSWORD} through the @code{extra-arguments} field, it is possible to securely set values in the container environment. This field's value can be a list of pairs or strings, even mixed: @@ -477,15 +610,16 @@ (define-configuration/no-serialization oci-container-configuration @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." +directly to the OCI runtime CLI. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run/#env,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#env-e-env,Podman} +upstream documentation for semantics." (sanitizer oci-sanitize-environment)) (image (string-or-oci-image) "The image used to build the container. It can be a string or an -@code{oci-image} record. Strings are resolved by the Docker -Engine, and follow the usual format +@code{oci-image} record. Strings are resolved by the OCI runtime, +and follow the usual format @code{myregistry.local:5000/testing/test-image:tag}.") (provision (maybe-string) @@ -514,7 +648,7 @@ (define-configuration/no-serialization oci-container-configuration (sanitizer oci-sanitize-shepherd-actions)) (network (maybe-string) - "Set a Docker network for the spawned container.") + "Set an OCI network for the spawned container.") (ports (list '()) "Set the port or port ranges to expose from the spawned container. This can @@ -526,9 +660,10 @@ (define-configuration/no-serialization oci-container-configuration @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." +directly to the OCI runtime CLI. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run/#publish,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#publish-p-ip-hostport-containerport-protocol,Podman} +upstream documentation for semantics." (sanitizer oci-sanitize-ports)) (volumes (list '()) @@ -541,71 +676,363 @@ (define-configuration/no-serialization oci-container-configuration @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." +directly to the OCI runtime CLI. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run/#volume,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#volume-v-source-volume-host-dir-container-dir-options,Podman} +upstream documentation for semantics." (sanitizer oci-sanitize-volumes)) (container-user (maybe-string) "Set the current user inside the spawned container. You can refer to the -@url{https://docs.docker.com/engine/reference/run/#user,upstream} -documentation for semantics.") +@url{https://docs.docker.com/engine/reference/run/#user,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#user-u-user-group,Podman} +upstream documentation for semantics.") (workdir (maybe-string) - "Set the current working for the spawned Shepherd service. + "Set the current working directory for the spawned Shepherd service. You can refer to the -@url{https://docs.docker.com/engine/reference/run/#workdir,upstream} -documentation for semantics.") +@url{https://docs.docker.com/engine/reference/run/#workdir,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#workdir-w-dir,Podman} +upstream documentation for semantics.") (extra-arguments (list '()) "A list of strings, gexps or file-like objects that will be directly passed -to the @command{docker run} invokation." +to the @command{docker run} or @command{podman 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 (list-of-oci-containers? value) + (list-of-oci-records? "containers" oci-container-configuration? value)) + +(define-configuration/no-serialization oci-volume-configuration + (name + (string) + "The name of the OCI volume to provision.") + (labels + (list '()) + "The list of labels that will be used to tag the current volume." + (sanitizer oci-sanitize-labels)) + (extra-arguments + (list '()) + "A list of strings, gexps or file-like objects that will be directly passed +to the @command{docker volume create} or @command{podman volume create} +invocation." + (sanitizer oci-sanitize-extra-arguments))) + +(define (list-of-oci-volumes? value) + (list-of-oci-records? "volumes" oci-volume-configuration? value)) + +(define-configuration/no-serialization oci-network-configuration + (name + (string) + "The name of the OCI network to provision.") + (driver + (maybe-string) + "The driver to manage the network.") + (gateway + (maybe-string) + "IPv4 or IPv6 gateway for the subnet.") + (internal? + (boolean #f) + "Restrict external access to the network") + (ip-range + (maybe-string) + "Allocate container ip from a sub-range in CIDR format.") + (ipam-driver + (maybe-string) + "IP Address Management Driver.") + (ipv6? + (boolean #f) + "Enable IPv6 networking.") + (subnet + (maybe-string) + "Subnet in CIDR format that represents a network segment.") + (labels + (list '()) + "The list of labels that will be used to tag the current volume." + (sanitizer oci-sanitize-labels)) + (extra-arguments + (list '()) + "A list of strings, gexps or file-like objects that will be directly passed +to the @command{docker network create} or @command{podman network create} +invocation." + (sanitizer oci-sanitize-extra-arguments))) + +(define (list-of-oci-networks? value) + (list-of-oci-records? "networks" oci-network-configuration? value)) + +(define-record-type* + oci-configuration + make-oci-configuration + oci-configuration? + this-oci-configuration + + (runtime oci-configuration-runtime + (default 'docker)) + (runtime-cli oci-configuration-runtime-cli + (default #f)) ; package or string + (runtime-extra-arguments oci-configuration-runtime-extra-arguments ; strings or gexps + (default '())) ; or file-like objects + (user oci-configuration-user + (default "oci-container")) + (group oci-configuration-group ; string + (default #f)) + (subuids-range oci-configuration-subuids-range ; subid-range + (default #f)) + (subgids-range oci-configuration-subgids-range ; subid-range + (default #f)) + (containers oci-configuration-containers ; oci-container-configurations + (default '())) + (networks oci-configuration-networks ; oci-network-configurations + (default '())) + (volumes oci-configuration-volumes ; oci-volume-configurations + (default '())) + (verbose? oci-configuration-verbose? + (default #f)) + (home-service? oci-configuration-home-service? + (default for-home?) (innate))) + +(define (package-or-string? value) + (or (package? value) (string? value))) + +(define (oci-configuration-valid? config) + (define runtime-cli + (oci-configuration-runtime-cli config)) + (define group + (oci-configuration-group config)) + (define subuids-range + (oci-configuration-subuids-range config)) + (define subgids-range + (oci-configuration-subgids-range config)) + (and + (symbol? + (oci-sanitize-runtime (oci-configuration-runtime config))) + (or (eq? runtime-cli #f) + (package-or-string? runtime-cli)) + (list? (oci-configuration-runtime-extra-arguments config)) + (string? (oci-configuration-user config)) + (or (eq? group #f) + (string? group)) + (or (eq? subuids-range #f) + (subid-range? subuids-range)) + (or (eq? subgids-range #f) + (subid-range? subgids-range)) + (list-of-oci-containers? + (oci-configuration-containers config)) + (list-of-oci-networks? + (oci-configuration-networks config)) + (list-of-oci-volumes? + (oci-configuration-volumes config)) + (boolean? + (oci-configuration-verbose? config)) + (boolean? + (oci-configuration-home-service? config)))) + +(define (oci-runtime-system-environment runtime user) + (if (eq? runtime 'podman) + (list + #~(string-append + "HOME=" (passwd:dir (getpwnam #$user)))) + #~())) + +(define (oci-runtime-system-group runtime user group) + (if (eq? runtime 'podman) + #~(group:name + (getgrgid + (passwd:gid + (getpwnam #$user)))) + group)) + +(define (oci-runtime-cli runtime runtime-cli path) + "Return a gexp that, when lowered, evaluates to the file system path of the OCI +runtime command requested by the user." + (if (string? runtime-cli) + ;; It is a user defined absolute path + runtime-cli + #~(string-append + #$(if (eq? runtime-cli #f) + path + runtime-cli) + #$(if (eq? 'podman runtime) + "/bin/podman" + "/bin/docker")))) + +(define* (oci-runtime-system-cli config #:key (path "/run/current-system/profile")) + (let ((runtime-cli + (oci-configuration-runtime-cli config)) + (runtime + (oci-configuration-runtime config))) + (oci-runtime-cli runtime runtime-cli path))) + +(define (oci-runtime-home-cli config) + (let ((runtime-cli + (oci-configuration-runtime-cli config)) + (runtime + (oci-configuration-runtime config))) + (oci-runtime-cli runtime runtime-cli + (string-append (getenv "HOME") + "/.guix-home/profile")))) + +(define-configuration/no-serialization oci-extension + (containers + (list-of-oci-containers '()) + "The list of @code{oci-container-configuration} records representing the +containers to add.") + (networks + (list-of-oci-networks '()) + "The list of @code{oci-network-configuration} records representing the +networks to add.") + (volumes + (list-of-oci-volumes '()) + "The list of @code{oci-volume-configuration} records representing the +volumes to add.")) + +(define (oci-image->container-name image) + "Infer the name of an OCI backed Shepherd service from its OCI image." + (basename + (if (string? image) + (first (string-split image #\:)) + (oci-image-repository image)))) + +(define (oci-object-command-shepherd-action object-name invokation) + "Return a Shepherd action printing a given INVOKATION of an OCI command for the +given OBJECT-NAME." + (shepherd-action + (name 'command-line) + (documentation + (format #f "Prints ~a's OCI runtime command line invocation." + object-name)) + (procedure + #~(lambda _ + (format #t "~a~%" #$invokation))))) + +(define (oci-container-shepherd-name runtime config) + "Return the name of an OCI backed Shepherd service based on CONFIG. +The name configured in the configuration record is returned when +CONFIG's name field has a value, otherwise a name is inferred from CONFIG's +image field." + (define name (oci-container-configuration-provision config)) + (define image (oci-container-configuration-image config)) + + (if (maybe-value-set? name) + name + (string-append (symbol->string runtime) "-" + (oci-image->container-name image)))) + +(define (oci-networks-shepherd-name runtime) + "Return the name of the OCI networks provisioning Shepherd service based on +RUNTIME." + (string-append (symbol->string runtime) "-networks")) + +(define (oci-volumes-shepherd-name runtime) + "Return the name of the OCI volumes provisioning Shepherd service based on +RUNTIME." + (string-append (symbol->string runtime) "-volumes")) + +(define (oci-networks-home-shepherd-name runtime) + "Return the name of the OCI volumes provisioning Home Shepherd service based on +RUNTIME." + (string-append "home-" (oci-networks-shepherd-name runtime))) + +(define (oci-volumes-home-shepherd-name runtime) + "Return the name of the OCI volumes provisioning Home Shepherd service based on +RUNTIME." + (string-append "home-" (oci-volumes-shepherd-name runtime))) + +(define (oci-container-configuration->options config) + "Map CONFIG, an oci-container-configuration record, to a gexp that, upon +lowering, will be evaluated to a list of strings containing command line options +for the OCI runtime run command." + (let ((entrypoint + (oci-container-configuration-entrypoint config)) + (network + (oci-container-configuration-network config)) + (user + (oci-container-configuration-container-user config)) + (workdir + (oci-container-configuration-workdir config))) + (apply append + (filter (compose not unspecified?) + `(,(if (maybe-value-set? entrypoint) + `("--entrypoint" ,entrypoint) + '()) + ,(append-map + (lambda (spec) + (list "--env" spec)) + (oci-container-configuration-environment config)) + ,(if (maybe-value-set? network) + `("--network" ,network) + '()) + ,(if (maybe-value-set? user) + `("--user" ,user) + '()) + ,(if (maybe-value-set? workdir) + `("--workdir" ,workdir) + '()) + ,(append-map + (lambda (spec) + (list "-p" spec)) + (oci-container-configuration-ports config)) + ,(append-map + (lambda (spec) + (list "-v" spec)) + (oci-container-configuration-volumes config))))))) + +(define (oci-network-configuration->options config) + "Map CONFIG, an oci-network-configuration record, to a gexp that, upon +lowering, will be evaluated to a list of strings containing command line options +for the OCI runtime network create command." + (let ((driver (oci-network-configuration-driver config)) + (gateway + (oci-network-configuration-gateway config)) + (internal? + (oci-network-configuration-internal? config)) + (ip-range + (oci-network-configuration-ip-range config)) + (ipam-driver + (oci-network-configuration-ipam-driver config)) + (ipv6? + (oci-network-configuration-ipv6? config)) + (subnet + (oci-network-configuration-subnet config))) + (apply append + (filter (compose not unspecified?) + `(,(if (maybe-value-set? driver) + `("--driver" ,driver) + '()) + ,(if (maybe-value-set? gateway) + `("--gateway" ,gateway) + '()) + ,(if internal? + `("--internal") + '()) + ,(if (maybe-value-set? ip-range) + `("--ip-range" ,ip-range) + '()) + ,(if (maybe-value-set? ipam-driver) + `("--ipam-driver" ,ipam-driver) + '()) + ,(if ipv6? + `("--ipv6") + '()) + ,(if (maybe-value-set? subnet) + `("--subnet" ,subnet) + '()) + ,(append-map + (lambda (spec) + (list "--label" spec)) + (oci-network-configuration-labels config))))))) + +(define (oci-volume-configuration->options config) + "Map CONFIG, an oci-volume-configuration record, to a gexp that, upon +lowering, will be evaluated to a list of strings containing command line options +for the OCI runtime volume create command." + (append-map + (lambda (spec) + (list "--label" spec)) + (oci-volume-configuration-labels config))) (define (lower-operating-system os target system) + "Lower OS, an operating-system record, into a tarball containing an OCI image." (mlet* %store-monad ((tarball (lower-object @@ -614,24 +1041,11 @@ (define (lower-operating-system os target 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))))) - +(define (lower-manifest name value options image-reference + target system grafts?) + "Lower VALUE, a manifest record, into a tarball containing an OCI image." (mlet* %store-monad - ((_ (set-grafting - (oci-image-grafts? image))) + ((_ (set-grafting grafts?)) (guile (set-guile-for-build (default-guile))) (profile (profile-derivation value @@ -642,14 +1056,11 @@ (define (lower-manifest name image target system) (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 (lower-oci-image-state name value options reference + image-target image-system grafts?) (define target (if (maybe-value-set? image-target) image-target @@ -662,7 +1073,8 @@ (define (lower-oci-image name image) (run-with-store store (match value ((? manifest? value) - (lower-manifest name image target system)) + (lower-manifest name value options reference + target system grafts?)) ((? operating-system? value) (lower-operating-system value target system)) ((or (? gexp? value) @@ -677,113 +1089,665 @@ (define (lower-oci-image name image) #: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))) +(define (lower-oci-image name image) + "Lower IMAGE, a oci-image record, into a tarball containing an OCI image." + (lower-oci-image-state + name + (oci-image-value image) + (oci-image-pack-options image) + (oci-image-reference image) + (oci-image-target image) + (oci-image-system image) + (oci-image-grafts? image))) + +(define (oci-object-exists? runtime runtime-cli object verbose?) + #~(lambda* (name #:key (format-string "{{.Name}}")) + (use-modules (ice-9 format) + (ice-9 match) + (ice-9 popen) + (ice-9 rdelim) + (srfi srfi-1)) + + (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))) + + #$(if (eq? runtime 'podman) + #~(let ((command + (list #$runtime-cli + #$object "exists" name))) + (when #$verbose? + (format #t "Running~{ ~a~}~%" command)) + (define exit-code (status:exit-val (apply system* command))) + (when #$verbose? + (format #t "Exit code: ~a~%" exit-code)) + (equal? EXIT_SUCCESS exit-code)) + #~(let ((command + (string-append #$runtime-cli + " " #$object " ls --format " + "\"" format-string "\""))) + (when #$verbose? + (format #t "Running ~a~%" command)) + (member name (read-lines (open-input-pipe command))))))) + +(define* (oci-image-loader runtime runtime-cli name image tag #:key (verbose? #f)) + "Return a file-like object that, once lowered, will evaluate to a program able +to load IMAGE through RUNTIME-CLI and to tag it with TAG afterwards." + (let ((tarball (lower-oci-image name image))) (with-imported-modules '((guix build utils)) - (program-file (format #f "~a-image-loader" name) + (program-file + (format #f "~a-image-loader" name) #~(begin (use-modules (guix build utils) + (ice-9 match) (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)) + (ice-9 rdelim) + (srfi srfi-1)) + (define object-exists? + #$(oci-object-exists? runtime runtime-cli "image" verbose?)) + (define load-command + (string-append #$runtime-cli + " load -i " #$tarball)) + + (if (object-exists? #$tag #:format-string "{{.Repository}}:{{.Tag}}") + (format #t "~a image already exists, skipping.~%" #$tag) + (begin + (format #t "Loading image for ~a from ~a...~%" #$name #$tarball) + (when #$verbose? + (format #t "Running ~a~%" load-command)) + (let ((line (read-line + (open-input-pipe load-command)))) + (unless (or (eof-object? line) + (string-null? line)) + (format #t "~a~%" line) + (let* ((repository&tag + (string-drop line + (string-length + "Loaded image: "))) + (tag-command + (list #$runtime-cli "tag" repository&tag #$tag)) + (drop-old-tag-command + (list #$runtime-cli "image" "rm" "-f" repository&tag))) + + (unless (string=? repository&tag #$tag) + (when #$verbose? + (format #t "Running~{ ~a~}~%" tag-command)) + + (let ((exit-code + (status:exit-val (apply system* tag-command)))) + (format #t "Tagged ~a with ~a...~%" #$tarball #$tag) + + (when #$verbose? + (format #t "Exit code: ~a~%" exit-code)) + + (when (equal? EXIT_SUCCESS exit-code) + (when #$verbose? + (format #t "Running~{ ~a~}~%" drop-old-tag-command)) + (let ((drop-exit-code + (status:exit-val (apply system* drop-old-tag-command)))) + (when #$verbose? + (format #t "Exit code: ~a~%" drop-exit-code)))))))))))))))) + +(define (oci-container-run-invokation runtime-cli name command image-reference + options runtime-extra-arguments run-extra-arguments) + "Return a list representing the OCI runtime +invocation for running containers." + ;; run [OPTIONS] IMAGE [COMMAND] [ARG...] + `(,runtime-cli ,@runtime-extra-arguments "run" + "--rm" "--name" ,name + ,@options ,@run-extra-arguments + ,image-reference ,@command)) + +(define* (oci-container-entrypoint runtime runtime-cli name image image-reference + invokation #:key (verbose? #f)) + "Return a file-like object that, once lowered, will evaluate to the entrypoint +for the Shepherd service that will run IMAGE through RUNTIME-CLI." + (program-file + (string-append "oci-entrypoint-" name) + #~(begin + (use-modules (ice-9 format) + (srfi srfi-1)) + (when #$verbose? + (format #t "Running in verbose mode...~%")) + (define invokation (list #$@invokation)) + #$@(if (oci-image? image) + #~((system* + #$(oci-image-loader + runtime runtime-cli name image + image-reference #:verbose? verbose?))) + #~()) + (when #$verbose? + (format #t "Running~{ ~a~}~%" invokation)) + (apply execlp `(,(first invokation) ,@invokation))))) + +(define* (oci-container-shepherd-service runtime runtime-cli config + #:key + (runtime-environment #~()) + (runtime-extra-arguments '()) + (oci-requirement '()) + (user #f) + (group #f) + (verbose? #f)) + "Return a Shepherd service object that will run the OCI container represented +by CONFIG through RUNTIME-CLI." + (let* ((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)) + (maybe-user (oci-container-configuration-user config)) + (maybe-group (oci-container-configuration-group config)) + (user (if (maybe-value-set? maybe-user) + maybe-user + user)) + (group (if (maybe-value-set? maybe-group) + maybe-group + group)) (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)) + (name + (oci-container-shepherd-name runtime config)) (extra-arguments - (oci-container-configuration-extra-arguments config))) + (oci-container-configuration-extra-arguments config)) + (invokation + (oci-container-run-invokation + runtime-cli name command image-reference + options runtime-extra-arguments extra-arguments)) + (wrap-command + (lambda (command) + (if (eq? runtime 'podman) + (list + "/bin/sh" "-l" "-c" + #~(string-join (list #$@command) " ")) + command))) + (container-action + (lambda* (command #:key (environment-variables #f)) + #~(lambda _ + (fork+exec-command + (list #$@command) + #$@(if user (list #:user user) '()) + #$@(if group (list #:group group) '()) + #$@(if (maybe-value-set? log-file) + (list #:log-file log-file) + '()) + #$@(if (and user (eq? runtime 'podman)) + (list #:directory + #~(passwd:dir (getpwnam #$user))) + '()) + #$@(if environment-variables + (list #:environment-variables + environment-variables) + '())))))) (shepherd-service (provision `(,(string->symbol name))) - (requirement `(dockerd user-processes ,@requirement)) + (requirement `(,@oci-requirement + ,@requirement)) (respawn? respawn?) (auto-start? auto-start?) (documentation (string-append - "Docker backed Shepherd service for " + (oci-runtime-name runtime) " 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)))) + (container-action + (list (oci-container-entrypoint + runtime runtime-cli name image image-reference + invokation #:verbose? verbose?)) + #:environment-variables + #~(append + (list #$@host-environment) + (list #$@runtime-environment)))) (stop - #~(lambda _ - (invoke #$docker "rm" "-f" #$name))) + (container-action + (wrap-command + (list runtime-cli "rm" "-f" name)))) (actions - (if (oci-image? image) - '() - (append + (append + (list + (oci-object-command-shepherd-action + name #~(string-join (list #$@invokation) " "))) + (if (oci-image? image) + '() (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 + (let ((service-name name)) + (shepherd-action + (name 'pull) + (documentation + (format #f "Pull ~a's image (~a)." + service-name image)) + (procedure + (container-action + (wrap-command + (list runtime-cli "pull" image)))))))) + actions))))) + +(define (oci-object-create-invokation object runtime-cli name options + runtime-extra-arguments + create-extra-arguments) + "Return a gexp that, upon lowering, will evaluate to the OCI runtime +invocation for creating networks and volumes." + ;; network|volume create [options] [NAME] + #~(list #$runtime-cli #$@runtime-extra-arguments #$object "create" + #$@options #$@create-extra-arguments #$name)) + +(define (format-oci-invokations invokations) + "Return a gexp that, upon lowering, will evaluate to a formatted message +containing the INVOKATIONS that the OCI runtime will execute to provision +networks or volumes." + #~(string-join (map (lambda (i) (string-join i " ")) + (list #$@invokations)) + "\n")) + +(define* (oci-object-create-script object runtime runtime-cli invokations + #:key (verbose? #f)) + "Return a file-like object that, once lowered, will evaluate to a program able +to create OCI networks and volumes through RUNTIME-CLI." + (define runtime-string (symbol->string runtime)) + (program-file + (string-append runtime-string "-" object "s-create.scm") + #~(begin + (use-modules (ice-9 format) + (ice-9 match) + (ice-9 popen) + (ice-9 rdelim) + (srfi srfi-1)) + + (define object-exists? + #$(oci-object-exists? runtime runtime-cli object verbose?)) + + (for-each + (lambda (invokation) + (define name (last invokation)) + (if (object-exists? name) + (format #t "~a ~a ~a already exists, skipping creation.~%" + #$(oci-runtime-name runtime) name #$object) + (begin + (when #$verbose? + (format #t "Running~{ ~a~}~%" invokation)) + (let ((exit-code (status:exit-val (apply system* invokation)))) + (when #$verbose? + (format #t "Exit code: ~a~%" exit-code)))))) + (list #$@invokations))))) + +(define* (oci-object-shepherd-service object runtime runtime-cli name requirement invokations + #:key + (runtime-environment #~()) + (user #f) + (group #f) + (verbose? #f)) + "Return a Shepherd service object that will create the OBJECTs represented +by INVOKATIONS through RUNTIME-CLI." + (shepherd-service (provision `(,(string->symbol name))) + (requirement requirement) + (one-shot? #t) + (documentation + (string-append + (oci-runtime-name runtime) " " object + " provisioning service")) + (start + #~(lambda _ + (fork+exec-command + (list + #$(oci-object-create-script + object runtime runtime-cli + invokations + #:verbose? verbose?)) + #$@(if user (list #:user user) '()) + #$@(if group (list #:group group) '()) + #:environment-variables + (list #$@runtime-environment)))) + (actions + (list + (oci-object-command-shepherd-action + name (format-oci-invokations invokations)))))) + +(define* (oci-networks-shepherd-service runtime runtime-cli name networks + #:key (user #f) (group #f) (verbose? #f) + (runtime-extra-arguments '()) + (runtime-environment #~()) + (runtime-requirement '())) + "Return a Shepherd service object that will create the networks represented +in CONFIG." + (let ((invokations + (map + (lambda (network) + (oci-object-create-invokation + "network" runtime-cli + (oci-network-configuration-name network) + (oci-network-configuration->options network) + runtime-extra-arguments + (oci-network-configuration-extra-arguments network))) + networks))) + + (oci-object-shepherd-service + "network" runtime runtime-cli name + runtime-requirement invokations + #:user user #:group group #:runtime-environment runtime-environment + #:verbose? verbose?))) + +(define* (oci-volumes-shepherd-service runtime runtime-cli name volumes + #:key (user #f) (group #f) (verbose? #f) + (runtime-extra-arguments '()) + (runtime-environment #~()) + (runtime-requirement '())) + "Return a Shepherd service object that will create the volumes represented +in CONFIG." + (let ((invokations + (map + (lambda (volume) + (oci-object-create-invokation + "volume" runtime-cli + (oci-volume-configuration-name volume) + (oci-volume-configuration->options volume) + runtime-extra-arguments + (oci-volume-configuration-extra-arguments volume))) + volumes))) + + (oci-object-shepherd-service + "volume" runtime runtime-cli name runtime-requirement invokations + #:user user #:group group #:runtime-environment runtime-environment + #:verbose? verbose?))) + +(define (oci-service-accounts config) + (define user (oci-configuration-user config)) + (define maybe-group (oci-configuration-group config)) + (define runtime (oci-configuration-runtime config)) (list (user-account - (name "oci-container") + (name user) (comment "OCI services account") - (group "docker") - (system? #t) - (home-directory "/var/empty") + (group "users") + (supplementary-groups + (list (oci-runtime-group runtime maybe-group))) + (system? (eq? 'docker runtime)) + (home-directory (if (eq? 'podman runtime) + (string-append "/home/" user) + "/var/empty")) + (create-home-directory? (eq? 'podman runtime)) (shell (file-append shadow "/sbin/nologin"))))) + +(define* (oci-state->shepherd-services runtime runtime-cli containers networks volumes + #:key (user #f) (group #f) (verbose? #f) + (networks-name #f) (volumes-name #f) + (runtime-extra-arguments '()) + (runtime-environment #~()) + (runtime-requirement '()) + (containers-requirement '()) + (networks-requirement '()) + (volumes-requirement '())) + "Returns a list of Shepherd services based on the input OCI state." + (let* ((networks-name + (if (string? networks-name) + networks-name + (oci-networks-shepherd-name runtime))) + (networks? + (> (length networks) 0)) + (networks-service + (if networks? + (list + (string->symbol networks-name)) + '())) + (volumes-name + (if (string? volumes-name) + volumes-name + (oci-volumes-shepherd-name runtime))) + (volumes? + (> (length volumes) 0)) + (volumes-service + (if volumes? + (list (string->symbol volumes-name)) + '()))) + (append + (map + (lambda (c) + (oci-container-shepherd-service + runtime runtime-cli c + #:user user + #:group group + #:runtime-environment runtime-environment + #:runtime-extra-arguments runtime-extra-arguments + #:oci-requirement + (append containers-requirement + runtime-requirement + networks-service + volumes-service) + #:verbose? verbose?)) + containers) + (if networks? + (list + (oci-networks-shepherd-service + runtime runtime-cli + networks-name networks + #:user user #:group group + #:runtime-extra-arguments runtime-extra-arguments + #:runtime-environment runtime-environment + #:runtime-requirement (append networks-requirement + runtime-requirement) + #:verbose? verbose?)) + '()) + (if volumes? + (list + (oci-volumes-shepherd-service + runtime runtime-cli + volumes-name volumes + #:user user #:group group + #:runtime-extra-arguments runtime-extra-arguments + #:runtime-environment runtime-environment + #:runtime-requirement (append runtime-requirement + volumes-requirement) + #:verbose? verbose?)) + '())))) + +(define (oci-configuration->shepherd-services config) + (let* ((runtime (oci-configuration-runtime config)) + (system-runtime-cli + (oci-runtime-system-cli config)) + (home-runtime-cli + (oci-runtime-home-cli config)) + (runtime-extra-arguments + (oci-configuration-runtime-extra-arguments config)) + (containers (oci-configuration-containers config)) + (networks (oci-configuration-networks config)) + (volumes (oci-configuration-volumes config)) + (user (oci-configuration-user config)) + (group (oci-runtime-group + runtime (oci-configuration-group config))) + (verbose? (oci-configuration-verbose? config)) + (home-service? + (oci-configuration-home-service? config))) + (if home-service? + (oci-state->shepherd-services runtime home-runtime-cli containers networks volumes + #:verbose? verbose? + #:networks-name + (oci-networks-home-shepherd-name runtime) + #:volumes-name + (oci-volumes-home-shepherd-name runtime)) + (oci-state->shepherd-services runtime system-runtime-cli containers networks volumes + #:user user + #:group + (oci-runtime-system-group runtime user group) + #:verbose? verbose? + #:runtime-extra-arguments + runtime-extra-arguments + #:runtime-environment + (oci-runtime-system-environment runtime user) + #:runtime-requirement + (oci-runtime-system-requirement runtime) + #:networks-requirement '(networking))))) + +(define (oci-service-subids config) + "Return a subids-extension record representing subuids and subgids required by +the rootless Podman backend." + (define (delete-duplicate-ranges ranges) + (delete-duplicates ranges + (lambda args + (apply string=? (map subid-range-name ranges))))) + (define runtime + (oci-configuration-runtime config)) + (define user + (oci-configuration-user config)) + (define subgids (oci-configuration-subgids-range config)) + (define subuids (oci-configuration-subuids-range config)) + (define container-users + (filter (lambda (range) + (and (maybe-value-set? + (subid-range-name range)) + (not (string=? (subid-range-name range) user)))) + (map (lambda (container) + (subid-range + (name + (oci-container-configuration-user container)))) + (oci-configuration-containers config)))) + (define subgid-ranges + (delete-duplicate-ranges + (cons + (if (eq? subgids #f) + (subid-range (name user)) + subgids) + container-users))) + (define subuid-ranges + (delete-duplicate-ranges + (cons + (if (eq? subuids #f) + (subid-range (name user)) + subuids) + container-users))) + + (if (eq? 'podman runtime) + (subids-extension + (subgids + subgid-ranges) + (subuids + subuid-ranges)) + (subids-extension))) + +(define (oci-objects-merge-lst a b object get-name) + (define (contains? value lst) + (member value (map get-name lst))) + (let loop ((merged '()) + (lst (append a b))) + (if (null? lst) + merged + (loop + (let ((element (car lst))) + (when (contains? element merged) + (raise + (formatted-message + (G_ "Duplicated ~a: ~a. ~as names should be unique, please +remove the duplicate.") object (get-name element) object))) + (cons element merged)) + (cdr lst))))) + +(define (oci-extension-merge a b) + (oci-extension + (containers (oci-objects-merge-lst + (oci-extension-containers a) + (oci-extension-containers b) + "container" + (lambda (config) + (define maybe-name (oci-container-configuration-provision config)) + (if (maybe-value-set? maybe-name) + maybe-name + (oci-image->container-name + (oci-container-configuration-image config)))))) + (networks (oci-objects-merge-lst + (oci-extension-networks a) + (oci-extension-networks b) + "network" + oci-network-configuration-name)) + (volumes (oci-objects-merge-lst + (oci-extension-volumes a) + (oci-extension-volumes b) + "volume" + oci-volume-configuration-name)))) + +(define (oci-service-profile runtime runtime-cli) + `(,bash-minimal + ,@(if (string? runtime-cli) + '() + (list + (cond + ((not (eq? runtime-cli #f)) + runtime-cli) + ((eq? 'podman runtime) + podman) + (else + docker-cli)))))) + +(define (oci-service-extension-wrap-validate extension) + (lambda (config) + (if (oci-configuration-valid? config) + (extension config) + (raise + (formatted-message + (G_ "Invalide oci-configuration ~a.") config))))) + +(define (oci-configuration-extend config extension) + (oci-configuration + (inherit config) + (containers + (oci-objects-merge-lst + (oci-configuration-containers config) + (oci-extension-containers extension) + "container" + (lambda (oci-config) + (define runtime + (oci-configuration-runtime config)) + (oci-container-shepherd-name runtime oci-config)))) + (networks (oci-objects-merge-lst + (oci-configuration-networks config) + (oci-extension-networks extension) + "network" + oci-network-configuration-name)) + (volumes (oci-objects-merge-lst + (oci-configuration-volumes config) + (oci-extension-volumes extension) + "volume" + oci-volume-configuration-name)))) + +(define oci-service-type + (service-type (name 'oci) + (extensions + (list + (service-extension profile-service-type + (oci-service-extension-wrap-validate + (lambda (config) + (let ((runtime-cli + (oci-configuration-runtime-cli config)) + (runtime + (oci-configuration-runtime config))) + (oci-service-profile runtime runtime-cli))))) + (service-extension subids-service-type + (oci-service-extension-wrap-validate + oci-service-subids)) + (service-extension account-service-type + (oci-service-extension-wrap-validate + oci-service-accounts)) + (service-extension shepherd-root-service-type + (oci-service-extension-wrap-validate + oci-configuration->shepherd-services)))) + ;; Concatenate OCI object lists. + (compose (lambda (args) + (fold oci-extension-merge + (oci-extension) + args))) + (extend oci-configuration-extend) + (default-value (oci-configuration)) + (description + "This service implements the provisioning of OCI object such +as containers, networks and volumes."))) diff --git a/gnu/services/docker.scm b/gnu/services/docker.scm index 828ceea313a..125e748bb0e 100644 --- a/gnu/services/docker.scm +++ b/gnu/services/docker.scm @@ -31,7 +31,10 @@ (define-module (gnu services docker) #:use-module (gnu system shadow) #:use-module (gnu packages docker) #:use-module (gnu packages linux) ;singularity + #:use-module (guix deprecation) + #:use-module (guix diagnostics) #:use-module (guix gexp) + #:use-module (guix i18n) #:use-module (guix records) #:use-module (srfi srfi-1) #:use-module (ice-9 format) @@ -67,16 +70,18 @@ (define-module (gnu services docker) 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) + oci-container-configuration-extra-arguments) #:export (containerd-configuration containerd-service-type docker-configuration docker-service-type singularity-service-type - oci-container-service-type)) + ;; for backwards compatibility, until the + ;; oci-container-service-type is fully deprecated + oci-container-shepherd-service + oci-container-service-type + %oci-container-accounts)) (define-maybe file-like) @@ -297,17 +302,25 @@ (define singularity-service-type ;;; OCI container. ;;; -(define (configs->shepherd-services configs) - (map oci-container-shepherd-service configs)) +;; for backwards compatibility, until the +;; oci-container-service-type is fully deprecated +(define-deprecated (oci-container-shepherd-service config) + oci-service-type + ((@ (gnu services containers) oci-container-shepherd-service) + 'docker config)) +(define %oci-container-accounts + (filter user-account? (oci-service-accounts (oci-configuration)))) (define oci-container-service-type (service-type (name 'oci-container) - (extensions (list (service-extension profile-service-type - (lambda _ (list docker-cli))) - (service-extension account-service-type - (const %oci-container-accounts)) - (service-extension shepherd-root-service-type - configs->shepherd-services))) + (extensions + (list (service-extension oci-service-type + (lambda (containers) + (warning + (G_ + "'oci-container-service-type' is deprecated, use 'oci-service-type' instead~%")) + (oci-extension + (containers containers)))))) (default-value '()) (extend append) (compose concatenate) diff --git a/gnu/tests/containers.scm b/gnu/tests/containers.scm index 0ecc8ddb126..5e6f39387e7 100644 --- a/gnu/tests/containers.scm +++ b/gnu/tests/containers.scm @@ -27,6 +27,9 @@ (define-module (gnu tests containers) #: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 @@ (define-module (gnu tests containers) #: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 @@ -345,3 +350,995 @@ (define %test-rootless-podman (name "rootless-podman") (description "Test rootless Podman service.") (value (build-tarball&run-rootless-podman-test)))) + + +(define %oci-rootless-podman-os + (simple-operating-system + (service dhcp-client-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-configuration (name "my-network")))) + (volumes + (list (oci-volume-configuration (name "my-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)(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 services herd) + (guix combinators)))) + + (define vm + (virtual-machine + (operating-system os) + (volatile? #f) + (memory-size 1024) + (disk-image-size (* 3000 (expt 2 20))) + (port-forwardings '()))) + + (define test + (with-imported-modules '((gnu build marionette)) + #~(begin + (use-modules (srfi srfi-11) (srfi srfi-64) + (gnu build marionette)) + + (define marionette + ;; Relax timeout to accommodate older systems and + ;; allow for pulling the image. + (make-marionette (list #$vm) #:timeout 60)) + (define out-dir "/tmp") + + (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 "rootless-podman services started successfully" + (begin + (define (run-test) + (marionette-eval + `(begin + (use-modules (ice-9 popen) + (ice-9 match) + (ice-9 rdelim)) + + (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 slurp + (lambda args + (let* ((port (apply open-pipe* OPEN_READ args)) + (output (read-lines port)) + (status (close-pipe port))) + output))) + (let* ((bash + ,(string-append #$bash "/bin/bash")) + (response1 + (slurp bash "-c" + (string-append "ls -la /sys/fs/cgroup | " + "grep -E ' \\./?$' | awk '{ print $4 }'"))) + (response2 (slurp bash "-c" + (string-append "ls -l /sys/fs/cgroup/cgroup" + ".{procs,subtree_control,threads} | " + "awk '{ print $4 }' | sort -u")))) + (list (string-join response1 "\n") (string-join response2 "\n")))) + marionette)) + ;; Allow services to come up on slower machines + (let loop ((attempts 0)) + (if (= attempts 60) + (error "Services didn't come up after more than 60 seconds") + (if (equal? '("cgroup" "cgroup") + (run-test)) + #t + (begin + (sleep 1) + (format #t "Services didn't come up yet, retrying with attempt ~a~%" + (+ 1 attempts)) + (loop (+ 1 attempts)))))))) + + (test-assert "podman-volumes running" + (begin + (define (run-test) + (marionette-eval + `(begin + (use-modules (srfi srfi-1) + (ice-9 popen) + (ice-9 match) + (ice-9 rdelim)) + + (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 (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 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))) + + (match (primitive-fork) + (0 + (dynamic-wind + (const #f) + (lambda () + (setgid (passwd:gid (getpwnam "oci-container"))) + (setuid (passwd:uid (getpw "oci-container"))) + + (let ((response (slurp + "/run/current-system/profile/bin/podman" + "volume" "ls" "-n" "--format" "\"{{.Name}}\"" + "|" "tr" "' '" "'\n'"))) + + (call-with-output-file (string-append ,out-dir "/response") + (lambda (port) + (display (string-join response "\n") port))))) + (lambda () + (primitive-exit 127)))) + (pid + (cdr (waitpid pid)))) + + (wait-for-file (string-append ,out-dir "/response")) + + (stable-sort + (slurp "cat" (string-append ,out-dir "/response")) + string<=?)) + marionette)) + ;; Allow services to come up on slower machines + (let loop ((attempts 0)) + (if (= attempts 80) + (error "Service didn't come up after more than 80 seconds") + (if (equal? '("my-volume") + (run-test)) + #t + (begin + (sleep 1) + (loop (+ 1 attempts)))))))) + + (test-assert "podman-networks running" + (begin + (define (run-test) + (marionette-eval + `(begin + (use-modules (srfi srfi-1) + (ice-9 popen) + (ice-9 match) + (ice-9 rdelim)) + + (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 (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 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))) + + (match (primitive-fork) + (0 + (dynamic-wind + (const #f) + (lambda () + (setgid (passwd:gid (getpwnam "oci-container"))) + (setuid (passwd:uid (getpw "oci-container"))) + + (let ((response (slurp + "/run/current-system/profile/bin/podman" + "network" "ls" "-n" "--format" "\"{{.Name}}\"" + "|" "tr" "' '" "'\n'"))) + + (call-with-output-file (string-append ,out-dir "/response") + (lambda (port) + (display (string-join response "\n") port))))) + (lambda () + (primitive-exit 127)))) + (pid + (cdr (waitpid pid)))) + + (wait-for-file (string-append ,out-dir "/response")) + + (stable-sort + (slurp "cat" (string-append ,out-dir "/response")) + string<=?)) + marionette)) + ;; Allow services to come up on slower machines + (let loop ((attempts 0)) + (if (= attempts 80) + (error "Service didn't come up after more than 80 seconds") + (if (equal? '("my-network" "podman") + (run-test)) + #t + (begin + (sleep 1) + (loop (+ 1 attempts)))))))) + + (test-assert "first container running" + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (wait-for-service 'first #:timeout 120) + #t) + marionette)) + + (test-assert "second container running" + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (wait-for-service 'second #:timeout 120) + #t) + marionette)) + + (test-assert "passing host environment variables" + (begin + (define (run-test) + (marionette-eval + `(begin + (use-modules (srfi srfi-1) + (ice-9 popen) + (ice-9 match) + (ice-9 rdelim)) + + (define (wait-for-file file) + ;; Wait until FILE shows up. + (let loop ((i 60)) + (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 (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 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))) + + (match (primitive-fork) + (0 + (dynamic-wind + (const #f) + (lambda () + (setgid (passwd:gid (getpwnam "oci-container"))) + (setuid (passwd:uid (getpw "oci-container"))) + + (let ((response (slurp + "/run/current-system/profile/bin/podman" + "exec" "first" + "/bin/guile" "-c" "'(display (getenv \"VARIABLE\"))'"))) + (call-with-output-file (string-append ,out-dir "/response") + (lambda (port) + (display (string-join response "\n") port))))) + (lambda () + (primitive-exit 127)))) + (pid + (cdr (waitpid pid)))) + + (wait-for-file (string-append ,out-dir "/response")) + (slurp "cat" (string-append ,out-dir "/response"))) + marionette)) + ;; Allow image to be loaded on slower machines + (let loop ((attempts 0)) + (if (= attempts 180) + (error "Service didn't come up after more than 180 seconds") + (if (equal? (list "value") + (run-test)) + #t + (begin + (sleep 1) + (loop (+ 1 attempts)))))))) + + (test-equal "mounting host files" + '("hello") + (marionette-eval + `(begin + (use-modules (srfi srfi-1) + (ice-9 popen) + (ice-9 match) + (ice-9 rdelim)) + + (define (wait-for-file file) + ;; Wait until FILE shows up. + (let loop ((i 60)) + (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 (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 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))) + + (match (primitive-fork) + (0 + (dynamic-wind + (const #f) + (lambda () + (setgid (passwd:gid (getpwnam "oci-container"))) + (setuid (passwd:uid (getpw "oci-container"))) + + (let ((response (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)))'"))) + (call-with-output-file (string-append ,out-dir "/response") + (lambda (port) + (display (string-join response " ") port))))) + (lambda () + (primitive-exit 127)))) + (pid + (cdr (waitpid pid)))) + + (wait-for-file (string-append ,out-dir "/response")) + (slurp "cat" (string-append ,out-dir "/response"))) + marionette)) + + (test-equal "write to volumes" + '("world") + (marionette-eval + `(begin + (use-modules (srfi srfi-1) + (ice-9 popen) + (ice-9 match) + (ice-9 rdelim)) + + (define (wait-for-file file) + ;; Wait until FILE shows up. + (let loop ((i 60)) + (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 (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 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))) + + (match (primitive-fork) + (0 + (dynamic-wind + (const #f) + (lambda () + (setgid (passwd:gid (getpwnam "oci-container"))) + (setuid (passwd:uid (getpw "oci-container"))) + + (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))))'") + + (let ((response (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)))'"))) + (call-with-output-file (string-append ,out-dir "/response") + (lambda (port) + (display (string-join response " ") port))))) + (lambda () + (primitive-exit 127)))) + (pid + (cdr (waitpid pid)))) + + (wait-for-file (string-append ,out-dir "/response")) + (slurp "cat" (string-append ,out-dir "/response"))) + marionette)) + + (test-equal "can read ports over network" + '("out of office") + (marionette-eval + `(begin + (use-modules (srfi srfi-1) + (ice-9 popen) + (ice-9 match) + (ice-9 rdelim)) + + (define (wait-for-file file) + ;; Wait until FILE shows up. + (let loop ((i 60)) + (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 (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 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))) + + (match (primitive-fork) + (0 + (dynamic-wind + (const #f) + (lambda () + (setgid (passwd:gid (getpwnam "oci-container"))) + (setuid (passwd:uid (getpw "oci-container"))) + + (let ((response (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))'"))) + (call-with-output-file (string-append ,out-dir "/response") + (lambda (port) + (display (string-join response " ") port))))) + (lambda () + (primitive-exit 127)))) + (pid + (cdr (waitpid pid)))) + + (wait-for-file (string-append ,out-dir "/response")) + (slurp "cat" (string-append ,out-dir "/response"))) + 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-os + (simple-operating-system + (service dhcp-client-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-configuration (name "my-network")))) + (volumes + (list (oci-volume-configuration (name "my-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)(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 services herd) + (guix combinators)))) + + (define vm + (virtual-machine + (operating-system os) + (volatile? #f) + (memory-size 1024) + (disk-image-size (* 3000 (expt 2 20))) + (port-forwardings '()))) + + (define test + (with-imported-modules '((gnu build marionette)) + #~(begin + (use-modules (srfi srfi-11) (srfi srfi-64) + (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) + (marionette-eval + `(begin + (use-modules (ice-9 popen) + (ice-9 rdelim)) + + (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 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))) + + (stable-sort + (slurp + "/run/current-system/profile/bin/docker" + "volume" "ls" "--format" "\"{{.Name}}\"") + string<=?)) + + marionette)) + ;; Allow services to come up on slower machines + (let loop ((attempts 0)) + (if (= attempts 80) + (error "Service didn't come up after more than 80 seconds") + (if (equal? '("my-volume") + (run-test)) + #t + (begin + (sleep 1) + (loop (+ 1 attempts)))))))) + + (test-assert "docker-networks running" + (begin + (define (run-test) + (marionette-eval + `(begin + (use-modules (ice-9 popen) + (ice-9 rdelim)) + + (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 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))) + + (stable-sort + (slurp + "/run/current-system/profile/bin/docker" + "network" "ls" "--format" "\"{{.Name}}\"") + string<=?)) + + marionette)) + ;; Allow services to come up on slower machines + (let loop ((attempts 0)) + (if (= attempts 80) + (error "Service didn't come up after more than 80 seconds") + (if (equal? '("bridge" "host" "my-network" "none") + (run-test)) + #t + (begin + (sleep 1) + (loop (+ 1 attempts)))))))) + + (test-assert "first container running" + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (wait-for-service 'first #:timeout 120) + #t) + marionette)) + + (test-assert "second container running" + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (wait-for-service 'second #:timeout 120) + #t) + marionette)) + + (test-assert "passing host environment variables" + (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))) + + (slurp + "/run/current-system/profile/bin/docker" + "exec" "first" + "/bin/guile" "-c" "(display (getenv \"VARIABLE\"))")) + marionette)) + ;; Allow image to be loaded on slower machines + (let loop ((attempts 0)) + (if (= attempts 180) + (error "Service didn't come up after more than 180 seconds") + (if (equal? "value" + (run-test)) + #t + (begin + (sleep 1) + (loop (+ 1 attempts)))))))) + + (test-equal "mounting host files" + "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))) + + (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 \"/shared.txt\" read-line)))")) + marionette)) + + (test-equal "write to volumes" + "world" + (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))) + + (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 ports over network" + "out of office" + (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))) + + (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)))) -- 2.48.1 From unknown Fri Jun 13 11:55:10 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#76081] [PATCH v6 4/5] tests: Use lower-oci-image-state in container tests. Resent-From: Giacomo Leidi Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Wed, 26 Feb 2025 23:09:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 76081 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 76081@debbugs.gnu.org Cc: Giacomo Leidi Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.17406113084860 (code B ref 76081); Wed, 26 Feb 2025 23:09:02 +0000 Received: (at 76081) by debbugs.gnu.org; 26 Feb 2025 23:08:28 +0000 Received: from localhost ([127.0.0.1]:56075 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tnQVv-0001GD-6y for submit@debbugs.gnu.org; Wed, 26 Feb 2025 18:08:28 -0500 Received: from confino.investici.org ([93.190.126.19]:47071) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1tnQVr-0001Fa-Ts for 76081@debbugs.gnu.org; Wed, 26 Feb 2025 18:08:25 -0500 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org; s=stigmate; t=1740611302; bh=PpnlXDiHDweVa3+k4DAj5IYR0vx7Oa4zoSqOksxGVQ0=; h=From:To:Cc:Subject:Date:In-Reply-To:References:From; b=n7mUOHqnzjJ1gFqh0Vhu83n9q55obiyQrrDSso8SH0wOQyn8s8Ddpa2EEG9l/plgS ydiKfGYDGTMyAASgrFACBW9c/SOdvPrthtcpAC8i1/V2bYBSjpgHdoD+pwyBRMg7ga eOZoP9uljmBwFci45fb61x625zVgG5pzB3WqIb70= Received: from mx1.investici.org (unknown [127.0.0.1]) by confino.investici.org (Postfix) with ESMTP id 4Z39BG6pnVz11D7; Wed, 26 Feb 2025 23:08:22 +0000 (UTC) Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19]) (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with ESMTPSA id 4Z39BG5ZYFz111L; Wed, 26 Feb 2025 23:08:22 +0000 (UTC) From: Giacomo Leidi Date: Thu, 27 Feb 2025 00:08:09 +0100 Message-ID: <7d3f6521d783c726f555d906881624eed5a523c2.1740611290.git.goodoldpaul@autistici.org> X-Mailer: git-send-email 2.48.1 In-Reply-To: <0ba285c5241f6817250b4af71776072faf248a14.1740611290.git.goodoldpaul@autistici.org> References: <0ba285c5241f6817250b4af71776072faf248a14.1740611290.git.goodoldpaul@autistici.org> MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Spam-Score: -0.7 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.7 (-) This patch replaces boilerplate in container related tests with oci-image plumbing from (gnu services containers). * gnu/services/containers.scm: Export lower-oci-image-state. * gnu/tests/containers.scm (%oci-tarball): New variable; (run-rootless-podman-test): use %oci-tarball; (build-tarball&run-rootless-podman-test): drop procedure. * gnu/tests/docker.scm (%docker-tarball): New variable; (build-tarball&run-docker-test): use %docker-tarball; (%docker-system-tarball): New variable; (build-tarball&run-docker-system-test): new procedure. Change-Id: Iad6f0704aee188d89464c83722dea0bb7adb084a --- gnu/services/containers.scm | 2 + gnu/tests/containers.scm | 80 ++++++++++++++--------------- gnu/tests/docker.scm | 100 ++++++++++++++++++++---------------- 3 files changed, 95 insertions(+), 87 deletions(-) diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm index 603eec25e2b..139d5e4ec50 100644 --- a/gnu/services/containers.scm +++ b/gnu/services/containers.scm @@ -75,6 +75,8 @@ (define-module (gnu services containers) oci-image-system oci-image-grafts? + lower-oci-image-state + oci-container-configuration oci-container-configuration? oci-container-configuration-fields diff --git a/gnu/tests/containers.scm b/gnu/tests/containers.scm index 5e6f39387e7..8cdd86e7ae3 100644 --- a/gnu/tests/containers.scm +++ b/gnu/tests/containers.scm @@ -69,13 +69,47 @@ (define %rootless-podman-os (supplementary-groups '("wheel" "netdev" "cgroup" "audio" "video"))))))) -(define (run-rootless-podman-test oci-tarball) +(define %oci-tarball + (lower-oci-image-state + "guile-guest" + (packages->manifest + (list + guile-3.0 guile-json-3 + (package + (name "guest-script") + (version "0") + (source #f) + (build-system trivial-build-system) + (arguments `(#:guile ,guile-3.0 + #:builder + (let ((out (assoc-ref %outputs "out"))) + (mkdir out) + (call-with-output-file (string-append out "/a.scm") + (lambda (port) + (display "(display \"hello world\n\")" port))) + #t))) + (synopsis "Display hello world using Guile") + (description "This package displays the text \"hello world\" on the +standard output device and then enters a new line.") + (home-page #f) + (license license:public-domain)))) + '(#:entry-point "bin/guile" + #:localstatedir? #t + #:extra-options (#:image-tag "guile-guest") + #:symlinks (("/bin/Guile" -> "bin/guile") + ("aa.scm" -> "a.scm"))) + "guile-guest" + (%current-target-system) + (%current-system) + #f)) + +(define (run-rootless-podman-test) (define os (marionette-operating-system (operating-system-with-gc-roots %rootless-podman-os - (list oci-tarball)) + (list %oci-tarball)) #:imported-modules '((gnu services herd) (guix combinators)))) @@ -254,7 +288,7 @@ (define (run-rootless-podman-test oci-tarball) (let* ((loaded (slurp ,(string-append #$podman "/bin/podman") "load" "-i" - ,#$oci-tarball)) + ,#$%oci-tarball)) (repository&tag "localhost/guile-guest:latest") (response1 (slurp ,(string-append #$podman "/bin/podman") @@ -307,49 +341,11 @@ (define (run-rootless-podman-test oci-tarball) (gexp->derivation "rootless-podman-test" test)) -(define (build-tarball&run-rootless-podman-test) - (mlet* %store-monad - ((_ (set-grafting #f)) - (guile (set-guile-for-build (default-guile))) - (guest-script-package -> - (package - (name "guest-script") - (version "0") - (source #f) - (build-system trivial-build-system) - (arguments `(#:guile ,guile-3.0 - #:builder - (let ((out (assoc-ref %outputs "out"))) - (mkdir out) - (call-with-output-file (string-append out "/a.scm") - (lambda (port) - (display "(display \"hello world\n\")" port))) - #t))) - (synopsis "Display hello world using Guile") - (description "This package displays the text \"hello world\" on the -standard output device and then enters a new line.") - (home-page #f) - (license license:public-domain))) - (profile (profile-derivation (packages->manifest - (list guile-3.0 guile-json-3 - guest-script-package)) - #:hooks '() - #:locales? #f)) - (tarball (pack:docker-image - "docker-pack" profile - #:symlinks '(("/bin/Guile" -> "bin/guile") - ("aa.scm" -> "a.scm")) - #:extra-options - '(#:image-tag "guile-guest") - #:entry-point "bin/guile" - #:localstatedir? #t))) - (run-rootless-podman-test tarball))) - (define %test-rootless-podman (system-test (name "rootless-podman") (description "Test rootless Podman service.") - (value (build-tarball&run-rootless-podman-test)))) + (value (run-rootless-podman-test)))) (define %oci-rootless-podman-os diff --git a/gnu/tests/docker.scm b/gnu/tests/docker.scm index 5dcf05a17e3..07edd9d5341 100644 --- a/gnu/tests/docker.scm +++ b/gnu/tests/docker.scm @@ -26,6 +26,7 @@ (define-module (gnu tests docker) #:use-module (gnu system image) #:use-module (gnu system vm) #:use-module (gnu services) + #:use-module (gnu services containers) #:use-module (gnu services dbus) #:use-module (gnu services networking) #:use-module (gnu services docker) @@ -57,6 +58,40 @@ (define %docker-os (service containerd-service-type) (service docker-service-type))) +(define %docker-tarball + (lower-oci-image-state + "guile-guest" + (packages->manifest + (list + guile-3.0 guile-json-3 + (package + (name "guest-script") + (version "0") + (source #f) + (build-system trivial-build-system) + (arguments `(#:guile ,guile-3.0 + #:builder + (let ((out (assoc-ref %outputs "out"))) + (mkdir out) + (call-with-output-file (string-append out "/a.scm") + (lambda (port) + (display "(display \"hello world\n\")" port))) + #t))) + (synopsis "Display hello world using Guile") + (description "This package displays the text \"hello world\" on the +standard output device and then enters a new line.") + (home-page #f) + (license license:public-domain)))) + '(#:entry-point "bin/guile" + #:localstatedir? #t + #:extra-options (#:image-tag "guile-guest") + #:symlinks (("/bin/Guile" -> "bin/guile") + ("aa.scm" -> "a.scm"))) + "guile-guest" + (%current-target-system) + (%current-system) + #f)) + (define (run-docker-test docker-tarball) "Load DOCKER-TARBALL as Docker image and run it in a Docker container, inside %DOCKER-OS." @@ -173,40 +208,7 @@ (define (run-docker-test docker-tarball) (gexp->derivation "docker-test" test)) (define (build-tarball&run-docker-test) - (mlet* %store-monad - ((_ (set-grafting #f)) - (guile (set-guile-for-build (default-guile))) - (guest-script-package -> - (package - (name "guest-script") - (version "0") - (source #f) - (build-system trivial-build-system) - (arguments `(#:guile ,guile-3.0 - #:builder - (let ((out (assoc-ref %outputs "out"))) - (mkdir out) - (call-with-output-file (string-append out "/a.scm") - (lambda (port) - (display "(display \"hello world\n\")" port))) - #t))) - (synopsis "Display hello world using Guile") - (description "This package displays the text \"hello world\" on the -standard output device and then enters a new line.") - (home-page #f) - (license license:public-domain))) - (profile (profile-derivation (packages->manifest - (list guile-3.0 guile-json-3 - guest-script-package)) - #:hooks '() - #:locales? #f)) - (tarball (pack:docker-image - "docker-pack" profile - #:symlinks '(("/bin/Guile" -> "bin/guile") - ("aa.scm" -> "a.scm")) - #:entry-point "bin/guile" - #:localstatedir? #t))) - (run-docker-test tarball))) + (run-docker-test %docker-tarball)) (define %test-docker (system-test @@ -215,8 +217,22 @@ (define %test-docker (value (build-tarball&run-docker-test)))) +(define %docker-system-tarball + (lower-oci-image-state + "guix-system-guest" + (operating-system + (inherit (simple-operating-system)) + ;; Use locales for a single libc to + ;; reduce space requirements. + (locale-libcs (list glibc))) + '() + "guix-system-guest" + (%current-target-system) + (%current-system) + #f)) + (define (run-docker-system-test tarball) - "Load DOCKER-TARBALL as Docker image and run it in a Docker container, + "Load TARBALL as Docker image and run it in a Docker container, inside %DOCKER-OS." (define os (marionette-operating-system @@ -333,21 +349,15 @@ (define (run-docker-system-test tarball) (gexp->derivation "docker-system-test" test)) +(define (build-tarball&run-docker-system-test) + (run-docker-system-test %docker-system-tarball)) + (define %test-docker-system (system-test (name "docker-system") (description "Run a system image as produced by @command{guix system docker-image} inside Docker.") - (value (with-monad %store-monad - (>>= (lower-object - (system-image (os->image - (operating-system - (inherit (simple-operating-system)) - ;; Use locales for a single libc to - ;; reduce space requirements. - (locale-libcs (list glibc))) - #:type docker-image-type))) - run-docker-system-test))))) + (value (build-tarball&run-docker-system-test)))) (define %oci-os -- 2.48.1 From unknown Fri Jun 13 11:55:10 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#76081] [PATCH v6 5/5] home: Add home-oci-service-type. Resent-From: Giacomo Leidi Original-Sender: "Debbugs-submit" Resent-CC: andrew@trop.in, janneke@gnu.org, ludo@gnu.org, maxim.cournoyer@gmail.com, tanguy@bioneland.org, guix-patches@gnu.org Resent-Date: Wed, 26 Feb 2025 23:09:03 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 76081 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 76081@debbugs.gnu.org Cc: Giacomo Leidi , Andrew Tropin , Janneke Nieuwenhuizen , Ludovic =?UTF-8?Q?Court=C3=A8s?= , Maxim Cournoyer , Tanguy Le Carrour X-Debbugs-Original-Xcc: Andrew Tropin , Janneke Nieuwenhuizen , Ludovic =?UTF-8?Q?Court=C3=A8s?= , Maxim Cournoyer , Tanguy Le Carrour Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.17406113094872 (code B ref 76081); Wed, 26 Feb 2025 23:09:03 +0000 Received: (at 76081) by debbugs.gnu.org; 26 Feb 2025 23:08:29 +0000 Received: from localhost ([127.0.0.1]:56077 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tnQVw-0001GL-7o for submit@debbugs.gnu.org; Wed, 26 Feb 2025 18:08:29 -0500 Received: from confino.investici.org ([2a11:7980:1::2:0]:61379) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1tnQVs-0001Fb-3j for 76081@debbugs.gnu.org; Wed, 26 Feb 2025 18:08:26 -0500 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org; s=stigmate; t=1740611303; bh=kHL9LMwU8v0P9d3hNCgHuoQg6btk38l3Y+bbF98TWYo=; h=From:To:Cc:Subject:Date:In-Reply-To:References:From; b=BV9Y8/W9H8RbmZJSZPXk375M8NNlDmMP+0XYh26r6uB6B95Xj9WyFAzpRmXdQyqeA Lvw81SRmLpU6V8tSFWh5Zz4p+50+JJVihVPQEWSkgUHRZwn5I/iYWlbgLDZHv4xN1t JZcQZMEcL7qXlh9zULX4ObfpyFh3+KTlPXyxWHNQ= Received: from mx1.investici.org (unknown [127.0.0.1]) by confino.investici.org (Postfix) with ESMTP id 4Z39BH2FtDz11Dc; Wed, 26 Feb 2025 23:08:23 +0000 (UTC) Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19]) (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with ESMTPSA id 4Z39BH1JlSz111L; Wed, 26 Feb 2025 23:08:23 +0000 (UTC) From: Giacomo Leidi Date: Thu, 27 Feb 2025 00:08:10 +0100 Message-ID: X-Mailer: git-send-email 2.48.1 In-Reply-To: <0ba285c5241f6817250b4af71776072faf248a14.1740611290.git.goodoldpaul@autistici.org> References: <0ba285c5241f6817250b4af71776072faf248a14.1740611290.git.goodoldpaul@autistici.org> MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit X-Spam-Score: -0.0 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) * gnu/home/service/containers.scm: New file; * gnu/local.mk (GNU_SYSTEM_MODULES): Add it. * doc/guix.texi (OCI backed services): Document it. Change-Id: I8ce5b301e8032d0a7b2a9ca46752738cdee1f030 --- doc/guix.texi | 114 +++++++++++++++++++++++++++++++ gnu/home/services/containers.scm | 50 ++++++++++++++ gnu/local.mk | 1 + 3 files changed, 165 insertions(+) create mode 100644 gnu/home/services/containers.scm diff --git a/doc/guix.texi b/doc/guix.texi index fd08261af3b..5513eb89048 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -49876,6 +49876,120 @@ Miscellaneous Home Services (dicod-configuration @dots{}))) @end lisp +@subsubheading OCI backed services + +@cindex OCI-backed, for Home +The @code{(gnu home services containers)} module provides the following service: + +@defvar home-oci-service-type +This is the type of the service that allows to manage your OCI containers with +the same consistent interface you use for your other Home Shepherd services. +@end defvar + +This service is a direct mapping of the @code{oci-service-type} system +service (@pxref{Miscellaneous Services, OCI backed services}). You can +use it like this: + +@lisp +(use-modules (gnu services containers) + (gnu home services containers)) + +(simple-service 'home-oci-provisioning + home-oci-service-type + (oci-extension + (volumes + (list + (oci-volume-configuration (name "prometheus")) + (oci-volume-configuration (name "grafana")))) + (networks + (list + (oci-network-configuration (name "monitoring")))) + (containers + (list + (oci-container-configuration + (network "monitoring") + (image + (oci-image + (repository "guile") + (tag "3") + (value (specifications->manifest '("guile"))) + (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile")) + #:max-layers 2)))) + (entrypoint "/bin/guile") + (command + '("-c" "(display \"hello!\n\")"))) + (oci-container-configuration + (image "prom/prometheus") + (network "monitoring") + (ports + '(("9000" . "9000") + ("9090" . "9090"))) + (volumes + (list + '(("prometheus" . "/var/lib/prometheus"))))) + (oci-container-configuration + (image "grafana/grafana:10.0.1") + (network "monitoring") + (volumes + '(("grafana:/var/lib/grafana")))))))) + +@end lisp + +You may specify a custom configuration by providing a +@code{oci-configuration} record, exactly like for +@code{oci-service-type}, but wrapping it in @code{for-home}: + +@lisp +(use-modules (gnu services) + (gnu services containers) + (gnu home services containers)) + +(service home-oci-service-type + (for-home + (oci-configuration + (runtime 'podman) + (verbose? #t)))) + +(simple-service 'home-oci-provisioning + home-oci-service-type + (oci-extension + (volumes + (list + (oci-volume-configuration (name "prometheus")) + (oci-volume-configuration (name "grafana")))) + (networks + (list + (oci-network-configuration (name "monitoring")))) + (containers + (list + (oci-container-configuration + (network "monitoring") + (image + (oci-image + (repository "guile") + (tag "3") + (value (specifications->manifest '("guile"))) + (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile")) + #:max-layers 2)))) + (entrypoint "/bin/guile") + (command + '("-c" "(display \"hello!\n\")"))) + (oci-container-configuration + (image "prom/prometheus") + (network "monitoring") + (ports + '(("9000" . "9000") + ("9090" . "9090"))) + (volumes + (list + '(("prometheus" . "/var/lib/prometheus"))))) + (oci-container-configuration + (image "grafana/grafana:10.0.1") + (network "monitoring") + (volumes + '(("grafana:/var/lib/grafana")))))))) +@end lisp + @node Invoking guix home @section Invoking @command{guix home} diff --git a/gnu/home/services/containers.scm b/gnu/home/services/containers.scm new file mode 100644 index 00000000000..938dde2f37a --- /dev/null +++ b/gnu/home/services/containers.scm @@ -0,0 +1,50 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2025 Giacomo Leidi +;;; +;;; 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 . + +(define-module (gnu home services containers) + #:use-module (gnu home services) + #:use-module (gnu home services shepherd) + #:use-module (gnu services) + #:use-module (gnu services configuration) + #:use-module (gnu services containers) + #:use-module (guix gexp) + #:use-module (guix packages) + #:use-module (srfi srfi-1) + #:export (home-oci-service-type)) + +(define home-oci-service-type + (service-type (inherit (system->home-service-type oci-service-type)) + (extensions + (list + (service-extension home-profile-service-type + (oci-service-extension-wrap-validate + (lambda (config) + (let ((runtime-cli + (oci-configuration-runtime-cli config)) + (runtime + (oci-configuration-runtime config))) + (oci-service-profile runtime runtime-cli))))) + (service-extension home-shepherd-service-type + (oci-service-extension-wrap-validate + oci-configuration->shepherd-services)))) + (extend + (lambda (config extension) + (for-home + (oci-configuration + (inherit (oci-configuration-extend config extension)))))) + (default-value (for-home (oci-configuration))))) diff --git a/gnu/local.mk b/gnu/local.mk index c8a29bf98b5..9b86e59c37f 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -102,6 +102,7 @@ GNU_SYSTEM_MODULES = \ %D%/home.scm \ %D%/home/services.scm \ %D%/home/services/admin.scm \ + %D%/home/services/containers.scm \ %D%/home/services/desktop.scm \ %D%/home/services/dict.scm \ %D%/home/services/dotfiles.scm \ -- 2.48.1 From unknown Fri Jun 13 11:55:10 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#76081] [PATCH v6 2/5] services: oci-container-configuration: Move to (gnu services containers). Resent-From: Giacomo Leidi Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Wed, 26 Feb 2025 23:09:03 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 76081 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 76081@debbugs.gnu.org Cc: Giacomo Leidi Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.17406113334926 (code B ref 76081); Wed, 26 Feb 2025 23:09:03 +0000 Received: (at 76081) by debbugs.gnu.org; 26 Feb 2025 23:08:53 +0000 Received: from localhost ([127.0.0.1]:56079 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tnQWI-0001HJ-F6 for submit@debbugs.gnu.org; Wed, 26 Feb 2025 18:08:52 -0500 Received: from confino.investici.org ([93.190.126.19]:55527) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1tnQVr-0001FX-UE for 76081@debbugs.gnu.org; Wed, 26 Feb 2025 18:08:28 -0500 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org; s=stigmate; t=1740611302; bh=5w1pguUy5euk/p6I7KBfaqhA/lWVRKQOsLxduTGYZqY=; h=From:To:Cc:Subject:Date:In-Reply-To:References:From; b=rfgDNHeGaHXBfm1bcE/EpMDUqbRreZm4v07akeYBirTBr8OyaOfbYyCtO/sVPkOCh EO1Fp/O7647B5Wk6LiebHsdtScspOGDkEUfTor8QUoOXac0EllRJBTOUDentAeQIlv In9YCudfPhqpc4KK6lNpbgQIcmjaTy4q99fBrxkI= Received: from mx1.investici.org (unknown [127.0.0.1]) by confino.investici.org (Postfix) with ESMTP id 4Z39BG0ycMz117r; Wed, 26 Feb 2025 23:08:22 +0000 (UTC) Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19]) (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with ESMTPSA id 4Z39BF6q1Rz111L; Wed, 26 Feb 2025 23:08:21 +0000 (UTC) From: Giacomo Leidi Date: Thu, 27 Feb 2025 00:08:07 +0100 Message-ID: <4b79084a63c98ff9b15c925af93455ef1f1c1fd1.1740611290.git.goodoldpaul@autistici.org> X-Mailer: git-send-email 2.48.1 In-Reply-To: <0ba285c5241f6817250b4af71776072faf248a14.1740611290.git.goodoldpaul@autistici.org> References: <0ba285c5241f6817250b4af71776072faf248a14.1740611290.git.goodoldpaul@autistici.org> MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit X-Spam-Score: -0.7 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.7 (-) 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 +;;; Copyright © 2024, 2025 Giacomo Leidi ;;; ;;; This file is part of GNU Guix. ;;; @@ -17,19 +17,31 @@ ;;; along with GNU Guix. If not, see . (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 ;;; Copyright © 2020 Jesse Dowell ;;; Copyright © 2021 Brice Waegeneire -;;; Copyright © 2023, 2024 Giacomo Leidi +;;; Copyright © 2023, 2024, 2025 Giacomo Leidi ;;; ;;; This file is part of GNU Guix. ;;; @@ -23,72 +23,60 @@ ;;; along with GNU Guix. If not, see . (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 ;;; Copyright © 2019-2023 Ludovic Courtès -;;; Copyright © 2024 Giacomo Leidi +;;; Copyright © 2024, 2025 Giacomo Leidi ;;; ;;; 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 From unknown Fri Jun 13 11:55:10 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#76081] OCI provisioning service Resent-From: paul Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Tue, 04 Mar 2025 12:40:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 76081 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 76081@debbugs.gnu.org Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.17410919821867 (code B ref 76081); Tue, 04 Mar 2025 12:40:02 +0000 Received: (at 76081) by debbugs.gnu.org; 4 Mar 2025 12:39:42 +0000 Received: from localhost ([127.0.0.1]:56138 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tpRYj-0000U1-IO for submit@debbugs.gnu.org; Tue, 04 Mar 2025 07:39:42 -0500 Received: from confino.investici.org ([93.190.126.19]:46275) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1tpRYe-0000Tm-EZ for 76081@debbugs.gnu.org; Tue, 04 Mar 2025 07:39:39 -0500 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org; s=stigmate; t=1741091974; bh=8DGpHwqkpANSw5LzIMEQSItgGLcbHrNg6LQB0uL6wYo=; h=Date:Subject:From:To:References:In-Reply-To:From; b=tcUWfKgZcZoAe3oHuQYXoJyX+fwd+kOmv8UInKp67ke3NmLKgDlPyZ74W0HGtY9vq /ZbUH3zj82X4o5Rz3E6bYd0J1UETyIwxBMFKwZXfXrTFeyA1AB3pca6aTbQaywckoq cr+WNc4FOjfcuHlStWTaZO6+tBjy7aVDyO6+it1g= Received: from mx1.investici.org (unknown [127.0.0.1]) by confino.investici.org (Postfix) with ESMTP id 4Z6Zxy2R0wz1122 for <76081@debbugs.gnu.org>; Tue, 4 Mar 2025 12:39:34 +0000 (UTC) Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19]) (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with ESMTPSA id 4Z6Zxy1jc0z111F for <76081@debbugs.gnu.org>; Tue, 4 Mar 2025 12:39:34 +0000 (UTC) Message-ID: Date: Tue, 4 Mar 2025 13:39:33 +0100 MIME-Version: 1.0 User-Agent: Icedove Daily From: paul References: <274b98ea-1af9-4f0f-af58-8fa755feb73b@autistici.org> <397afc1f-b638-430a-b9e7-7de4721bca45@autistici.org> Content-Language: en-US In-Reply-To: <397afc1f-b638-430a-b9e7-7de4721bca45@autistici.org> Content-Type: text/plain; charset=UTF-8; format=flowed Content-Transfer-Encoding: 8bit X-Spam-Score: -0.7 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.7 (-) Hi, On 2/27/25 00:01, paul wrote: > Hi guix, > > On 2/18/25 02:20, paul wrote: >> Hi, >> >> On 2/12/25 02:09, paul wrote: >>> Hi guix, >>> >>> On 2/9/25 21:38, paul wrote: >>>> I'm sending a v3 fixing a bug in the merge algorithm for volumes >>>> and networks. >>>> >>>> On 2/9/25 20:14, paul wrote: >>>>> Hi, >>>>> >>>>> I'm about to send a v2. v2 compared to the first revision features: >>>>> >>>>> >>>>> - it actually compiles all the times :) (rev 1 referenced >>>>> oci-image too early for it to be working and generated a compile >>>>> time error, if you recompiled it sometimes went away so I thought >>>>> it was a problem of my setup. CI caught this) >>>>> - it allows more values to be overridden by eventual users of the >>>>> Scheme API >>>>> - it allows passing extra arguments directly after each podman or >>>>> docker invokation, allowing for example for overriding podman >>>>> --root and similar options. >>>>> >>>>> All of these tests should pass: >>>>> >>>>> guix shell -D guix -CPW -- make check-system TESTS="oci-container >>>>> oci-service-rootless-podman docker docker-system rootless-podman >>>>> oci-service-docker" >>>>> >>> I'm sending a v4 changing slightly the image loader, the same tests >>> as before are supposed to pass. Now the Home service [0] is working >>> for me with rootless podman. I'll try it on different distros if I >>> manage to. >> >> I'm sending a v5 implementing a Home service. The changes compared to >> v4 are pretty trivial as the plumbing was already there, the only >> downside is that I'm not able to use for-home? in >> define-configuration, so I had to reimplement oci-configuration with >> (guix records) and had to reimplement some validation (gnu services >> configuration) would figure out magically. > > I'm sending  a v6. Compared to v5 it resolves the conflicts with > master and it should fix the stop action for rootless podman backed > services. I'm sending a v7 fixing the restart action for podman backed services. Thank you for your work, giacomo From unknown Fri Jun 13 11:55:10 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#76081] [PATCH v7 3/5] services: Add oci-service-type. Resent-From: Giacomo Leidi Original-Sender: "Debbugs-submit" Resent-CC: ludo@gnu.org, maxim.cournoyer@gmail.com, guix-patches@gnu.org Resent-Date: Tue, 04 Mar 2025 12:42:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 76081 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 76081@debbugs.gnu.org Cc: Giacomo Leidi , Ludovic =?UTF-8?Q?Court=C3=A8s?= , Maxim Cournoyer X-Debbugs-Original-Xcc: Ludovic =?UTF-8?Q?Court=C3=A8s?= , Maxim Cournoyer Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.17410920682476 (code B ref 76081); Tue, 04 Mar 2025 12:42:01 +0000 Received: (at 76081) by debbugs.gnu.org; 4 Mar 2025 12:41:08 +0000 Received: from localhost ([127.0.0.1]:56152 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tpRa8-0000ds-GY for submit@debbugs.gnu.org; Tue, 04 Mar 2025 07:41:08 -0500 Received: from confino.investici.org ([2a11:7980:1::2:0]:35699) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1tpRa5-0000dM-MD for 76081@debbugs.gnu.org; Tue, 04 Mar 2025 07:41:06 -0500 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org; s=stigmate; t=1741092064; bh=M+PjDOaJyxGTs8vBXtUuaOIziKnrWlv2zL4zzHQlBzQ=; h=From:To:Cc:Subject:Date:In-Reply-To:References:From; b=XtEwGVjOg+Art40rQ5ihhBVn4Dxqrvw4miAxXweWr6Qwk7uandWYKgvUGe1VSMADY yCJNhvUjb+Bub46WcOVMqqHtXSsKMCnmwKIlnJyeJFb54/KA4lrymReRUpCTrNO9Pz X/0m9xKftIJWkVfLB5JFTUNb1XAItpRrgPd85M+U= Received: from mx1.investici.org (unknown [127.0.0.1]) by confino.investici.org (Postfix) with ESMTP id 4Z6Zzh3X3hz115V; Tue, 4 Mar 2025 12:41:04 +0000 (UTC) Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19]) (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with ESMTPSA id 4Z6Zzh11Nwz1122; Tue, 4 Mar 2025 12:41:04 +0000 (UTC) From: Giacomo Leidi Date: Tue, 4 Mar 2025 13:40:00 +0100 Message-ID: <88bcb0d883db7ad2b1c1a997a3a4e852ef386ea1.1741092002.git.goodoldpaul@autistici.org> X-Mailer: git-send-email 2.48.1 In-Reply-To: References: MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" 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/services/containers.scm (%oci-supported-runtimes): New variable; (oci-runtime-cli): new variable; (oci-runtime-name): new variable; (oci-network-configuration): new variable; (oci-volume-configuration): new variable; (oci-configuration): new variable; (oci-extension): new variable; (oci-networks-shepherd-name): new variable; (oci-service-type): new variable; (oci-state->shepherd-services): new variable. * doc/guix.texi: Document it. * gnu/tests/containers.scm: Test it. * gnu/services/docker.scm: Deprecate the oci-container-service-type. Change-Id: I656b3db85832e42d53072fcbfb91d1226f39ef38 --- doc/guix.texi | 306 ++++++-- gnu/services/containers.scm | 1320 ++++++++++++++++++++++++++++++----- gnu/services/docker.scm | 37 +- gnu/tests/containers.scm | 999 +++++++++++++++++++++++++- 4 files changed, 2410 insertions(+), 252 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index 551bc52f7f6..be5c8cf8fad 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -42727,59 +42727,162 @@ Miscellaneous Services @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: given an -@acronym{Open Container Initiative, OCI} container image, it will run it in a +Should you wish to manage your @acronym{Open Container Initiative, OCI} containers +with the same consistent interface you use for your other Shepherd services, +@var{oci-service-type} is the tool to use: given an +OCI container image, it will run it in a Shepherd service. One example where this is useful: it lets you run services -that are available as Docker/OCI images but not yet packaged for Guix. +that are available as OCI images but not yet packaged for Guix. -@defvar oci-container-service-type +@defvar oci-service-type -This is a thin wrapper around Docker's CLI that executes OCI images backed +This is a thin wrapper around Docker's or Podman's CLI that executes OCI images backed processes as Shepherd Services. @lisp -(service oci-container-service-type - (list - (oci-container-configuration - (network "host") - (image - (oci-image - (repository "guile") - (tag "3") - (value (specifications->manifest '("guile"))) - (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile")) - #:max-layers 2)))) - (entrypoint "/bin/guile") - (command - '("-c" "(display \"hello!\n\")"))) - (oci-container-configuration - (image "prom/prometheus") - (ports - '(("9000" . "9000") - ("9090" . "9090")))) - (oci-container-configuration - (image "grafana/grafana:10.0.1") - (network "host") - (volumes - '("/var/lib/grafana:/var/lib/grafana"))))) +(simple-service 'oci-provisioning + oci-service-type + (oci-extension + (networks + (list + (oci-network-configuration (name "monitoring")))) + (containers + (list + (oci-container-configuration + (network "monitoring") + (image + (oci-image + (repository "guile") + (tag "3") + (value (specifications->manifest '("guile"))) + (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile")) + #:max-layers 2)))) + (entrypoint "/bin/guile") + (command + '("-c" "(display \"hello!\n\")"))) + (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 In this example three different Shepherd services are going to be added to the system. Each @code{oci-container-configuration} record translates to a -@code{docker run} invocation and its fields directly map to options. You can -refer to the -@url{https://docs.docker.com/engine/reference/commandline/run,upstream} -documentation for the semantics of each value. If the images are not found, -they will be -@url{https://docs.docker.com/engine/reference/commandline/pull/,pulled}. The +@command{docker run} or @command{podman run} invocation and its fields directly +map to options. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html,Podman} +upstream documentation for semantics of each value. If the images are not found, +they will be pulled. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/pull/,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-pull.1.html,Podman} +upstream documentation for semantics. The services with @code{(network "host")} are going to be attached to the host network and are supposed to behave like native processes with regard to networking. @end defvar +@c %start of fragment + +@deftp {Data Type} oci-configuration +Available @code{oci-configuration} fields are: + +@table @asis +@item @code{runtime} (default: @code{'docker}) (type: symbol) +The OCI runtime to use to run commands. It can be either @code{'docker} or +@code{'podman}. + +@item @code{runtime-cli} (type: maybe-package-or-string) +The OCI runtime command line to be installed in the system profile and used +to provision OCI resources. When unset it will default to @code{docker-cli} +package for the @code{'docker} runtime or to @code{podman} package for the +@code{'podman} runtime. When a string is passed it will be interpreted as the +absolute file-system path of the selected OCI runtime command. + +@item @code{runtime-extra-arguments} (default: @code{'()}) (type: list) +A list of strings, gexps or file-like objects that will be placed +after each @command{docker} or @command{podman} invokation. + +@item @code{user} (type: maybe-string) +The user name under whose authority OCI commands will be run. This field will +override the @code{user} field of @code{oci-configuration}. + +@item @code{group} (type: maybe-string) +The group name under whose authority OCI commands will be run. When +using the @code{'podman} OCI runtime, this field will be ignored and the +default group of the user configured in the @code{user} field will be used. +This field will override the @code{group} field of @code{oci-configuration}. + +@item @code{subuids-range} (type: maybe-subid-range) +An optional @code{subid-range} record allocating subuids for the user from +the @code{user} field. When unset, with the rootless Podman OCI runtime, it +defaults to @code{(subid-range (name "oci-container"))}. + +@item @code{subgids-range} (type: maybe-subid-range) +An optional @code{subid-range} record allocating subgids for the user from +the @code{user} field. When unset, with the rootless Podman OCI runtime, it +defaults to @code{(subid-range (name "oci-container"))}. + +@item @code{containers} (default: @code{'()}) (type: list-of-oci-containers) +The list of @code{oci-container-configuration} records representing the +containers to provision. Most users are supposed not to use this field and use +the @code{oci-extension} record instead. + +@item @code{networks} (default: @code{'()}) (type: list-of-oci-networks) +The list of @code{oci-network-configuration} records representing the +containers to provision. Most users are supposed not to use this field and use +the @code{oci-extension} record instead. + +@item @code{volumes} (default: @code{'()}) (type: list-of-oci-volumes) +The list of @code{oci-volumes-configuration} records representing the +containers to provision. Most users are supposed not to use this field and use +the @code{oci-extension} record instead. + +@item @code{verbose?} (default: @code{#f}) (type: boolean) +When true, additional output will be printed, allowing to better follow the +flow of execution. + +@end table + +@end deftp + + +@c %end of fragment + +@c %start of fragment + +@deftp {Data Type} oci-extension +Available @code{oci-extension} fields are: + +@table @asis +@item @code{containers} (default: @code{'()}) (type: list-of-oci-containers) +The list of @code{oci-container-configuration} records representing the +containers to provision. + +@item @code{networks} (default: @code{'()}) (type: list-of-oci-networks) +The list of @code{oci-network-configuration} records representing the +containers to provision. + +@item @code{volumes} (default: @code{'()}) (type: list-of-oci-volumes) +The list of @code{oci-volumes-configuration} records representing the +containers to provision. + +@end table + +@end deftp + + +@c %end of fragment + + @c %start of fragment @deftp {Data Type} oci-container-configuration @@ -42799,16 +42902,16 @@ Miscellaneous Services Overwrite the default entrypoint (@code{ENTRYPOINT}) of the image. @item @code{host-environment} (default: @code{'()}) (type: 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 +Set environment variables in the host environment where @command{docker run} +or @command{podman run} are invoked. This is especially useful to pass secrets +from the host to the container without having them on the OCI runtime command line, +for example: by setting the @code{MYSQL_PASSWORD} on the host and by passing @code{--env MYSQL_PASSWORD} through the @code{extra-arguments} field, it is possible to securely set values in the container environment. This field's value can be a list of pairs or strings, even mixed: @lisp -(list '("LANGUAGE\" . "eo:ca:eu") +(list '("LANGUAGE" . "eo:ca:eu") "JAVA_HOME=/opt/java") @end lisp @@ -42816,22 +42919,24 @@ Miscellaneous Services directly to @code{make-forkexec-constructor}. @item @code{environment} (default: @code{'()}) (type: list) -Set environment variables. This can be a list of pairs or strings, even mixed: +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 -@uref{https://docs.docker.com/engine/reference/commandline/run/#env,upstream} -documentation for semantics. +Pair members can be strings, gexps or file-like objects. Strings are passed +directly to the OCI runtime CLI. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run/#env,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#env-e-env,Podman} +upstream documentation for semantics. @item @code{image} (type: 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{oci-image} record. Strings are resolved by the OCI runtime, +and follow the usual format @code{myregistry.local:5000/testing/test-image:tag}. @item @code{provision} (default: @code{""}) (type: string) @@ -42859,7 +42964,7 @@ Miscellaneous Services by the service. @item @code{network} (default: @code{""}) (type: string) -Set a Docker network for the spawned container. +Set an OCI 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 @@ -42870,10 +42975,11 @@ Miscellaneous Services "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 -@uref{https://docs.docker.com/engine/reference/commandline/run/#publish,upstream} -documentation for semantics. +Pair members can be strings, gexps or file-like objects. Strings are passed +directly to the OCI runtime CLI. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run/#publish,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#publish-p-ip-hostport-containerport-protocol,Podman} +upstream documentation for semantics. @item @code{volumes} (default: @code{'()}) (type: list) Set volume mappings for the spawned container. This can be a @@ -42884,25 +42990,97 @@ Miscellaneous Services "/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 -@uref{https://docs.docker.com/engine/reference/commandline/run/#volume,upstream} -documentation for semantics. +Pair members can be strings, gexps or file-like objects. Strings are passed +directly to the OCI runtime CLI. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run/#volume,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#volume-v-source-volume-host-dir-container-dir-options,Podman} +upstream documentation for semantics. @item @code{container-user} (default: @code{""}) (type: 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. +@url{https://docs.docker.com/engine/reference/run/#user,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#user-u-user-group,Podman} +upstream documentation for semantics. @item @code{workdir} (default: @code{""}) (type: string) Set the current working directory for the spawned Shepherd service. You can refer to the -@url{https://docs.docker.com/engine/reference/run/#workdir,upstream} -documentation for semantics. +@url{https://docs.docker.com/engine/reference/run/#workdir,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#workdir-w-dir,Podman} +upstream documentation for semantics. + +@item @code{extra-arguments} (default: @code{'()}) (type: list) +A list of strings, gexps or file-like objects that will be directly passed +to the @command{docker run} or @command{podman run} invokation. + +@end table + +@end deftp + + +@c %end of fragment + +@c %start of fragment + +@deftp {Data Type} oci-network-configuration +Available @code{oci-network-configuration} fields are: + +@table @asis +@item @code{name} (type: string) +The name of the OCI network to provision. + +@item @code{driver} (type: maybe-string) +The driver to manage the network. + +@item @code{gateway} (type: maybe-string) +IPv4 or IPv6 gateway for the subnet. + +@item @code{internal?} (default: @code{#f}) (type: boolean) +Restrict external access to the network + +@item @code{ip-range} (type: maybe-string) +Allocate container ip from a sub-range in CIDR format. + +@item @code{ipam-driver} (type: maybe-string) +IP Address Management Driver. + +@item @code{ipv6?} (default: @code{#f}) (type: boolean) +Enable IPv6 networking. + +@item @code{subnet} (type: maybe-string) +Subnet in CIDR format that represents a network segment. + +@item @code{labels} (default: @code{'()}) (type: list) +The list of labels that will be used to tag the current volume. + +@item @code{extra-arguments} (default: @code{'()}) (type: list) +A list of strings, gexps or file-like objects that will be directly passed +to the @command{docker network create} or @command{podman network create} +invokation. + +@end table + +@end deftp + + +@c %end of fragment + +@c %start of fragment + +@deftp {Data Type} oci-volume-configuration +Available @code{oci-volume-configuration} fields are: + +@table @asis +@item @code{name} (type: string) +The name of the OCI volume to provision. + +@item @code{labels} (default: @code{'()}) (type: list) +The list of labels that will be used to tag the current volume. @item @code{extra-arguments} (default: @code{'()}) (type: list) -A list of strings, gexps or file-like objects that will be directly -passed to the @command{docker run} invocation. +A list of strings, gexps or file-like objects that will be directly passed +to the @command{docker volume create} or @command{podman volume create} +invokation. @end table diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm index 24f31c756b8..4600846ac3d 100644 --- a/gnu/services/containers.scm +++ b/gnu/services/containers.scm @@ -39,8 +39,10 @@ (define-module (gnu services containers) #:use-module (guix packages) #:use-module (guix profiles) #:use-module ((guix scripts pack) #:prefix pack:) + #:use-module (guix records) #:use-module (guix store) #:use-module (srfi srfi-1) + #:use-module (ice-9 format) #:use-module (ice-9 match) #:export (rootless-podman-configuration rootless-podman-configuration? @@ -96,8 +98,80 @@ (define-module (gnu services containers) oci-container-configuration-workdir oci-container-configuration-extra-arguments + list-of-oci-containers? + list-of-oci-networks? + list-of-oci-volumes? + + %oci-supported-runtimes + oci-sanitize-runtime + oci-runtime-system-environment + oci-runtime-system-extra-arguments + oci-runtime-system-group + oci-runtime-system-requirement + oci-runtime-cli + oci-runtime-system-cli + oci-runtime-home-cli + oci-runtime-name + oci-runtime-group + + oci-network-configuration + oci-network-configuration? + oci-network-configuration-fields + oci-network-configuration-name + oci-network-configuration-driver + oci-network-configuration-gateway + oci-network-configuration-internal? + oci-network-configuration-ip-range + oci-network-configuration-ipam-driver + oci-network-configuration-ipv6? + oci-network-configuration-subnet + oci-network-configuration-labels + oci-network-configuration-extra-arguments + + oci-volume-configuration + oci-volume-configuration? + oci-volume-configuration-fields + oci-volume-configuration-name + oci-volume-configuration-labels + oci-volume-configuration-extra-arguments + + oci-configuration + oci-configuration? + oci-configuration-runtime + oci-configuration-runtime-cli + oci-configuration-runtime-extra-arguments + oci-configuration-user + oci-configuration-group + oci-configuration-containers + oci-configuration-networks + oci-configuration-volumes + oci-configuration-verbose? + oci-configuration-valid? + + oci-extension + oci-extension? + oci-extension-fields + oci-extension-containers + oci-extension-networks + oci-extension-volumes + + oci-container-shepherd-name + oci-networks-shepherd-name + oci-networks-home-shepherd-name + oci-volumes-shepherd-name + oci-volumes-home-shepherd-name + oci-container-shepherd-service - %oci-container-accounts)) + oci-objects-merge-lst + oci-extension-merge + oci-service-extension-wrap-validate + oci-service-type + oci-service-accounts + oci-service-profile + oci-service-subids + oci-state->shepherd-services + oci-configuration->shepherd-services + oci-configuration-extend)) (define (gexp-or-string? value) (or (gexp? value) @@ -296,9 +370,42 @@ (define rootless-podman-service-type ;;; -;;; OCI container. +;;; OCI provisioning service. ;;; +(define %oci-supported-runtimes + '(docker podman)) + +(define (oci-runtime-system-requirement runtime) + "Return a list of Shepherd service names required by a given OCI runtime, +before it is able to run containers." + (if (eq? 'podman runtime) + '(cgroups2-fs-owner cgroups2-limits + rootless-podman-shared-root-fs user-processes) + '(dockerd user-processes))) + +(define (oci-runtime-name runtime) + "Return a human readable name for a given OCI runtime." + (if (eq? 'podman runtime) + "Podman" "Docker")) + +(define (oci-runtime-group runtime maybe-group) + "Implement the logic behind selection of the group that is to be used by +Shepherd to execute OCI commands." + (if (eq? maybe-group #f) + (if (eq? 'podman runtime) + "cgroup" + "docker") + maybe-group)) + +(define (oci-sanitize-runtime value) + (unless (member value %oci-supported-runtimes) + (raise + (formatted-message + (G_ "OCI runtime must be a symbol and one of ~a, +but ~a was found") %oci-supported-runtimes value))) + value) + (define (oci-sanitize-pair pair delimiter) (define (valid? member) (or (string? member) @@ -347,6 +454,11 @@ (define (oci-sanitize-volumes value) ;; '(("/mnt/dir" . "/dir") "/run/current-system/profile:/java") (oci-sanitize-mixed-list "volumes" value ":")) +(define (oci-sanitize-labels value) + ;; Expected spec format: + ;; '(("foo" . "bar") "foo=bar") + (oci-sanitize-mixed-list "labels" value "=")) + (define (oci-sanitize-shepherd-actions value) (map (lambda (el) @@ -374,10 +486,15 @@ (define (oci-sanitize-extra-arguments value) value)) (define (oci-image-reference image) - (if (string? image) - image - (string-append (oci-image-repository image) - ":" (oci-image-tag image)))) + "Return a string OCI image reference representing IMAGE." + (define reference + (if (string? image) + image + (string-append (oci-image-repository image) + ":" (oci-image-tag image)))) + (if (> (length (string-split reference #\/)) 1) + reference + (string-append "localhost/" reference))) (define (oci-lowerable-image? image) (or (manifest? image) @@ -392,7 +509,19 @@ (define (string-or-oci-image? image) (define list-of-symbols? (list-of symbol?)) +(define (list-of-oci-records? name predicate value) + (map + (lambda (el) + (if (predicate el) + el + (raise + (formatted-message + (G_ "~a contains an illegal value: ~a") name el)))) + value)) + (define-maybe/no-serialization string) +(define-maybe/no-serialization package) +(define-maybe/no-serialization subid-range) (define-configuration/no-serialization oci-image (repository @@ -437,11 +566,15 @@ (define-configuration/no-serialization oci-image (define-configuration/no-serialization oci-container-configuration (user - (string "oci-container") - "The user under whose authority docker commands will be run.") + (maybe-string) + "The user name under whose authority OCI commands will be run. This field will +override the @code{user} field of @code{oci-configuration}.") (group - (string "docker") - "The group under whose authority docker commands will be run.") + (maybe-string) + "The group name under whose authority OCI commands will be run. When +using the @code{'podman} OCI runtime, this field will be ignored and the +default group of the user configured in the @code{user} field will be used. +This field will override the @code{group} field of @code{oci-configuration}.") (command (list-of-strings '()) "Overwrite the default command (@code{CMD}) of the image.") @@ -451,9 +584,9 @@ (define-configuration/no-serialization oci-container-configuration (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 +or @command{podman run} are invoked. This is especially useful to pass secrets +from the host to the container without having them on the OCI runtime command line, +for example: by setting the @code{MYSQL_PASSWORD} on the host and by passing @code{--env MYSQL_PASSWORD} through the @code{extra-arguments} field, it is possible to securely set values in the container environment. This field's value can be a list of pairs or strings, even mixed: @@ -477,15 +610,16 @@ (define-configuration/no-serialization oci-container-configuration @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." +directly to the OCI runtime CLI. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run/#env,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#env-e-env,Podman} +upstream documentation for semantics." (sanitizer oci-sanitize-environment)) (image (string-or-oci-image) "The image used to build the container. It can be a string or an -@code{oci-image} record. Strings are resolved by the Docker -Engine, and follow the usual format +@code{oci-image} record. Strings are resolved by the OCI runtime, +and follow the usual format @code{myregistry.local:5000/testing/test-image:tag}.") (provision (maybe-string) @@ -514,7 +648,7 @@ (define-configuration/no-serialization oci-container-configuration (sanitizer oci-sanitize-shepherd-actions)) (network (maybe-string) - "Set a Docker network for the spawned container.") + "Set an OCI network for the spawned container.") (ports (list '()) "Set the port or port ranges to expose from the spawned container. This can @@ -526,9 +660,10 @@ (define-configuration/no-serialization oci-container-configuration @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." +directly to the OCI runtime CLI. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run/#publish,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#publish-p-ip-hostport-containerport-protocol,Podman} +upstream documentation for semantics." (sanitizer oci-sanitize-ports)) (volumes (list '()) @@ -541,71 +676,363 @@ (define-configuration/no-serialization oci-container-configuration @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." +directly to the OCI runtime CLI. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run/#volume,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#volume-v-source-volume-host-dir-container-dir-options,Podman} +upstream documentation for semantics." (sanitizer oci-sanitize-volumes)) (container-user (maybe-string) "Set the current user inside the spawned container. You can refer to the -@url{https://docs.docker.com/engine/reference/run/#user,upstream} -documentation for semantics.") +@url{https://docs.docker.com/engine/reference/run/#user,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#user-u-user-group,Podman} +upstream documentation for semantics.") (workdir (maybe-string) - "Set the current working for the spawned Shepherd service. + "Set the current working directory for the spawned Shepherd service. You can refer to the -@url{https://docs.docker.com/engine/reference/run/#workdir,upstream} -documentation for semantics.") +@url{https://docs.docker.com/engine/reference/run/#workdir,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#workdir-w-dir,Podman} +upstream documentation for semantics.") (extra-arguments (list '()) "A list of strings, gexps or file-like objects that will be directly passed -to the @command{docker run} invokation." +to the @command{docker run} or @command{podman 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 (list-of-oci-containers? value) + (list-of-oci-records? "containers" oci-container-configuration? value)) + +(define-configuration/no-serialization oci-volume-configuration + (name + (string) + "The name of the OCI volume to provision.") + (labels + (list '()) + "The list of labels that will be used to tag the current volume." + (sanitizer oci-sanitize-labels)) + (extra-arguments + (list '()) + "A list of strings, gexps or file-like objects that will be directly passed +to the @command{docker volume create} or @command{podman volume create} +invocation." + (sanitizer oci-sanitize-extra-arguments))) + +(define (list-of-oci-volumes? value) + (list-of-oci-records? "volumes" oci-volume-configuration? value)) + +(define-configuration/no-serialization oci-network-configuration + (name + (string) + "The name of the OCI network to provision.") + (driver + (maybe-string) + "The driver to manage the network.") + (gateway + (maybe-string) + "IPv4 or IPv6 gateway for the subnet.") + (internal? + (boolean #f) + "Restrict external access to the network") + (ip-range + (maybe-string) + "Allocate container ip from a sub-range in CIDR format.") + (ipam-driver + (maybe-string) + "IP Address Management Driver.") + (ipv6? + (boolean #f) + "Enable IPv6 networking.") + (subnet + (maybe-string) + "Subnet in CIDR format that represents a network segment.") + (labels + (list '()) + "The list of labels that will be used to tag the current volume." + (sanitizer oci-sanitize-labels)) + (extra-arguments + (list '()) + "A list of strings, gexps or file-like objects that will be directly passed +to the @command{docker network create} or @command{podman network create} +invocation." + (sanitizer oci-sanitize-extra-arguments))) + +(define (list-of-oci-networks? value) + (list-of-oci-records? "networks" oci-network-configuration? value)) + +(define-record-type* + oci-configuration + make-oci-configuration + oci-configuration? + this-oci-configuration + + (runtime oci-configuration-runtime + (default 'docker)) + (runtime-cli oci-configuration-runtime-cli + (default #f)) ; package or string + (runtime-extra-arguments oci-configuration-runtime-extra-arguments ; strings or gexps + (default '())) ; or file-like objects + (user oci-configuration-user + (default "oci-container")) + (group oci-configuration-group ; string + (default #f)) + (subuids-range oci-configuration-subuids-range ; subid-range + (default #f)) + (subgids-range oci-configuration-subgids-range ; subid-range + (default #f)) + (containers oci-configuration-containers ; oci-container-configurations + (default '())) + (networks oci-configuration-networks ; oci-network-configurations + (default '())) + (volumes oci-configuration-volumes ; oci-volume-configurations + (default '())) + (verbose? oci-configuration-verbose? + (default #f)) + (home-service? oci-configuration-home-service? + (default for-home?) (innate))) + +(define (package-or-string? value) + (or (package? value) (string? value))) + +(define (oci-configuration-valid? config) + (define runtime-cli + (oci-configuration-runtime-cli config)) + (define group + (oci-configuration-group config)) + (define subuids-range + (oci-configuration-subuids-range config)) + (define subgids-range + (oci-configuration-subgids-range config)) + (and + (symbol? + (oci-sanitize-runtime (oci-configuration-runtime config))) + (or (eq? runtime-cli #f) + (package-or-string? runtime-cli)) + (list? (oci-configuration-runtime-extra-arguments config)) + (string? (oci-configuration-user config)) + (or (eq? group #f) + (string? group)) + (or (eq? subuids-range #f) + (subid-range? subuids-range)) + (or (eq? subgids-range #f) + (subid-range? subgids-range)) + (list-of-oci-containers? + (oci-configuration-containers config)) + (list-of-oci-networks? + (oci-configuration-networks config)) + (list-of-oci-volumes? + (oci-configuration-volumes config)) + (boolean? + (oci-configuration-verbose? config)) + (boolean? + (oci-configuration-home-service? config)))) + +(define (oci-runtime-system-environment runtime user) + (if (eq? runtime 'podman) + (list + #~(string-append + "HOME=" (passwd:dir (getpwnam #$user)))) + #~())) + +(define (oci-runtime-system-group runtime user group) + (if (eq? runtime 'podman) + #~(group:name + (getgrgid + (passwd:gid + (getpwnam #$user)))) + group)) + +(define (oci-runtime-cli runtime runtime-cli path) + "Return a gexp that, when lowered, evaluates to the file system path of the OCI +runtime command requested by the user." + (if (string? runtime-cli) + ;; It is a user defined absolute path + runtime-cli + #~(string-append + #$(if (eq? runtime-cli #f) + path + runtime-cli) + #$(if (eq? 'podman runtime) + "/bin/podman" + "/bin/docker")))) + +(define* (oci-runtime-system-cli config #:key (path "/run/current-system/profile")) + (let ((runtime-cli + (oci-configuration-runtime-cli config)) + (runtime + (oci-configuration-runtime config))) + (oci-runtime-cli runtime runtime-cli path))) + +(define (oci-runtime-home-cli config) + (let ((runtime-cli + (oci-configuration-runtime-cli config)) + (runtime + (oci-configuration-runtime config))) + (oci-runtime-cli runtime runtime-cli + (string-append (getenv "HOME") + "/.guix-home/profile")))) + +(define-configuration/no-serialization oci-extension + (containers + (list-of-oci-containers '()) + "The list of @code{oci-container-configuration} records representing the +containers to add.") + (networks + (list-of-oci-networks '()) + "The list of @code{oci-network-configuration} records representing the +networks to add.") + (volumes + (list-of-oci-volumes '()) + "The list of @code{oci-volume-configuration} records representing the +volumes to add.")) + +(define (oci-image->container-name image) + "Infer the name of an OCI backed Shepherd service from its OCI image." + (basename + (if (string? image) + (first (string-split image #\:)) + (oci-image-repository image)))) + +(define (oci-object-command-shepherd-action object-name invocation) + "Return a Shepherd action printing a given INVOCATION of an OCI command for the +given OBJECT-NAME." + (shepherd-action + (name 'command-line) + (documentation + (format #f "Prints ~a's OCI runtime command line invocation." + object-name)) + (procedure + #~(lambda _ + (format #t "~a~%" #$invocation))))) + +(define (oci-container-shepherd-name runtime config) + "Return the name of an OCI backed Shepherd service based on CONFIG. +The name configured in the configuration record is returned when +CONFIG's name field has a value, otherwise a name is inferred from CONFIG's +image field." + (define name (oci-container-configuration-provision config)) + (define image (oci-container-configuration-image config)) + + (if (maybe-value-set? name) + name + (string-append (symbol->string runtime) "-" + (oci-image->container-name image)))) + +(define (oci-networks-shepherd-name runtime) + "Return the name of the OCI networks provisioning Shepherd service based on +RUNTIME." + (string-append (symbol->string runtime) "-networks")) + +(define (oci-volumes-shepherd-name runtime) + "Return the name of the OCI volumes provisioning Shepherd service based on +RUNTIME." + (string-append (symbol->string runtime) "-volumes")) + +(define (oci-networks-home-shepherd-name runtime) + "Return the name of the OCI volumes provisioning Home Shepherd service based on +RUNTIME." + (string-append "home-" (oci-networks-shepherd-name runtime))) + +(define (oci-volumes-home-shepherd-name runtime) + "Return the name of the OCI volumes provisioning Home Shepherd service based on +RUNTIME." + (string-append "home-" (oci-volumes-shepherd-name runtime))) + +(define (oci-container-configuration->options config) + "Map CONFIG, an oci-container-configuration record, to a gexp that, upon +lowering, will be evaluated to a list of strings containing command line options +for the OCI runtime run command." + (let ((entrypoint + (oci-container-configuration-entrypoint config)) + (network + (oci-container-configuration-network config)) + (user + (oci-container-configuration-container-user config)) + (workdir + (oci-container-configuration-workdir config))) + (apply append + (filter (compose not unspecified?) + `(,(if (maybe-value-set? entrypoint) + `("--entrypoint" ,entrypoint) + '()) + ,(append-map + (lambda (spec) + (list "--env" spec)) + (oci-container-configuration-environment config)) + ,(if (maybe-value-set? network) + `("--network" ,network) + '()) + ,(if (maybe-value-set? user) + `("--user" ,user) + '()) + ,(if (maybe-value-set? workdir) + `("--workdir" ,workdir) + '()) + ,(append-map + (lambda (spec) + (list "-p" spec)) + (oci-container-configuration-ports config)) + ,(append-map + (lambda (spec) + (list "-v" spec)) + (oci-container-configuration-volumes config))))))) + +(define (oci-network-configuration->options config) + "Map CONFIG, an oci-network-configuration record, to a gexp that, upon +lowering, will be evaluated to a list of strings containing command line options +for the OCI runtime network create command." + (let ((driver (oci-network-configuration-driver config)) + (gateway + (oci-network-configuration-gateway config)) + (internal? + (oci-network-configuration-internal? config)) + (ip-range + (oci-network-configuration-ip-range config)) + (ipam-driver + (oci-network-configuration-ipam-driver config)) + (ipv6? + (oci-network-configuration-ipv6? config)) + (subnet + (oci-network-configuration-subnet config))) + (apply append + (filter (compose not unspecified?) + `(,(if (maybe-value-set? driver) + `("--driver" ,driver) + '()) + ,(if (maybe-value-set? gateway) + `("--gateway" ,gateway) + '()) + ,(if internal? + `("--internal") + '()) + ,(if (maybe-value-set? ip-range) + `("--ip-range" ,ip-range) + '()) + ,(if (maybe-value-set? ipam-driver) + `("--ipam-driver" ,ipam-driver) + '()) + ,(if ipv6? + `("--ipv6") + '()) + ,(if (maybe-value-set? subnet) + `("--subnet" ,subnet) + '()) + ,(append-map + (lambda (spec) + (list "--label" spec)) + (oci-network-configuration-labels config))))))) + +(define (oci-volume-configuration->options config) + "Map CONFIG, an oci-volume-configuration record, to a gexp that, upon +lowering, will be evaluated to a list of strings containing command line options +for the OCI runtime volume create command." + (append-map + (lambda (spec) + (list "--label" spec)) + (oci-volume-configuration-labels config))) (define (lower-operating-system os target system) + "Lower OS, an operating-system record, into a tarball containing an OCI image." (mlet* %store-monad ((tarball (lower-object @@ -614,24 +1041,11 @@ (define (lower-operating-system os target 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))))) - +(define (lower-manifest name value options image-reference + target system grafts?) + "Lower VALUE, a manifest record, into a tarball containing an OCI image." (mlet* %store-monad - ((_ (set-grafting - (oci-image-grafts? image))) + ((_ (set-grafting grafts?)) (guile (set-guile-for-build (default-guile))) (profile (profile-derivation value @@ -642,14 +1056,11 @@ (define (lower-manifest name image target system) (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 (lower-oci-image-state name value options reference + image-target image-system grafts?) (define target (if (maybe-value-set? image-target) image-target @@ -662,7 +1073,8 @@ (define (lower-oci-image name image) (run-with-store store (match value ((? manifest? value) - (lower-manifest name image target system)) + (lower-manifest name value options reference + target system grafts?)) ((? operating-system? value) (lower-operating-system value target system)) ((or (? gexp? value) @@ -677,113 +1089,671 @@ (define (lower-oci-image name image) #: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))) +(define (lower-oci-image name image) + "Lower IMAGE, a oci-image record, into a tarball containing an OCI image." + (lower-oci-image-state + name + (oci-image-value image) + (oci-image-pack-options image) + (oci-image-reference image) + (oci-image-target image) + (oci-image-system image) + (oci-image-grafts? image))) + +(define (oci-object-exists? runtime runtime-cli object verbose?) + #~(lambda* (name #:key (format-string "{{.Name}}")) + (use-modules (ice-9 format) + (ice-9 match) + (ice-9 popen) + (ice-9 rdelim) + (srfi srfi-1)) + + (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))) + + #$(if (eq? runtime 'podman) + #~(let ((command + (list #$runtime-cli + #$object "exists" name))) + (when #$verbose? + (format #t "Running~{ ~a~}~%" command)) + (define exit-code (status:exit-val (apply system* command))) + (when #$verbose? + (format #t "Exit code: ~a~%" exit-code)) + (equal? EXIT_SUCCESS exit-code)) + #~(let ((command + (string-append #$runtime-cli + " " #$object " ls --format " + "\"" format-string "\""))) + (when #$verbose? + (format #t "Running ~a~%" command)) + (member name (read-lines (open-input-pipe command))))))) + +(define* (oci-image-loader runtime runtime-cli name image tag #:key (verbose? #f)) + "Return a file-like object that, once lowered, will evaluate to a program able +to load IMAGE through RUNTIME-CLI and to tag it with TAG afterwards." + (let ((tarball (lower-oci-image name image))) (with-imported-modules '((guix build utils)) - (program-file (format #f "~a-image-loader" name) + (program-file + (format #f "~a-image-loader" name) #~(begin (use-modules (guix build utils) + (ice-9 match) (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)) + (ice-9 rdelim) + (srfi srfi-1)) + (define object-exists? + #$(oci-object-exists? runtime runtime-cli "image" verbose?)) + (define load-command + (string-append #$runtime-cli + " load -i " #$tarball)) + + (if (object-exists? #$tag #:format-string "{{.Repository}}:{{.Tag}}") + (format #t "~a image already exists, skipping.~%" #$tag) + (begin + (format #t "Loading image for ~a from ~a...~%" #$name #$tarball) + (when #$verbose? + (format #t "Running ~a~%" load-command)) + (let ((line (read-line + (open-input-pipe load-command)))) + (unless (or (eof-object? line) + (string-null? line)) + (format #t "~a~%" line) + (let* ((repository&tag + (string-drop line + (string-length + "Loaded image: "))) + (tag-command + (list #$runtime-cli "tag" repository&tag #$tag)) + (drop-old-tag-command + (list #$runtime-cli "image" "rm" "-f" repository&tag))) + + (unless (string=? repository&tag #$tag) + (when #$verbose? + (format #t "Running~{ ~a~}~%" tag-command)) + + (let ((exit-code + (status:exit-val (apply system* tag-command)))) + (format #t "Tagged ~a with ~a...~%" #$tarball #$tag) + + (when #$verbose? + (format #t "Exit code: ~a~%" exit-code)) + + (when (equal? EXIT_SUCCESS exit-code) + (when #$verbose? + (format #t "Running~{ ~a~}~%" drop-old-tag-command)) + (let ((drop-exit-code + (status:exit-val (apply system* drop-old-tag-command)))) + (when #$verbose? + (format #t "Exit code: ~a~%" drop-exit-code)))))))))))))))) + +(define (oci-container-run-invocation runtime runtime-cli name command image-reference + options runtime-extra-arguments run-extra-arguments) + "Return a list representing the OCI runtime +invocation for running containers." + ;; run [OPTIONS] IMAGE [COMMAND] [ARG...] + `(,runtime-cli ,@runtime-extra-arguments "run" "--rm" + ,@(if (eq? runtime 'podman) + ;; This is because podman takes some time to + ;; release container names. --replace seems + ;; to be required to be able to restart services. + '("--replace") + '()) + "--name" ,name + ,@options ,@run-extra-arguments + ,image-reference ,@command)) + +(define* (oci-container-entrypoint runtime runtime-cli name image image-reference + invocation #:key (verbose? #f)) + "Return a file-like object that, once lowered, will evaluate to the entrypoint +for the Shepherd service that will run IMAGE through RUNTIME-CLI." + (program-file + (string-append "oci-entrypoint-" name) + #~(begin + (use-modules (ice-9 format) + (srfi srfi-1)) + (when #$verbose? + (format #t "Running in verbose mode...~%")) + (define invocation (list #$@invocation)) + #$@(if (oci-image? image) + #~((system* + #$(oci-image-loader + runtime runtime-cli name image + image-reference #:verbose? verbose?))) + #~()) + (when #$verbose? + (format #t "Running~{ ~a~}~%" invocation)) + (apply execlp `(,(first invocation) ,@invocation))))) + +(define* (oci-container-shepherd-service runtime runtime-cli config + #:key + (runtime-environment #~()) + (runtime-extra-arguments '()) + (oci-requirement '()) + (user #f) + (group #f) + (verbose? #f)) + "Return a Shepherd service object that will run the OCI container represented +by CONFIG through RUNTIME-CLI." + (let* ((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)) + (maybe-user (oci-container-configuration-user config)) + (maybe-group (oci-container-configuration-group config)) + (user (if (maybe-value-set? maybe-user) + maybe-user + user)) + (group (if (maybe-value-set? maybe-group) + maybe-group + group)) (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)) + (name + (oci-container-shepherd-name runtime config)) (extra-arguments - (oci-container-configuration-extra-arguments config))) + (oci-container-configuration-extra-arguments config)) + (invocation + (oci-container-run-invocation + runtime runtime-cli name command image-reference + options runtime-extra-arguments extra-arguments)) + (wrap-command + (lambda (command) + (if (eq? runtime 'podman) + (list + "/bin/sh" "-l" "-c" + #~(string-join (list #$@command) " ")) + command))) + (container-action + (lambda* (command #:key (environment-variables #f)) + #~(lambda _ + (fork+exec-command + (list #$@command) + #$@(if user (list #:user user) '()) + #$@(if group (list #:group group) '()) + #$@(if (maybe-value-set? log-file) + (list #:log-file log-file) + '()) + #$@(if (and user (eq? runtime 'podman)) + (list #:directory + #~(passwd:dir (getpwnam #$user))) + '()) + #$@(if environment-variables + (list #:environment-variables + environment-variables) + '())))))) (shepherd-service (provision `(,(string->symbol name))) - (requirement `(dockerd user-processes ,@requirement)) + (requirement `(,@oci-requirement + ,@requirement)) (respawn? respawn?) (auto-start? auto-start?) (documentation (string-append - "Docker backed Shepherd service for " + (oci-runtime-name runtime) " 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)))) + (container-action + (list (oci-container-entrypoint + runtime runtime-cli name image image-reference + invocation #:verbose? verbose?)) + #:environment-variables + #~(append + (list #$@host-environment) + (list #$@runtime-environment)))) (stop - #~(lambda _ - (invoke #$docker "rm" "-f" #$name))) + (container-action + (wrap-command + (list runtime-cli "rm" "-f" name)))) (actions - (if (oci-image? image) - '() - (append + (append + (list + (oci-object-command-shepherd-action + name #~(string-join (list #$@invocation) " "))) + (if (oci-image? image) + '() (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 + (let ((service-name name)) + (shepherd-action + (name 'pull) + (documentation + (format #f "Pull ~a's image (~a)." + service-name image)) + (procedure + (container-action + (wrap-command + (list runtime-cli "pull" image)))))))) + actions))))) + +(define (oci-object-create-invocation object runtime-cli name options + runtime-extra-arguments + create-extra-arguments) + "Return a gexp that, upon lowering, will evaluate to the OCI runtime +invocation for creating networks and volumes." + ;; network|volume create [options] [NAME] + #~(list #$runtime-cli #$@runtime-extra-arguments #$object "create" + #$@options #$@create-extra-arguments #$name)) + +(define (format-oci-invocations invocations) + "Return a gexp that, upon lowering, will evaluate to a formatted message +containing the INVOCATIONS that the OCI runtime will execute to provision +networks or volumes." + #~(string-join (map (lambda (i) (string-join i " ")) + (list #$@invocations)) + "\n")) + +(define* (oci-object-create-script object runtime runtime-cli invocations + #:key (verbose? #f)) + "Return a file-like object that, once lowered, will evaluate to a program able +to create OCI networks and volumes through RUNTIME-CLI." + (define runtime-string (symbol->string runtime)) + (program-file + (string-append runtime-string "-" object "s-create.scm") + #~(begin + (use-modules (ice-9 format) + (ice-9 match) + (ice-9 popen) + (ice-9 rdelim) + (srfi srfi-1)) + + (define object-exists? + #$(oci-object-exists? runtime runtime-cli object verbose?)) + + (for-each + (lambda (invocation) + (define name (last invocation)) + (if (object-exists? name) + (format #t "~a ~a ~a already exists, skipping creation.~%" + #$(oci-runtime-name runtime) name #$object) + (begin + (when #$verbose? + (format #t "Running~{ ~a~}~%" invocation)) + (let ((exit-code (status:exit-val (apply system* invocation)))) + (when #$verbose? + (format #t "Exit code: ~a~%" exit-code)))))) + (list #$@invocations))))) + +(define* (oci-object-shepherd-service object runtime runtime-cli name requirement invocations + #:key + (runtime-environment #~()) + (user #f) + (group #f) + (verbose? #f)) + "Return a Shepherd service object that will create the OBJECTs represented +by INVOCATIONS through RUNTIME-CLI." + (shepherd-service (provision `(,(string->symbol name))) + (requirement requirement) + (one-shot? #t) + (documentation + (string-append + (oci-runtime-name runtime) " " object + " provisioning service")) + (start + #~(lambda _ + (fork+exec-command + (list + #$(oci-object-create-script + object runtime runtime-cli + invocations + #:verbose? verbose?)) + #$@(if user (list #:user user) '()) + #$@(if group (list #:group group) '()) + #:environment-variables + (list #$@runtime-environment)))) + (actions + (list + (oci-object-command-shepherd-action + name (format-oci-invocations invocations)))))) + +(define* (oci-networks-shepherd-service runtime runtime-cli name networks + #:key (user #f) (group #f) (verbose? #f) + (runtime-extra-arguments '()) + (runtime-environment #~()) + (runtime-requirement '())) + "Return a Shepherd service object that will create the networks represented +in CONFIG." + (let ((invocations + (map + (lambda (network) + (oci-object-create-invocation + "network" runtime-cli + (oci-network-configuration-name network) + (oci-network-configuration->options network) + runtime-extra-arguments + (oci-network-configuration-extra-arguments network))) + networks))) + + (oci-object-shepherd-service + "network" runtime runtime-cli name + runtime-requirement invocations + #:user user #:group group #:runtime-environment runtime-environment + #:verbose? verbose?))) + +(define* (oci-volumes-shepherd-service runtime runtime-cli name volumes + #:key (user #f) (group #f) (verbose? #f) + (runtime-extra-arguments '()) + (runtime-environment #~()) + (runtime-requirement '())) + "Return a Shepherd service object that will create the volumes represented +in CONFIG." + (let ((invocations + (map + (lambda (volume) + (oci-object-create-invocation + "volume" runtime-cli + (oci-volume-configuration-name volume) + (oci-volume-configuration->options volume) + runtime-extra-arguments + (oci-volume-configuration-extra-arguments volume))) + volumes))) + + (oci-object-shepherd-service + "volume" runtime runtime-cli name runtime-requirement invocations + #:user user #:group group #:runtime-environment runtime-environment + #:verbose? verbose?))) + +(define (oci-service-accounts config) + (define user (oci-configuration-user config)) + (define maybe-group (oci-configuration-group config)) + (define runtime (oci-configuration-runtime config)) (list (user-account - (name "oci-container") + (name user) (comment "OCI services account") - (group "docker") - (system? #t) - (home-directory "/var/empty") + (group "users") + (supplementary-groups + (list (oci-runtime-group runtime maybe-group))) + (system? (eq? 'docker runtime)) + (home-directory (if (eq? 'podman runtime) + (string-append "/home/" user) + "/var/empty")) + (create-home-directory? (eq? 'podman runtime)) (shell (file-append shadow "/sbin/nologin"))))) + +(define* (oci-state->shepherd-services runtime runtime-cli containers networks volumes + #:key (user #f) (group #f) (verbose? #f) + (networks-name #f) (volumes-name #f) + (runtime-extra-arguments '()) + (runtime-environment #~()) + (runtime-requirement '()) + (containers-requirement '()) + (networks-requirement '()) + (volumes-requirement '())) + "Returns a list of Shepherd services based on the input OCI state." + (let* ((networks-name + (if (string? networks-name) + networks-name + (oci-networks-shepherd-name runtime))) + (networks? + (> (length networks) 0)) + (networks-service + (if networks? + (list + (string->symbol networks-name)) + '())) + (volumes-name + (if (string? volumes-name) + volumes-name + (oci-volumes-shepherd-name runtime))) + (volumes? + (> (length volumes) 0)) + (volumes-service + (if volumes? + (list (string->symbol volumes-name)) + '()))) + (append + (map + (lambda (c) + (oci-container-shepherd-service + runtime runtime-cli c + #:user user + #:group group + #:runtime-environment runtime-environment + #:runtime-extra-arguments runtime-extra-arguments + #:oci-requirement + (append containers-requirement + runtime-requirement + networks-service + volumes-service) + #:verbose? verbose?)) + containers) + (if networks? + (list + (oci-networks-shepherd-service + runtime runtime-cli + networks-name networks + #:user user #:group group + #:runtime-extra-arguments runtime-extra-arguments + #:runtime-environment runtime-environment + #:runtime-requirement (append networks-requirement + runtime-requirement) + #:verbose? verbose?)) + '()) + (if volumes? + (list + (oci-volumes-shepherd-service + runtime runtime-cli + volumes-name volumes + #:user user #:group group + #:runtime-extra-arguments runtime-extra-arguments + #:runtime-environment runtime-environment + #:runtime-requirement (append runtime-requirement + volumes-requirement) + #:verbose? verbose?)) + '())))) + +(define (oci-configuration->shepherd-services config) + (let* ((runtime (oci-configuration-runtime config)) + (system-runtime-cli + (oci-runtime-system-cli config)) + (home-runtime-cli + (oci-runtime-home-cli config)) + (runtime-extra-arguments + (oci-configuration-runtime-extra-arguments config)) + (containers (oci-configuration-containers config)) + (networks (oci-configuration-networks config)) + (volumes (oci-configuration-volumes config)) + (user (oci-configuration-user config)) + (group (oci-runtime-group + runtime (oci-configuration-group config))) + (verbose? (oci-configuration-verbose? config)) + (home-service? + (oci-configuration-home-service? config))) + (if home-service? + (oci-state->shepherd-services runtime home-runtime-cli containers networks volumes + #:verbose? verbose? + #:networks-name + (oci-networks-home-shepherd-name runtime) + #:volumes-name + (oci-volumes-home-shepherd-name runtime)) + (oci-state->shepherd-services runtime system-runtime-cli containers networks volumes + #:user user + #:group + (oci-runtime-system-group runtime user group) + #:verbose? verbose? + #:runtime-extra-arguments + runtime-extra-arguments + #:runtime-environment + (oci-runtime-system-environment runtime user) + #:runtime-requirement + (oci-runtime-system-requirement runtime) + #:networks-requirement '(networking))))) + +(define (oci-service-subids config) + "Return a subids-extension record representing subuids and subgids required by +the rootless Podman backend." + (define (delete-duplicate-ranges ranges) + (delete-duplicates ranges + (lambda args + (apply string=? (map subid-range-name ranges))))) + (define runtime + (oci-configuration-runtime config)) + (define user + (oci-configuration-user config)) + (define subgids (oci-configuration-subgids-range config)) + (define subuids (oci-configuration-subuids-range config)) + (define container-users + (filter (lambda (range) + (and (maybe-value-set? + (subid-range-name range)) + (not (string=? (subid-range-name range) user)))) + (map (lambda (container) + (subid-range + (name + (oci-container-configuration-user container)))) + (oci-configuration-containers config)))) + (define subgid-ranges + (delete-duplicate-ranges + (cons + (if (eq? subgids #f) + (subid-range (name user)) + subgids) + container-users))) + (define subuid-ranges + (delete-duplicate-ranges + (cons + (if (eq? subuids #f) + (subid-range (name user)) + subuids) + container-users))) + + (if (eq? 'podman runtime) + (subids-extension + (subgids + subgid-ranges) + (subuids + subuid-ranges)) + (subids-extension))) + +(define (oci-objects-merge-lst a b object get-name) + (define (contains? value lst) + (member value (map get-name lst))) + (let loop ((merged '()) + (lst (append a b))) + (if (null? lst) + merged + (loop + (let ((element (car lst))) + (when (contains? element merged) + (raise + (formatted-message + (G_ "Duplicated ~a: ~a. ~as names should be unique, please +remove the duplicate.") object (get-name element) object))) + (cons element merged)) + (cdr lst))))) + +(define (oci-extension-merge a b) + (oci-extension + (containers (oci-objects-merge-lst + (oci-extension-containers a) + (oci-extension-containers b) + "container" + (lambda (config) + (define maybe-name (oci-container-configuration-provision config)) + (if (maybe-value-set? maybe-name) + maybe-name + (oci-image->container-name + (oci-container-configuration-image config)))))) + (networks (oci-objects-merge-lst + (oci-extension-networks a) + (oci-extension-networks b) + "network" + oci-network-configuration-name)) + (volumes (oci-objects-merge-lst + (oci-extension-volumes a) + (oci-extension-volumes b) + "volume" + oci-volume-configuration-name)))) + +(define (oci-service-profile runtime runtime-cli) + `(,bash-minimal + ,@(if (string? runtime-cli) + '() + (list + (cond + ((not (eq? runtime-cli #f)) + runtime-cli) + ((eq? 'podman runtime) + podman) + (else + docker-cli)))))) + +(define (oci-service-extension-wrap-validate extension) + (lambda (config) + (if (oci-configuration-valid? config) + (extension config) + (raise + (formatted-message + (G_ "Invalide oci-configuration ~a.") config))))) + +(define (oci-configuration-extend config extension) + (oci-configuration + (inherit config) + (containers + (oci-objects-merge-lst + (oci-configuration-containers config) + (oci-extension-containers extension) + "container" + (lambda (oci-config) + (define runtime + (oci-configuration-runtime config)) + (oci-container-shepherd-name runtime oci-config)))) + (networks (oci-objects-merge-lst + (oci-configuration-networks config) + (oci-extension-networks extension) + "network" + oci-network-configuration-name)) + (volumes (oci-objects-merge-lst + (oci-configuration-volumes config) + (oci-extension-volumes extension) + "volume" + oci-volume-configuration-name)))) + +(define oci-service-type + (service-type (name 'oci) + (extensions + (list + (service-extension profile-service-type + (oci-service-extension-wrap-validate + (lambda (config) + (let ((runtime-cli + (oci-configuration-runtime-cli config)) + (runtime + (oci-configuration-runtime config))) + (oci-service-profile runtime runtime-cli))))) + (service-extension subids-service-type + (oci-service-extension-wrap-validate + oci-service-subids)) + (service-extension account-service-type + (oci-service-extension-wrap-validate + oci-service-accounts)) + (service-extension shepherd-root-service-type + (oci-service-extension-wrap-validate + oci-configuration->shepherd-services)))) + ;; Concatenate OCI object lists. + (compose (lambda (args) + (fold oci-extension-merge + (oci-extension) + args))) + (extend oci-configuration-extend) + (default-value (oci-configuration)) + (description + "This service implements the provisioning of OCI object such +as containers, networks and volumes."))) diff --git a/gnu/services/docker.scm b/gnu/services/docker.scm index 828ceea313a..125e748bb0e 100644 --- a/gnu/services/docker.scm +++ b/gnu/services/docker.scm @@ -31,7 +31,10 @@ (define-module (gnu services docker) #:use-module (gnu system shadow) #:use-module (gnu packages docker) #:use-module (gnu packages linux) ;singularity + #:use-module (guix deprecation) + #:use-module (guix diagnostics) #:use-module (guix gexp) + #:use-module (guix i18n) #:use-module (guix records) #:use-module (srfi srfi-1) #:use-module (ice-9 format) @@ -67,16 +70,18 @@ (define-module (gnu services docker) 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) + oci-container-configuration-extra-arguments) #:export (containerd-configuration containerd-service-type docker-configuration docker-service-type singularity-service-type - oci-container-service-type)) + ;; for backwards compatibility, until the + ;; oci-container-service-type is fully deprecated + oci-container-shepherd-service + oci-container-service-type + %oci-container-accounts)) (define-maybe file-like) @@ -297,17 +302,25 @@ (define singularity-service-type ;;; OCI container. ;;; -(define (configs->shepherd-services configs) - (map oci-container-shepherd-service configs)) +;; for backwards compatibility, until the +;; oci-container-service-type is fully deprecated +(define-deprecated (oci-container-shepherd-service config) + oci-service-type + ((@ (gnu services containers) oci-container-shepherd-service) + 'docker config)) +(define %oci-container-accounts + (filter user-account? (oci-service-accounts (oci-configuration)))) (define oci-container-service-type (service-type (name 'oci-container) - (extensions (list (service-extension profile-service-type - (lambda _ (list docker-cli))) - (service-extension account-service-type - (const %oci-container-accounts)) - (service-extension shepherd-root-service-type - configs->shepherd-services))) + (extensions + (list (service-extension oci-service-type + (lambda (containers) + (warning + (G_ + "'oci-container-service-type' is deprecated, use 'oci-service-type' instead~%")) + (oci-extension + (containers containers)))))) (default-value '()) (extend append) (compose concatenate) diff --git a/gnu/tests/containers.scm b/gnu/tests/containers.scm index 0ecc8ddb126..5e6f39387e7 100644 --- a/gnu/tests/containers.scm +++ b/gnu/tests/containers.scm @@ -27,6 +27,9 @@ (define-module (gnu tests containers) #: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 @@ (define-module (gnu tests containers) #: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 @@ -345,3 +350,995 @@ (define %test-rootless-podman (name "rootless-podman") (description "Test rootless Podman service.") (value (build-tarball&run-rootless-podman-test)))) + + +(define %oci-rootless-podman-os + (simple-operating-system + (service dhcp-client-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-configuration (name "my-network")))) + (volumes + (list (oci-volume-configuration (name "my-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)(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 services herd) + (guix combinators)))) + + (define vm + (virtual-machine + (operating-system os) + (volatile? #f) + (memory-size 1024) + (disk-image-size (* 3000 (expt 2 20))) + (port-forwardings '()))) + + (define test + (with-imported-modules '((gnu build marionette)) + #~(begin + (use-modules (srfi srfi-11) (srfi srfi-64) + (gnu build marionette)) + + (define marionette + ;; Relax timeout to accommodate older systems and + ;; allow for pulling the image. + (make-marionette (list #$vm) #:timeout 60)) + (define out-dir "/tmp") + + (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 "rootless-podman services started successfully" + (begin + (define (run-test) + (marionette-eval + `(begin + (use-modules (ice-9 popen) + (ice-9 match) + (ice-9 rdelim)) + + (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 slurp + (lambda args + (let* ((port (apply open-pipe* OPEN_READ args)) + (output (read-lines port)) + (status (close-pipe port))) + output))) + (let* ((bash + ,(string-append #$bash "/bin/bash")) + (response1 + (slurp bash "-c" + (string-append "ls -la /sys/fs/cgroup | " + "grep -E ' \\./?$' | awk '{ print $4 }'"))) + (response2 (slurp bash "-c" + (string-append "ls -l /sys/fs/cgroup/cgroup" + ".{procs,subtree_control,threads} | " + "awk '{ print $4 }' | sort -u")))) + (list (string-join response1 "\n") (string-join response2 "\n")))) + marionette)) + ;; Allow services to come up on slower machines + (let loop ((attempts 0)) + (if (= attempts 60) + (error "Services didn't come up after more than 60 seconds") + (if (equal? '("cgroup" "cgroup") + (run-test)) + #t + (begin + (sleep 1) + (format #t "Services didn't come up yet, retrying with attempt ~a~%" + (+ 1 attempts)) + (loop (+ 1 attempts)))))))) + + (test-assert "podman-volumes running" + (begin + (define (run-test) + (marionette-eval + `(begin + (use-modules (srfi srfi-1) + (ice-9 popen) + (ice-9 match) + (ice-9 rdelim)) + + (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 (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 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))) + + (match (primitive-fork) + (0 + (dynamic-wind + (const #f) + (lambda () + (setgid (passwd:gid (getpwnam "oci-container"))) + (setuid (passwd:uid (getpw "oci-container"))) + + (let ((response (slurp + "/run/current-system/profile/bin/podman" + "volume" "ls" "-n" "--format" "\"{{.Name}}\"" + "|" "tr" "' '" "'\n'"))) + + (call-with-output-file (string-append ,out-dir "/response") + (lambda (port) + (display (string-join response "\n") port))))) + (lambda () + (primitive-exit 127)))) + (pid + (cdr (waitpid pid)))) + + (wait-for-file (string-append ,out-dir "/response")) + + (stable-sort + (slurp "cat" (string-append ,out-dir "/response")) + string<=?)) + marionette)) + ;; Allow services to come up on slower machines + (let loop ((attempts 0)) + (if (= attempts 80) + (error "Service didn't come up after more than 80 seconds") + (if (equal? '("my-volume") + (run-test)) + #t + (begin + (sleep 1) + (loop (+ 1 attempts)))))))) + + (test-assert "podman-networks running" + (begin + (define (run-test) + (marionette-eval + `(begin + (use-modules (srfi srfi-1) + (ice-9 popen) + (ice-9 match) + (ice-9 rdelim)) + + (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 (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 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))) + + (match (primitive-fork) + (0 + (dynamic-wind + (const #f) + (lambda () + (setgid (passwd:gid (getpwnam "oci-container"))) + (setuid (passwd:uid (getpw "oci-container"))) + + (let ((response (slurp + "/run/current-system/profile/bin/podman" + "network" "ls" "-n" "--format" "\"{{.Name}}\"" + "|" "tr" "' '" "'\n'"))) + + (call-with-output-file (string-append ,out-dir "/response") + (lambda (port) + (display (string-join response "\n") port))))) + (lambda () + (primitive-exit 127)))) + (pid + (cdr (waitpid pid)))) + + (wait-for-file (string-append ,out-dir "/response")) + + (stable-sort + (slurp "cat" (string-append ,out-dir "/response")) + string<=?)) + marionette)) + ;; Allow services to come up on slower machines + (let loop ((attempts 0)) + (if (= attempts 80) + (error "Service didn't come up after more than 80 seconds") + (if (equal? '("my-network" "podman") + (run-test)) + #t + (begin + (sleep 1) + (loop (+ 1 attempts)))))))) + + (test-assert "first container running" + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (wait-for-service 'first #:timeout 120) + #t) + marionette)) + + (test-assert "second container running" + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (wait-for-service 'second #:timeout 120) + #t) + marionette)) + + (test-assert "passing host environment variables" + (begin + (define (run-test) + (marionette-eval + `(begin + (use-modules (srfi srfi-1) + (ice-9 popen) + (ice-9 match) + (ice-9 rdelim)) + + (define (wait-for-file file) + ;; Wait until FILE shows up. + (let loop ((i 60)) + (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 (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 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))) + + (match (primitive-fork) + (0 + (dynamic-wind + (const #f) + (lambda () + (setgid (passwd:gid (getpwnam "oci-container"))) + (setuid (passwd:uid (getpw "oci-container"))) + + (let ((response (slurp + "/run/current-system/profile/bin/podman" + "exec" "first" + "/bin/guile" "-c" "'(display (getenv \"VARIABLE\"))'"))) + (call-with-output-file (string-append ,out-dir "/response") + (lambda (port) + (display (string-join response "\n") port))))) + (lambda () + (primitive-exit 127)))) + (pid + (cdr (waitpid pid)))) + + (wait-for-file (string-append ,out-dir "/response")) + (slurp "cat" (string-append ,out-dir "/response"))) + marionette)) + ;; Allow image to be loaded on slower machines + (let loop ((attempts 0)) + (if (= attempts 180) + (error "Service didn't come up after more than 180 seconds") + (if (equal? (list "value") + (run-test)) + #t + (begin + (sleep 1) + (loop (+ 1 attempts)))))))) + + (test-equal "mounting host files" + '("hello") + (marionette-eval + `(begin + (use-modules (srfi srfi-1) + (ice-9 popen) + (ice-9 match) + (ice-9 rdelim)) + + (define (wait-for-file file) + ;; Wait until FILE shows up. + (let loop ((i 60)) + (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 (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 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))) + + (match (primitive-fork) + (0 + (dynamic-wind + (const #f) + (lambda () + (setgid (passwd:gid (getpwnam "oci-container"))) + (setuid (passwd:uid (getpw "oci-container"))) + + (let ((response (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)))'"))) + (call-with-output-file (string-append ,out-dir "/response") + (lambda (port) + (display (string-join response " ") port))))) + (lambda () + (primitive-exit 127)))) + (pid + (cdr (waitpid pid)))) + + (wait-for-file (string-append ,out-dir "/response")) + (slurp "cat" (string-append ,out-dir "/response"))) + marionette)) + + (test-equal "write to volumes" + '("world") + (marionette-eval + `(begin + (use-modules (srfi srfi-1) + (ice-9 popen) + (ice-9 match) + (ice-9 rdelim)) + + (define (wait-for-file file) + ;; Wait until FILE shows up. + (let loop ((i 60)) + (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 (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 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))) + + (match (primitive-fork) + (0 + (dynamic-wind + (const #f) + (lambda () + (setgid (passwd:gid (getpwnam "oci-container"))) + (setuid (passwd:uid (getpw "oci-container"))) + + (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))))'") + + (let ((response (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)))'"))) + (call-with-output-file (string-append ,out-dir "/response") + (lambda (port) + (display (string-join response " ") port))))) + (lambda () + (primitive-exit 127)))) + (pid + (cdr (waitpid pid)))) + + (wait-for-file (string-append ,out-dir "/response")) + (slurp "cat" (string-append ,out-dir "/response"))) + marionette)) + + (test-equal "can read ports over network" + '("out of office") + (marionette-eval + `(begin + (use-modules (srfi srfi-1) + (ice-9 popen) + (ice-9 match) + (ice-9 rdelim)) + + (define (wait-for-file file) + ;; Wait until FILE shows up. + (let loop ((i 60)) + (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 (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 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))) + + (match (primitive-fork) + (0 + (dynamic-wind + (const #f) + (lambda () + (setgid (passwd:gid (getpwnam "oci-container"))) + (setuid (passwd:uid (getpw "oci-container"))) + + (let ((response (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))'"))) + (call-with-output-file (string-append ,out-dir "/response") + (lambda (port) + (display (string-join response " ") port))))) + (lambda () + (primitive-exit 127)))) + (pid + (cdr (waitpid pid)))) + + (wait-for-file (string-append ,out-dir "/response")) + (slurp "cat" (string-append ,out-dir "/response"))) + 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-os + (simple-operating-system + (service dhcp-client-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-configuration (name "my-network")))) + (volumes + (list (oci-volume-configuration (name "my-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)(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 services herd) + (guix combinators)))) + + (define vm + (virtual-machine + (operating-system os) + (volatile? #f) + (memory-size 1024) + (disk-image-size (* 3000 (expt 2 20))) + (port-forwardings '()))) + + (define test + (with-imported-modules '((gnu build marionette)) + #~(begin + (use-modules (srfi srfi-11) (srfi srfi-64) + (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) + (marionette-eval + `(begin + (use-modules (ice-9 popen) + (ice-9 rdelim)) + + (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 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))) + + (stable-sort + (slurp + "/run/current-system/profile/bin/docker" + "volume" "ls" "--format" "\"{{.Name}}\"") + string<=?)) + + marionette)) + ;; Allow services to come up on slower machines + (let loop ((attempts 0)) + (if (= attempts 80) + (error "Service didn't come up after more than 80 seconds") + (if (equal? '("my-volume") + (run-test)) + #t + (begin + (sleep 1) + (loop (+ 1 attempts)))))))) + + (test-assert "docker-networks running" + (begin + (define (run-test) + (marionette-eval + `(begin + (use-modules (ice-9 popen) + (ice-9 rdelim)) + + (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 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))) + + (stable-sort + (slurp + "/run/current-system/profile/bin/docker" + "network" "ls" "--format" "\"{{.Name}}\"") + string<=?)) + + marionette)) + ;; Allow services to come up on slower machines + (let loop ((attempts 0)) + (if (= attempts 80) + (error "Service didn't come up after more than 80 seconds") + (if (equal? '("bridge" "host" "my-network" "none") + (run-test)) + #t + (begin + (sleep 1) + (loop (+ 1 attempts)))))))) + + (test-assert "first container running" + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (wait-for-service 'first #:timeout 120) + #t) + marionette)) + + (test-assert "second container running" + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (wait-for-service 'second #:timeout 120) + #t) + marionette)) + + (test-assert "passing host environment variables" + (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))) + + (slurp + "/run/current-system/profile/bin/docker" + "exec" "first" + "/bin/guile" "-c" "(display (getenv \"VARIABLE\"))")) + marionette)) + ;; Allow image to be loaded on slower machines + (let loop ((attempts 0)) + (if (= attempts 180) + (error "Service didn't come up after more than 180 seconds") + (if (equal? "value" + (run-test)) + #t + (begin + (sleep 1) + (loop (+ 1 attempts)))))))) + + (test-equal "mounting host files" + "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))) + + (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 \"/shared.txt\" read-line)))")) + marionette)) + + (test-equal "write to volumes" + "world" + (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))) + + (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 ports over network" + "out of office" + (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))) + + (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)))) -- 2.48.1 From unknown Fri Jun 13 11:55:10 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#76081] [PATCH v7 4/5] tests: Use lower-oci-image-state in container tests. Resent-From: Giacomo Leidi Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Tue, 04 Mar 2025 12:42:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 76081 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 76081@debbugs.gnu.org Cc: Giacomo Leidi Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.17410920712498 (code B ref 76081); Tue, 04 Mar 2025 12:42:02 +0000 Received: (at 76081) by debbugs.gnu.org; 4 Mar 2025 12:41:11 +0000 Received: from localhost ([127.0.0.1]:56153 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tpRaA-0000eA-MU for submit@debbugs.gnu.org; Tue, 04 Mar 2025 07:41:11 -0500 Received: from confino.investici.org ([2a11:7980:1::2:0]:55513) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1tpRa5-0000dO-NR for 76081@debbugs.gnu.org; Tue, 04 Mar 2025 07:41:06 -0500 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org; s=stigmate; t=1741092064; bh=NX55x0vzZ7+snJ/vUqL2Po2HeLZqsb5E7PUjP7o0CRQ=; h=From:To:Cc:Subject:Date:In-Reply-To:References:From; b=mvCFPPzGw7UrcSJYgAauKF5DrphIgzQLkQBiafEiZSCtsuA1KEeXJq/Yi5YdM1Hz1 vEauzncxqgsKdLl52W0XHkre936R+EJEVJZLR2uRS4J9zf/Z7wfFSKnIwOljWD2WUu 9wMYnC65nMzdZ9ZlT5ZwrHMyD+Tsl2zQrUw5onVg= Received: from mx1.investici.org (unknown [127.0.0.1]) by confino.investici.org (Postfix) with ESMTP id 4Z6Zzh6VMvz115T; Tue, 4 Mar 2025 12:41:04 +0000 (UTC) Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19]) (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with ESMTPSA id 4Z6Zzh5C2Nz1122; Tue, 4 Mar 2025 12:41:04 +0000 (UTC) From: Giacomo Leidi Date: Tue, 4 Mar 2025 13:40:01 +0100 Message-ID: X-Mailer: git-send-email 2.48.1 In-Reply-To: References: MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Spam-Score: -0.0 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) This patch replaces boilerplate in container related tests with oci-image plumbing from (gnu services containers). * gnu/services/containers.scm: Export lower-oci-image-state. * gnu/tests/containers.scm (%oci-tarball): New variable; (run-rootless-podman-test): use %oci-tarball; (build-tarball&run-rootless-podman-test): drop procedure. * gnu/tests/docker.scm (%docker-tarball): New variable; (build-tarball&run-docker-test): use %docker-tarball; (%docker-system-tarball): New variable; (build-tarball&run-docker-system-test): new procedure. Change-Id: Iad6f0704aee188d89464c83722dea0bb7adb084a --- gnu/services/containers.scm | 2 + gnu/tests/containers.scm | 80 ++++++++++++++--------------- gnu/tests/docker.scm | 100 ++++++++++++++++++++---------------- 3 files changed, 95 insertions(+), 87 deletions(-) diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm index 4600846ac3d..57b14868f1a 100644 --- a/gnu/services/containers.scm +++ b/gnu/services/containers.scm @@ -75,6 +75,8 @@ (define-module (gnu services containers) oci-image-system oci-image-grafts? + lower-oci-image-state + oci-container-configuration oci-container-configuration? oci-container-configuration-fields diff --git a/gnu/tests/containers.scm b/gnu/tests/containers.scm index 5e6f39387e7..8cdd86e7ae3 100644 --- a/gnu/tests/containers.scm +++ b/gnu/tests/containers.scm @@ -69,13 +69,47 @@ (define %rootless-podman-os (supplementary-groups '("wheel" "netdev" "cgroup" "audio" "video"))))))) -(define (run-rootless-podman-test oci-tarball) +(define %oci-tarball + (lower-oci-image-state + "guile-guest" + (packages->manifest + (list + guile-3.0 guile-json-3 + (package + (name "guest-script") + (version "0") + (source #f) + (build-system trivial-build-system) + (arguments `(#:guile ,guile-3.0 + #:builder + (let ((out (assoc-ref %outputs "out"))) + (mkdir out) + (call-with-output-file (string-append out "/a.scm") + (lambda (port) + (display "(display \"hello world\n\")" port))) + #t))) + (synopsis "Display hello world using Guile") + (description "This package displays the text \"hello world\" on the +standard output device and then enters a new line.") + (home-page #f) + (license license:public-domain)))) + '(#:entry-point "bin/guile" + #:localstatedir? #t + #:extra-options (#:image-tag "guile-guest") + #:symlinks (("/bin/Guile" -> "bin/guile") + ("aa.scm" -> "a.scm"))) + "guile-guest" + (%current-target-system) + (%current-system) + #f)) + +(define (run-rootless-podman-test) (define os (marionette-operating-system (operating-system-with-gc-roots %rootless-podman-os - (list oci-tarball)) + (list %oci-tarball)) #:imported-modules '((gnu services herd) (guix combinators)))) @@ -254,7 +288,7 @@ (define (run-rootless-podman-test oci-tarball) (let* ((loaded (slurp ,(string-append #$podman "/bin/podman") "load" "-i" - ,#$oci-tarball)) + ,#$%oci-tarball)) (repository&tag "localhost/guile-guest:latest") (response1 (slurp ,(string-append #$podman "/bin/podman") @@ -307,49 +341,11 @@ (define (run-rootless-podman-test oci-tarball) (gexp->derivation "rootless-podman-test" test)) -(define (build-tarball&run-rootless-podman-test) - (mlet* %store-monad - ((_ (set-grafting #f)) - (guile (set-guile-for-build (default-guile))) - (guest-script-package -> - (package - (name "guest-script") - (version "0") - (source #f) - (build-system trivial-build-system) - (arguments `(#:guile ,guile-3.0 - #:builder - (let ((out (assoc-ref %outputs "out"))) - (mkdir out) - (call-with-output-file (string-append out "/a.scm") - (lambda (port) - (display "(display \"hello world\n\")" port))) - #t))) - (synopsis "Display hello world using Guile") - (description "This package displays the text \"hello world\" on the -standard output device and then enters a new line.") - (home-page #f) - (license license:public-domain))) - (profile (profile-derivation (packages->manifest - (list guile-3.0 guile-json-3 - guest-script-package)) - #:hooks '() - #:locales? #f)) - (tarball (pack:docker-image - "docker-pack" profile - #:symlinks '(("/bin/Guile" -> "bin/guile") - ("aa.scm" -> "a.scm")) - #:extra-options - '(#:image-tag "guile-guest") - #:entry-point "bin/guile" - #:localstatedir? #t))) - (run-rootless-podman-test tarball))) - (define %test-rootless-podman (system-test (name "rootless-podman") (description "Test rootless Podman service.") - (value (build-tarball&run-rootless-podman-test)))) + (value (run-rootless-podman-test)))) (define %oci-rootless-podman-os diff --git a/gnu/tests/docker.scm b/gnu/tests/docker.scm index 5dcf05a17e3..07edd9d5341 100644 --- a/gnu/tests/docker.scm +++ b/gnu/tests/docker.scm @@ -26,6 +26,7 @@ (define-module (gnu tests docker) #:use-module (gnu system image) #:use-module (gnu system vm) #:use-module (gnu services) + #:use-module (gnu services containers) #:use-module (gnu services dbus) #:use-module (gnu services networking) #:use-module (gnu services docker) @@ -57,6 +58,40 @@ (define %docker-os (service containerd-service-type) (service docker-service-type))) +(define %docker-tarball + (lower-oci-image-state + "guile-guest" + (packages->manifest + (list + guile-3.0 guile-json-3 + (package + (name "guest-script") + (version "0") + (source #f) + (build-system trivial-build-system) + (arguments `(#:guile ,guile-3.0 + #:builder + (let ((out (assoc-ref %outputs "out"))) + (mkdir out) + (call-with-output-file (string-append out "/a.scm") + (lambda (port) + (display "(display \"hello world\n\")" port))) + #t))) + (synopsis "Display hello world using Guile") + (description "This package displays the text \"hello world\" on the +standard output device and then enters a new line.") + (home-page #f) + (license license:public-domain)))) + '(#:entry-point "bin/guile" + #:localstatedir? #t + #:extra-options (#:image-tag "guile-guest") + #:symlinks (("/bin/Guile" -> "bin/guile") + ("aa.scm" -> "a.scm"))) + "guile-guest" + (%current-target-system) + (%current-system) + #f)) + (define (run-docker-test docker-tarball) "Load DOCKER-TARBALL as Docker image and run it in a Docker container, inside %DOCKER-OS." @@ -173,40 +208,7 @@ (define (run-docker-test docker-tarball) (gexp->derivation "docker-test" test)) (define (build-tarball&run-docker-test) - (mlet* %store-monad - ((_ (set-grafting #f)) - (guile (set-guile-for-build (default-guile))) - (guest-script-package -> - (package - (name "guest-script") - (version "0") - (source #f) - (build-system trivial-build-system) - (arguments `(#:guile ,guile-3.0 - #:builder - (let ((out (assoc-ref %outputs "out"))) - (mkdir out) - (call-with-output-file (string-append out "/a.scm") - (lambda (port) - (display "(display \"hello world\n\")" port))) - #t))) - (synopsis "Display hello world using Guile") - (description "This package displays the text \"hello world\" on the -standard output device and then enters a new line.") - (home-page #f) - (license license:public-domain))) - (profile (profile-derivation (packages->manifest - (list guile-3.0 guile-json-3 - guest-script-package)) - #:hooks '() - #:locales? #f)) - (tarball (pack:docker-image - "docker-pack" profile - #:symlinks '(("/bin/Guile" -> "bin/guile") - ("aa.scm" -> "a.scm")) - #:entry-point "bin/guile" - #:localstatedir? #t))) - (run-docker-test tarball))) + (run-docker-test %docker-tarball)) (define %test-docker (system-test @@ -215,8 +217,22 @@ (define %test-docker (value (build-tarball&run-docker-test)))) +(define %docker-system-tarball + (lower-oci-image-state + "guix-system-guest" + (operating-system + (inherit (simple-operating-system)) + ;; Use locales for a single libc to + ;; reduce space requirements. + (locale-libcs (list glibc))) + '() + "guix-system-guest" + (%current-target-system) + (%current-system) + #f)) + (define (run-docker-system-test tarball) - "Load DOCKER-TARBALL as Docker image and run it in a Docker container, + "Load TARBALL as Docker image and run it in a Docker container, inside %DOCKER-OS." (define os (marionette-operating-system @@ -333,21 +349,15 @@ (define (run-docker-system-test tarball) (gexp->derivation "docker-system-test" test)) +(define (build-tarball&run-docker-system-test) + (run-docker-system-test %docker-system-tarball)) + (define %test-docker-system (system-test (name "docker-system") (description "Run a system image as produced by @command{guix system docker-image} inside Docker.") - (value (with-monad %store-monad - (>>= (lower-object - (system-image (os->image - (operating-system - (inherit (simple-operating-system)) - ;; Use locales for a single libc to - ;; reduce space requirements. - (locale-libcs (list glibc))) - #:type docker-image-type))) - run-docker-system-test))))) + (value (build-tarball&run-docker-system-test)))) (define %oci-os -- 2.48.1 From unknown Fri Jun 13 11:55:10 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#76081] [PATCH v7 1/5] services: rootless-podman: Use login shell. References: <2f43e635-508c-407a-8309-06e75d492d89@autistici.org> In-Reply-To: <2f43e635-508c-407a-8309-06e75d492d89@autistici.org> Resent-From: Giacomo Leidi Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Tue, 04 Mar 2025 12:42:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 76081 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 76081@debbugs.gnu.org Cc: Giacomo Leidi Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.17410920722505 (code B ref 76081); Tue, 04 Mar 2025 12:42:02 +0000 Received: (at 76081) by debbugs.gnu.org; 4 Mar 2025 12:41:12 +0000 Received: from localhost ([127.0.0.1]:56155 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tpRaB-0000eF-L9 for submit@debbugs.gnu.org; Tue, 04 Mar 2025 07:41:11 -0500 Received: from confino.investici.org ([2a11:7980:1::2:0]:61221) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1tpRa6-0000dJ-4i for 76081@debbugs.gnu.org; Tue, 04 Mar 2025 07:41:06 -0500 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org; s=stigmate; t=1741092063; bh=Cu4zAqdvKiPIsz0kq/O65HDxVqxYKw8mLcYnRakqTms=; h=From:To:Cc:Subject:Date:From; b=rOPeoVGf2SyzrRCNUeWahaQrqEJYLk0oJrykswyAn0Sei88WvRdherSIg1fVz9uZu C3/o4lR1xR7Cut+7ta1CK6SoCMc1AkMaVyK7kWueZyjNwugdg4h+5478P6+nls+qxp hyZVHrFYQ7x9HVuCDEqXycIfErkY4ifviTU4HYjs= Received: from mx1.investici.org (unknown [127.0.0.1]) by confino.investici.org (Postfix) with ESMTP id 4Z6Zzg2N23z115G; Tue, 4 Mar 2025 12:41:03 +0000 (UTC) Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19]) (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with ESMTPSA id 4Z6Zzg112hz1122; Tue, 4 Mar 2025 12:41:03 +0000 (UTC) From: Giacomo Leidi Date: Tue, 4 Mar 2025 13:39:58 +0100 Message-ID: X-Mailer: git-send-email 2.48.1 MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Spam-Score: -0.0 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) This commit allows for having PATH set when changing the owner of /sys/fs/group. * gnu/services/containers.scm (crgroups-fs-owner): Use login shell. Change-Id: I9510c637a5332325e05ca5ebc9dfd4de32685c50 --- gnu/services/containers.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm index b3cd109ce6c..d5a211765a6 100644 --- a/gnu/services/containers.scm +++ b/gnu/services/containers.scm @@ -140,7 +140,7 @@ (define (cgroups-fs-owner-entrypoint config) (rootless-podman-configuration-group-name config)) (program-file "cgroups2-fs-owner-entrypoint" #~(system* - (string-append #+bash-minimal "/bin/bash") "-c" + (string-append #+bash-minimal "/bin/bash") "-l" "-c" (string-append "echo Setting /sys/fs/cgroup " "group ownership to " #$group " && chown -v " "root:" #$group " /sys/fs/cgroup && " base-commit: 72923a75af53a819f2be9dc4ae3c096aa3147d3f -- 2.48.1 From unknown Fri Jun 13 11:55:10 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#76081] [PATCH v7 5/5] home: Add home-oci-service-type. Resent-From: Giacomo Leidi Original-Sender: "Debbugs-submit" Resent-CC: andrew@trop.in, janneke@gnu.org, ludo@gnu.org, maxim.cournoyer@gmail.com, tanguy@bioneland.org, guix-patches@gnu.org Resent-Date: Tue, 04 Mar 2025 12:42:03 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 76081 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 76081@debbugs.gnu.org Cc: Giacomo Leidi , Andrew Tropin , Janneke Nieuwenhuizen , Ludovic =?UTF-8?Q?Court=C3=A8s?= , Maxim Cournoyer , Tanguy Le Carrour X-Debbugs-Original-Xcc: Andrew Tropin , Janneke Nieuwenhuizen , Ludovic =?UTF-8?Q?Court=C3=A8s?= , Maxim Cournoyer , Tanguy Le Carrour Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.17410920722513 (code B ref 76081); Tue, 04 Mar 2025 12:42:03 +0000 Received: (at 76081) by debbugs.gnu.org; 4 Mar 2025 12:41:12 +0000 Received: from localhost ([127.0.0.1]:56157 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tpRaC-0000eM-0C for submit@debbugs.gnu.org; Tue, 04 Mar 2025 07:41:12 -0500 Received: from confino.investici.org ([93.190.126.19]:33711) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1tpRa6-0000dR-FD for 76081@debbugs.gnu.org; Tue, 04 Mar 2025 07:41:07 -0500 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org; s=stigmate; t=1741092065; bh=h0plgAp9LHO8TolUragh/3iEzRwLganm4zDBr+kUGz4=; h=From:To:Cc:Subject:Date:In-Reply-To:References:From; b=tWTYCpkv8D699W8OJsN7AKc+NIh290rfC9R+QVDZvHvB7H5QzR/1uRGEIf2lOT1MF I2A8woylV87MmBraVNPl243segMdERWarWSDyv3jNxz1gU0cRNjvkU688oV0WflBjG GUesc6STfYTV3qYQiCrwVnEbr9xyNC/6HniefUT4= Received: from mx1.investici.org (unknown [127.0.0.1]) by confino.investici.org (Postfix) with ESMTP id 4Z6Zzj40g9z115b; Tue, 4 Mar 2025 12:41:05 +0000 (UTC) Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19]) (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with ESMTPSA id 4Z6Zzj1HKKz1122; Tue, 4 Mar 2025 12:41:05 +0000 (UTC) From: Giacomo Leidi Date: Tue, 4 Mar 2025 13:40:02 +0100 Message-ID: X-Mailer: git-send-email 2.48.1 In-Reply-To: References: MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit X-Spam-Score: -0.7 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.7 (-) * gnu/home/service/containers.scm: New file; * gnu/local.mk (GNU_SYSTEM_MODULES): Add it. * doc/guix.texi (OCI backed services): Document it. Change-Id: I8ce5b301e8032d0a7b2a9ca46752738cdee1f030 --- doc/guix.texi | 114 +++++++++++++++++++++++++++++++ gnu/home/services/containers.scm | 50 ++++++++++++++ gnu/local.mk | 1 + 3 files changed, 165 insertions(+) create mode 100644 gnu/home/services/containers.scm diff --git a/doc/guix.texi b/doc/guix.texi index be5c8cf8fad..6c09f929049 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -50288,6 +50288,120 @@ Miscellaneous Home Services (dicod-configuration @dots{}))) @end lisp +@subsubheading OCI backed services + +@cindex OCI-backed, for Home +The @code{(gnu home services containers)} module provides the following service: + +@defvar home-oci-service-type +This is the type of the service that allows to manage your OCI containers with +the same consistent interface you use for your other Home Shepherd services. +@end defvar + +This service is a direct mapping of the @code{oci-service-type} system +service (@pxref{Miscellaneous Services, OCI backed services}). You can +use it like this: + +@lisp +(use-modules (gnu services containers) + (gnu home services containers)) + +(simple-service 'home-oci-provisioning + home-oci-service-type + (oci-extension + (volumes + (list + (oci-volume-configuration (name "prometheus")) + (oci-volume-configuration (name "grafana")))) + (networks + (list + (oci-network-configuration (name "monitoring")))) + (containers + (list + (oci-container-configuration + (network "monitoring") + (image + (oci-image + (repository "guile") + (tag "3") + (value (specifications->manifest '("guile"))) + (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile")) + #:max-layers 2)))) + (entrypoint "/bin/guile") + (command + '("-c" "(display \"hello!\n\")"))) + (oci-container-configuration + (image "prom/prometheus") + (network "monitoring") + (ports + '(("9000" . "9000") + ("9090" . "9090"))) + (volumes + (list + '(("prometheus" . "/var/lib/prometheus"))))) + (oci-container-configuration + (image "grafana/grafana:10.0.1") + (network "monitoring") + (volumes + '(("grafana:/var/lib/grafana")))))))) + +@end lisp + +You may specify a custom configuration by providing a +@code{oci-configuration} record, exactly like for +@code{oci-service-type}, but wrapping it in @code{for-home}: + +@lisp +(use-modules (gnu services) + (gnu services containers) + (gnu home services containers)) + +(service home-oci-service-type + (for-home + (oci-configuration + (runtime 'podman) + (verbose? #t)))) + +(simple-service 'home-oci-provisioning + home-oci-service-type + (oci-extension + (volumes + (list + (oci-volume-configuration (name "prometheus")) + (oci-volume-configuration (name "grafana")))) + (networks + (list + (oci-network-configuration (name "monitoring")))) + (containers + (list + (oci-container-configuration + (network "monitoring") + (image + (oci-image + (repository "guile") + (tag "3") + (value (specifications->manifest '("guile"))) + (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile")) + #:max-layers 2)))) + (entrypoint "/bin/guile") + (command + '("-c" "(display \"hello!\n\")"))) + (oci-container-configuration + (image "prom/prometheus") + (network "monitoring") + (ports + '(("9000" . "9000") + ("9090" . "9090"))) + (volumes + (list + '(("prometheus" . "/var/lib/prometheus"))))) + (oci-container-configuration + (image "grafana/grafana:10.0.1") + (network "monitoring") + (volumes + '(("grafana:/var/lib/grafana")))))))) +@end lisp + @node Invoking guix home @section Invoking @command{guix home} diff --git a/gnu/home/services/containers.scm b/gnu/home/services/containers.scm new file mode 100644 index 00000000000..938dde2f37a --- /dev/null +++ b/gnu/home/services/containers.scm @@ -0,0 +1,50 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2025 Giacomo Leidi +;;; +;;; 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 . + +(define-module (gnu home services containers) + #:use-module (gnu home services) + #:use-module (gnu home services shepherd) + #:use-module (gnu services) + #:use-module (gnu services configuration) + #:use-module (gnu services containers) + #:use-module (guix gexp) + #:use-module (guix packages) + #:use-module (srfi srfi-1) + #:export (home-oci-service-type)) + +(define home-oci-service-type + (service-type (inherit (system->home-service-type oci-service-type)) + (extensions + (list + (service-extension home-profile-service-type + (oci-service-extension-wrap-validate + (lambda (config) + (let ((runtime-cli + (oci-configuration-runtime-cli config)) + (runtime + (oci-configuration-runtime config))) + (oci-service-profile runtime runtime-cli))))) + (service-extension home-shepherd-service-type + (oci-service-extension-wrap-validate + oci-configuration->shepherd-services)))) + (extend + (lambda (config extension) + (for-home + (oci-configuration + (inherit (oci-configuration-extend config extension)))))) + (default-value (for-home (oci-configuration))))) diff --git a/gnu/local.mk b/gnu/local.mk index a7a3238669d..d48e767154c 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -103,6 +103,7 @@ GNU_SYSTEM_MODULES = \ %D%/home.scm \ %D%/home/services.scm \ %D%/home/services/admin.scm \ + %D%/home/services/containers.scm \ %D%/home/services/desktop.scm \ %D%/home/services/dict.scm \ %D%/home/services/dotfiles.scm \ -- 2.48.1 From unknown Fri Jun 13 11:55:10 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#76081] [PATCH v7 2/5] services: oci-container-configuration: Move to (gnu services containers). Resent-From: Giacomo Leidi Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Tue, 04 Mar 2025 12:42:03 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 76081 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 76081@debbugs.gnu.org Cc: Giacomo Leidi Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.17410920752522 (code B ref 76081); Tue, 04 Mar 2025 12:42:03 +0000 Received: (at 76081) by debbugs.gnu.org; 4 Mar 2025 12:41:15 +0000 Received: from localhost ([127.0.0.1]:56159 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tpRaC-0000eU-LQ for submit@debbugs.gnu.org; Tue, 04 Mar 2025 07:41:15 -0500 Received: from confino.investici.org ([2a11:7980:1::2:0]:27941) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1tpRa6-0000dL-KV for 76081@debbugs.gnu.org; Tue, 04 Mar 2025 07:41:10 -0500 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org; s=stigmate; t=1741092063; bh=5w1pguUy5euk/p6I7KBfaqhA/lWVRKQOsLxduTGYZqY=; h=From:To:Cc:Subject:Date:In-Reply-To:References:From; b=VwtpKCI5x+4OcZFMSMpn9Ooslp6UkkXKlOAgxW53VKcX0HJwna4zVRtRtcsnMnxkE zr9hkTdbDtVVxdsge+I3a/7XlDvboqyY8HiM1OQT6N+keeWBupq++uqE+RW6K72T/R jbxLfVEUBajdUPWZv7y5cqit8eS9BVX+Ih92tblY= Received: from mx1.investici.org (unknown [127.0.0.1]) by confino.investici.org (Postfix) with ESMTP id 4Z6Zzg5wrhz115H; Tue, 4 Mar 2025 12:41:03 +0000 (UTC) Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19]) (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with ESMTPSA id 4Z6Zzg459jz1122; Tue, 4 Mar 2025 12:41:03 +0000 (UTC) From: Giacomo Leidi Date: Tue, 4 Mar 2025 13:39:59 +0100 Message-ID: X-Mailer: git-send-email 2.48.1 In-Reply-To: References: MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit X-Spam-Score: -0.0 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) 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 +;;; Copyright © 2024, 2025 Giacomo Leidi ;;; ;;; This file is part of GNU Guix. ;;; @@ -17,19 +17,31 @@ ;;; along with GNU Guix. If not, see . (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 ;;; Copyright © 2020 Jesse Dowell ;;; Copyright © 2021 Brice Waegeneire -;;; Copyright © 2023, 2024 Giacomo Leidi +;;; Copyright © 2023, 2024, 2025 Giacomo Leidi ;;; ;;; This file is part of GNU Guix. ;;; @@ -23,72 +23,60 @@ ;;; along with GNU Guix. If not, see . (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 ;;; Copyright © 2019-2023 Ludovic Courtès -;;; Copyright © 2024 Giacomo Leidi +;;; Copyright © 2024, 2025 Giacomo Leidi ;;; ;;; 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 From unknown Fri Jun 13 11:55:10 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#76081] OCI provisioning service Resent-From: paul Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sun, 09 Mar 2025 00:28:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 76081 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 76081@debbugs.gnu.org Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.174148007626753 (code B ref 76081); Sun, 09 Mar 2025 00:28:02 +0000 Received: (at 76081) by debbugs.gnu.org; 9 Mar 2025 00:27:56 +0000 Received: from localhost ([127.0.0.1]:57338 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tr4WJ-0006xP-O6 for submit@debbugs.gnu.org; Sat, 08 Mar 2025 19:27:56 -0500 Received: from confino.investici.org ([2a11:7980:1::2:0]:24593) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1tr4WH-0006xE-F7 for 76081@debbugs.gnu.org; Sat, 08 Mar 2025 19:27:54 -0500 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org; s=stigmate; t=1741480069; bh=tKyjtrc8P3uG9BnqjgJ+oVvgsvACORwpQCsbdPOAG+I=; h=Date:Subject:From:To:References:In-Reply-To:From; b=C0hHTL22c//Ew4egn270cllIJfPxVNoMdk8l1yufXfS7j0WLprZ4LNLPuVnLRjLr5 TetZbuEvaq4ES/neGi26Oq6Ix0bflMC0VTtPwSqYJLQD0NcEYrL1qXwVfal1Wz/ElQ iIZLhMzkNN6E6IEJIkKXP5fCTrVRVaRWK2rC9JV4= Received: from mx1.investici.org (unknown [127.0.0.1]) by confino.investici.org (Postfix) with ESMTP id 4Z9LTK0ChQz11NM for <76081@debbugs.gnu.org>; Sun, 9 Mar 2025 00:27:49 +0000 (UTC) Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19]) (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with ESMTPSA id 4Z9LTJ6qSsz11NJ for <76081@debbugs.gnu.org>; Sun, 9 Mar 2025 00:27:48 +0000 (UTC) Message-ID: Date: Sun, 9 Mar 2025 01:27:48 +0100 MIME-Version: 1.0 User-Agent: Icedove Daily From: paul References: <274b98ea-1af9-4f0f-af58-8fa755feb73b@autistici.org> <397afc1f-b638-430a-b9e7-7de4721bca45@autistici.org> Content-Language: en-US In-Reply-To: Content-Type: text/plain; charset=UTF-8; format=flowed Content-Transfer-Encoding: 8bit X-Spam-Score: -0.0 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) Hi, On 3/4/25 13:39, paul wrote: > Hi, > > On 2/27/25 00:01, paul wrote: >> Hi guix, >> >> On 2/18/25 02:20, paul wrote: >>> Hi, >>> >>> On 2/12/25 02:09, paul wrote: >>>> Hi guix, >>>> >>>> On 2/9/25 21:38, paul wrote: >>>>> I'm sending a v3 fixing a bug in the merge algorithm for volumes >>>>> and networks. >>>>> >>>>> On 2/9/25 20:14, paul wrote: >>>>>> Hi, >>>>>> >>>>>> I'm about to send a v2. v2 compared to the first revision features: >>>>>> >>>>>> >>>>>> - it actually compiles all the times :) (rev 1 referenced >>>>>> oci-image too early for it to be working and generated a compile >>>>>> time error, if you recompiled it sometimes went away so I thought >>>>>> it was a problem of my setup. CI caught this) >>>>>> - it allows more values to be overridden by eventual users of the >>>>>> Scheme API >>>>>> - it allows passing extra arguments directly after each podman or >>>>>> docker invokation, allowing for example for overriding podman >>>>>> --root and similar options. >>>>>> >>>>>> All of these tests should pass: >>>>>> >>>>>> guix shell -D guix -CPW -- make check-system TESTS="oci-container >>>>>> oci-service-rootless-podman docker docker-system rootless-podman >>>>>> oci-service-docker" >>>>>> >>>> I'm sending a v4 changing slightly the image loader, the same tests >>>> as before are supposed to pass. Now the Home service [0] is working >>>> for me with rootless podman. I'll try it on different distros if I >>>> manage to. >>> >>> I'm sending a v5 implementing a Home service. The changes compared >>> to v4 are pretty trivial as the plumbing was already there, the only >>> downside is that I'm not able to use for-home? in >>> define-configuration, so I had to reimplement oci-configuration with >>> (guix records) and had to reimplement some validation (gnu services >>> configuration) would figure out magically. >> >> I'm sending  a v6. Compared to v5 it resolves the conflicts with >> master and it should fix the stop action for rootless podman backed >> services. > > I'm sending a v7 fixing the restart action for podman backed services. I'm sending a v8 fixing some further bugs wrt to the start and stop of podman backed services. Thank you for your work, cheers giacomo From unknown Fri Jun 13 11:55:10 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#76081] [PATCH v8 3/5] services: Add oci-service-type. Resent-From: Giacomo Leidi Original-Sender: "Debbugs-submit" Resent-CC: ludo@gnu.org, maxim.cournoyer@gmail.com, guix-patches@gnu.org Resent-Date: Sun, 09 Mar 2025 01:07:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 76081 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 76081@debbugs.gnu.org Cc: Giacomo Leidi , Ludovic =?UTF-8?Q?Court=C3=A8s?= , Maxim Cournoyer X-Debbugs-Original-Xcc: Ludovic =?UTF-8?Q?Court=C3=A8s?= , Maxim Cournoyer Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.17414823881185 (code B ref 76081); Sun, 09 Mar 2025 01:07:02 +0000 Received: (at 76081) by debbugs.gnu.org; 9 Mar 2025 01:06:28 +0000 Received: from localhost ([127.0.0.1]:57381 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tr57c-0000J3-8A for submit@debbugs.gnu.org; Sat, 08 Mar 2025 20:06:28 -0500 Received: from confino.investici.org ([93.190.126.19]:44599) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1tr57Z-0000Ia-7e for 76081@debbugs.gnu.org; Sat, 08 Mar 2025 20:06:25 -0500 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org; s=stigmate; t=1741482383; bh=OFurPoE5KAFCORjZk5Ct+DmNJsmN2g+9Hhckv+da+i4=; h=From:To:Cc:Subject:Date:In-Reply-To:References:From; b=cAoPAeP2FWOMtdeHrpZdxmoCUfAjZ1oaJ8heXML3dv9Wmsuc644kd0xtSB1EP9PFu +oMh1f89EUKc0MIZX117VKtxXIvJmH7PO13lYWQmOL+m8IDGldnoJto599bXUlVSUT 4M3eqiV556HYV8edMoTaLTCB24wH84XpjzGUYdog= Received: from mx1.investici.org (unknown [127.0.0.1]) by confino.investici.org (Postfix) with ESMTP id 4Z9MKq3f8sz11NT; Sun, 9 Mar 2025 01:06:23 +0000 (UTC) Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19]) (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with ESMTPSA id 4Z9MKq2LHKz11NJ; Sun, 9 Mar 2025 01:06:23 +0000 (UTC) From: Giacomo Leidi Date: Sun, 9 Mar 2025 02:06:13 +0100 Message-ID: X-Mailer: git-send-email 2.48.1 In-Reply-To: <36e9d9e4474b8d547a86a0225e89f0039af39970.1741482375.git.goodoldpaul@autistici.org> References: <36e9d9e4474b8d547a86a0225e89f0039af39970.1741482375.git.goodoldpaul@autistici.org> MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" 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/services/containers.scm (%oci-supported-runtimes): New variable; (oci-runtime-cli): new variable; (oci-runtime-name): new variable; (oci-network-configuration): new variable; (oci-volume-configuration): new variable; (oci-configuration): new variable; (oci-extension): new variable; (oci-networks-shepherd-name): new variable; (oci-service-type): new variable; (oci-state->shepherd-services): new variable. * doc/guix.texi: Document it. * gnu/tests/containers.scm: Test it. * gnu/services/docker.scm: Deprecate the oci-container-service-type. Change-Id: I656b3db85832e42d53072fcbfb91d1226f39ef38 --- doc/guix.texi | 306 ++++++-- gnu/services/containers.scm | 1335 ++++++++++++++++++++++++++++++----- gnu/services/docker.scm | 37 +- gnu/tests/containers.scm | 999 +++++++++++++++++++++++++- 4 files changed, 2425 insertions(+), 252 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index 7d8a5243ed8..8686380669b 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -42839,59 +42839,162 @@ Miscellaneous Services @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: given an -@acronym{Open Container Initiative, OCI} container image, it will run it in a +Should you wish to manage your @acronym{Open Container Initiative, OCI} containers +with the same consistent interface you use for your other Shepherd services, +@var{oci-service-type} is the tool to use: given an +OCI container image, it will run it in a Shepherd service. One example where this is useful: it lets you run services -that are available as Docker/OCI images but not yet packaged for Guix. +that are available as OCI images but not yet packaged for Guix. -@defvar oci-container-service-type +@defvar oci-service-type -This is a thin wrapper around Docker's CLI that executes OCI images backed +This is a thin wrapper around Docker's or Podman's CLI that executes OCI images backed processes as Shepherd Services. @lisp -(service oci-container-service-type - (list - (oci-container-configuration - (network "host") - (image - (oci-image - (repository "guile") - (tag "3") - (value (specifications->manifest '("guile"))) - (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile")) - #:max-layers 2)))) - (entrypoint "/bin/guile") - (command - '("-c" "(display \"hello!\n\")"))) - (oci-container-configuration - (image "prom/prometheus") - (ports - '(("9000" . "9000") - ("9090" . "9090")))) - (oci-container-configuration - (image "grafana/grafana:10.0.1") - (network "host") - (volumes - '("/var/lib/grafana:/var/lib/grafana"))))) +(simple-service 'oci-provisioning + oci-service-type + (oci-extension + (networks + (list + (oci-network-configuration (name "monitoring")))) + (containers + (list + (oci-container-configuration + (network "monitoring") + (image + (oci-image + (repository "guile") + (tag "3") + (value (specifications->manifest '("guile"))) + (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile")) + #:max-layers 2)))) + (entrypoint "/bin/guile") + (command + '("-c" "(display \"hello!\n\")"))) + (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 In this example three different Shepherd services are going to be added to the system. Each @code{oci-container-configuration} record translates to a -@code{docker run} invocation and its fields directly map to options. You can -refer to the -@url{https://docs.docker.com/engine/reference/commandline/run,upstream} -documentation for the semantics of each value. If the images are not found, -they will be -@url{https://docs.docker.com/engine/reference/commandline/pull/,pulled}. The +@command{docker run} or @command{podman run} invocation and its fields directly +map to options. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html,Podman} +upstream documentation for semantics of each value. If the images are not found, +they will be pulled. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/pull/,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-pull.1.html,Podman} +upstream documentation for semantics. The services with @code{(network "host")} are going to be attached to the host network and are supposed to behave like native processes with regard to networking. @end defvar +@c %start of fragment + +@deftp {Data Type} oci-configuration +Available @code{oci-configuration} fields are: + +@table @asis +@item @code{runtime} (default: @code{'docker}) (type: symbol) +The OCI runtime to use to run commands. It can be either @code{'docker} or +@code{'podman}. + +@item @code{runtime-cli} (type: maybe-package-or-string) +The OCI runtime command line to be installed in the system profile and used +to provision OCI resources. When unset it will default to @code{docker-cli} +package for the @code{'docker} runtime or to @code{podman} package for the +@code{'podman} runtime. When a string is passed it will be interpreted as the +absolute file-system path of the selected OCI runtime command. + +@item @code{runtime-extra-arguments} (default: @code{'()}) (type: list) +A list of strings, gexps or file-like objects that will be placed +after each @command{docker} or @command{podman} invokation. + +@item @code{user} (type: maybe-string) +The user name under whose authority OCI commands will be run. This field will +override the @code{user} field of @code{oci-configuration}. + +@item @code{group} (type: maybe-string) +The group name under whose authority OCI commands will be run. When +using the @code{'podman} OCI runtime, this field will be ignored and the +default group of the user configured in the @code{user} field will be used. +This field will override the @code{group} field of @code{oci-configuration}. + +@item @code{subuids-range} (type: maybe-subid-range) +An optional @code{subid-range} record allocating subuids for the user from +the @code{user} field. When unset, with the rootless Podman OCI runtime, it +defaults to @code{(subid-range (name "oci-container"))}. + +@item @code{subgids-range} (type: maybe-subid-range) +An optional @code{subid-range} record allocating subgids for the user from +the @code{user} field. When unset, with the rootless Podman OCI runtime, it +defaults to @code{(subid-range (name "oci-container"))}. + +@item @code{containers} (default: @code{'()}) (type: list-of-oci-containers) +The list of @code{oci-container-configuration} records representing the +containers to provision. Most users are supposed not to use this field and use +the @code{oci-extension} record instead. + +@item @code{networks} (default: @code{'()}) (type: list-of-oci-networks) +The list of @code{oci-network-configuration} records representing the +containers to provision. Most users are supposed not to use this field and use +the @code{oci-extension} record instead. + +@item @code{volumes} (default: @code{'()}) (type: list-of-oci-volumes) +The list of @code{oci-volumes-configuration} records representing the +containers to provision. Most users are supposed not to use this field and use +the @code{oci-extension} record instead. + +@item @code{verbose?} (default: @code{#f}) (type: boolean) +When true, additional output will be printed, allowing to better follow the +flow of execution. + +@end table + +@end deftp + + +@c %end of fragment + +@c %start of fragment + +@deftp {Data Type} oci-extension +Available @code{oci-extension} fields are: + +@table @asis +@item @code{containers} (default: @code{'()}) (type: list-of-oci-containers) +The list of @code{oci-container-configuration} records representing the +containers to provision. + +@item @code{networks} (default: @code{'()}) (type: list-of-oci-networks) +The list of @code{oci-network-configuration} records representing the +containers to provision. + +@item @code{volumes} (default: @code{'()}) (type: list-of-oci-volumes) +The list of @code{oci-volumes-configuration} records representing the +containers to provision. + +@end table + +@end deftp + + +@c %end of fragment + + @c %start of fragment @deftp {Data Type} oci-container-configuration @@ -42911,16 +43014,16 @@ Miscellaneous Services Overwrite the default entrypoint (@code{ENTRYPOINT}) of the image. @item @code{host-environment} (default: @code{'()}) (type: 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 +Set environment variables in the host environment where @command{docker run} +or @command{podman run} are invoked. This is especially useful to pass secrets +from the host to the container without having them on the OCI runtime command line, +for example: by setting the @code{MYSQL_PASSWORD} on the host and by passing @code{--env MYSQL_PASSWORD} through the @code{extra-arguments} field, it is possible to securely set values in the container environment. This field's value can be a list of pairs or strings, even mixed: @lisp -(list '("LANGUAGE\" . "eo:ca:eu") +(list '("LANGUAGE" . "eo:ca:eu") "JAVA_HOME=/opt/java") @end lisp @@ -42928,22 +43031,24 @@ Miscellaneous Services directly to @code{make-forkexec-constructor}. @item @code{environment} (default: @code{'()}) (type: list) -Set environment variables. This can be a list of pairs or strings, even mixed: +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 -@uref{https://docs.docker.com/engine/reference/commandline/run/#env,upstream} -documentation for semantics. +Pair members can be strings, gexps or file-like objects. Strings are passed +directly to the OCI runtime CLI. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run/#env,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#env-e-env,Podman} +upstream documentation for semantics. @item @code{image} (type: 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{oci-image} record. Strings are resolved by the OCI runtime, +and follow the usual format @code{myregistry.local:5000/testing/test-image:tag}. @item @code{provision} (default: @code{""}) (type: string) @@ -42971,7 +43076,7 @@ Miscellaneous Services by the service. @item @code{network} (default: @code{""}) (type: string) -Set a Docker network for the spawned container. +Set an OCI 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 @@ -42982,10 +43087,11 @@ Miscellaneous Services "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 -@uref{https://docs.docker.com/engine/reference/commandline/run/#publish,upstream} -documentation for semantics. +Pair members can be strings, gexps or file-like objects. Strings are passed +directly to the OCI runtime CLI. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run/#publish,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#publish-p-ip-hostport-containerport-protocol,Podman} +upstream documentation for semantics. @item @code{volumes} (default: @code{'()}) (type: list) Set volume mappings for the spawned container. This can be a @@ -42996,25 +43102,97 @@ Miscellaneous Services "/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 -@uref{https://docs.docker.com/engine/reference/commandline/run/#volume,upstream} -documentation for semantics. +Pair members can be strings, gexps or file-like objects. Strings are passed +directly to the OCI runtime CLI. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run/#volume,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#volume-v-source-volume-host-dir-container-dir-options,Podman} +upstream documentation for semantics. @item @code{container-user} (default: @code{""}) (type: 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. +@url{https://docs.docker.com/engine/reference/run/#user,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#user-u-user-group,Podman} +upstream documentation for semantics. @item @code{workdir} (default: @code{""}) (type: string) Set the current working directory for the spawned Shepherd service. You can refer to the -@url{https://docs.docker.com/engine/reference/run/#workdir,upstream} -documentation for semantics. +@url{https://docs.docker.com/engine/reference/run/#workdir,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#workdir-w-dir,Podman} +upstream documentation for semantics. + +@item @code{extra-arguments} (default: @code{'()}) (type: list) +A list of strings, gexps or file-like objects that will be directly passed +to the @command{docker run} or @command{podman run} invokation. + +@end table + +@end deftp + + +@c %end of fragment + +@c %start of fragment + +@deftp {Data Type} oci-network-configuration +Available @code{oci-network-configuration} fields are: + +@table @asis +@item @code{name} (type: string) +The name of the OCI network to provision. + +@item @code{driver} (type: maybe-string) +The driver to manage the network. + +@item @code{gateway} (type: maybe-string) +IPv4 or IPv6 gateway for the subnet. + +@item @code{internal?} (default: @code{#f}) (type: boolean) +Restrict external access to the network + +@item @code{ip-range} (type: maybe-string) +Allocate container ip from a sub-range in CIDR format. + +@item @code{ipam-driver} (type: maybe-string) +IP Address Management Driver. + +@item @code{ipv6?} (default: @code{#f}) (type: boolean) +Enable IPv6 networking. + +@item @code{subnet} (type: maybe-string) +Subnet in CIDR format that represents a network segment. + +@item @code{labels} (default: @code{'()}) (type: list) +The list of labels that will be used to tag the current volume. + +@item @code{extra-arguments} (default: @code{'()}) (type: list) +A list of strings, gexps or file-like objects that will be directly passed +to the @command{docker network create} or @command{podman network create} +invokation. + +@end table + +@end deftp + + +@c %end of fragment + +@c %start of fragment + +@deftp {Data Type} oci-volume-configuration +Available @code{oci-volume-configuration} fields are: + +@table @asis +@item @code{name} (type: string) +The name of the OCI volume to provision. + +@item @code{labels} (default: @code{'()}) (type: list) +The list of labels that will be used to tag the current volume. @item @code{extra-arguments} (default: @code{'()}) (type: list) -A list of strings, gexps or file-like objects that will be directly -passed to the @command{docker run} invocation. +A list of strings, gexps or file-like objects that will be directly passed +to the @command{docker volume create} or @command{podman volume create} +invokation. @end table diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm index 24f31c756b8..a78be00f038 100644 --- a/gnu/services/containers.scm +++ b/gnu/services/containers.scm @@ -39,8 +39,10 @@ (define-module (gnu services containers) #:use-module (guix packages) #:use-module (guix profiles) #:use-module ((guix scripts pack) #:prefix pack:) + #:use-module (guix records) #:use-module (guix store) #:use-module (srfi srfi-1) + #:use-module (ice-9 format) #:use-module (ice-9 match) #:export (rootless-podman-configuration rootless-podman-configuration? @@ -96,8 +98,80 @@ (define-module (gnu services containers) oci-container-configuration-workdir oci-container-configuration-extra-arguments + list-of-oci-containers? + list-of-oci-networks? + list-of-oci-volumes? + + %oci-supported-runtimes + oci-sanitize-runtime + oci-runtime-system-environment + oci-runtime-system-extra-arguments + oci-runtime-system-group + oci-runtime-system-requirement + oci-runtime-cli + oci-runtime-system-cli + oci-runtime-home-cli + oci-runtime-name + oci-runtime-group + + oci-network-configuration + oci-network-configuration? + oci-network-configuration-fields + oci-network-configuration-name + oci-network-configuration-driver + oci-network-configuration-gateway + oci-network-configuration-internal? + oci-network-configuration-ip-range + oci-network-configuration-ipam-driver + oci-network-configuration-ipv6? + oci-network-configuration-subnet + oci-network-configuration-labels + oci-network-configuration-extra-arguments + + oci-volume-configuration + oci-volume-configuration? + oci-volume-configuration-fields + oci-volume-configuration-name + oci-volume-configuration-labels + oci-volume-configuration-extra-arguments + + oci-configuration + oci-configuration? + oci-configuration-runtime + oci-configuration-runtime-cli + oci-configuration-runtime-extra-arguments + oci-configuration-user + oci-configuration-group + oci-configuration-containers + oci-configuration-networks + oci-configuration-volumes + oci-configuration-verbose? + oci-configuration-valid? + + oci-extension + oci-extension? + oci-extension-fields + oci-extension-containers + oci-extension-networks + oci-extension-volumes + + oci-container-shepherd-name + oci-networks-shepherd-name + oci-networks-home-shepherd-name + oci-volumes-shepherd-name + oci-volumes-home-shepherd-name + oci-container-shepherd-service - %oci-container-accounts)) + oci-objects-merge-lst + oci-extension-merge + oci-service-extension-wrap-validate + oci-service-type + oci-service-accounts + oci-service-profile + oci-service-subids + oci-state->shepherd-services + oci-configuration->shepherd-services + oci-configuration-extend)) (define (gexp-or-string? value) (or (gexp? value) @@ -296,9 +370,42 @@ (define rootless-podman-service-type ;;; -;;; OCI container. +;;; OCI provisioning service. ;;; +(define %oci-supported-runtimes + '(docker podman)) + +(define (oci-runtime-system-requirement runtime) + "Return a list of Shepherd service names required by a given OCI runtime, +before it is able to run containers." + (if (eq? 'podman runtime) + '(cgroups2-fs-owner cgroups2-limits + rootless-podman-shared-root-fs user-processes) + '(dockerd user-processes))) + +(define (oci-runtime-name runtime) + "Return a human readable name for a given OCI runtime." + (if (eq? 'podman runtime) + "Podman" "Docker")) + +(define (oci-runtime-group runtime maybe-group) + "Implement the logic behind selection of the group that is to be used by +Shepherd to execute OCI commands." + (if (eq? maybe-group #f) + (if (eq? 'podman runtime) + "cgroup" + "docker") + maybe-group)) + +(define (oci-sanitize-runtime value) + (unless (member value %oci-supported-runtimes) + (raise + (formatted-message + (G_ "OCI runtime must be a symbol and one of ~a, +but ~a was found") %oci-supported-runtimes value))) + value) + (define (oci-sanitize-pair pair delimiter) (define (valid? member) (or (string? member) @@ -347,6 +454,11 @@ (define (oci-sanitize-volumes value) ;; '(("/mnt/dir" . "/dir") "/run/current-system/profile:/java") (oci-sanitize-mixed-list "volumes" value ":")) +(define (oci-sanitize-labels value) + ;; Expected spec format: + ;; '(("foo" . "bar") "foo=bar") + (oci-sanitize-mixed-list "labels" value "=")) + (define (oci-sanitize-shepherd-actions value) (map (lambda (el) @@ -374,10 +486,15 @@ (define (oci-sanitize-extra-arguments value) value)) (define (oci-image-reference image) - (if (string? image) - image - (string-append (oci-image-repository image) - ":" (oci-image-tag image)))) + "Return a string OCI image reference representing IMAGE." + (define reference + (if (string? image) + image + (string-append (oci-image-repository image) + ":" (oci-image-tag image)))) + (if (> (length (string-split reference #\/)) 1) + reference + (string-append "localhost/" reference))) (define (oci-lowerable-image? image) (or (manifest? image) @@ -392,7 +509,19 @@ (define (string-or-oci-image? image) (define list-of-symbols? (list-of symbol?)) +(define (list-of-oci-records? name predicate value) + (map + (lambda (el) + (if (predicate el) + el + (raise + (formatted-message + (G_ "~a contains an illegal value: ~a") name el)))) + value)) + (define-maybe/no-serialization string) +(define-maybe/no-serialization package) +(define-maybe/no-serialization subid-range) (define-configuration/no-serialization oci-image (repository @@ -437,11 +566,15 @@ (define-configuration/no-serialization oci-image (define-configuration/no-serialization oci-container-configuration (user - (string "oci-container") - "The user under whose authority docker commands will be run.") + (maybe-string) + "The user name under whose authority OCI commands will be run. This field will +override the @code{user} field of @code{oci-configuration}.") (group - (string "docker") - "The group under whose authority docker commands will be run.") + (maybe-string) + "The group name under whose authority OCI commands will be run. When +using the @code{'podman} OCI runtime, this field will be ignored and the +default group of the user configured in the @code{user} field will be used. +This field will override the @code{group} field of @code{oci-configuration}.") (command (list-of-strings '()) "Overwrite the default command (@code{CMD}) of the image.") @@ -451,9 +584,9 @@ (define-configuration/no-serialization oci-container-configuration (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 +or @command{podman run} are invoked. This is especially useful to pass secrets +from the host to the container without having them on the OCI runtime command line, +for example: by setting the @code{MYSQL_PASSWORD} on the host and by passing @code{--env MYSQL_PASSWORD} through the @code{extra-arguments} field, it is possible to securely set values in the container environment. This field's value can be a list of pairs or strings, even mixed: @@ -477,15 +610,16 @@ (define-configuration/no-serialization oci-container-configuration @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." +directly to the OCI runtime CLI. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run/#env,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#env-e-env,Podman} +upstream documentation for semantics." (sanitizer oci-sanitize-environment)) (image (string-or-oci-image) "The image used to build the container. It can be a string or an -@code{oci-image} record. Strings are resolved by the Docker -Engine, and follow the usual format +@code{oci-image} record. Strings are resolved by the OCI runtime, +and follow the usual format @code{myregistry.local:5000/testing/test-image:tag}.") (provision (maybe-string) @@ -514,7 +648,7 @@ (define-configuration/no-serialization oci-container-configuration (sanitizer oci-sanitize-shepherd-actions)) (network (maybe-string) - "Set a Docker network for the spawned container.") + "Set an OCI network for the spawned container.") (ports (list '()) "Set the port or port ranges to expose from the spawned container. This can @@ -526,9 +660,10 @@ (define-configuration/no-serialization oci-container-configuration @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." +directly to the OCI runtime CLI. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run/#publish,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#publish-p-ip-hostport-containerport-protocol,Podman} +upstream documentation for semantics." (sanitizer oci-sanitize-ports)) (volumes (list '()) @@ -541,71 +676,363 @@ (define-configuration/no-serialization oci-container-configuration @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." +directly to the OCI runtime CLI. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run/#volume,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#volume-v-source-volume-host-dir-container-dir-options,Podman} +upstream documentation for semantics." (sanitizer oci-sanitize-volumes)) (container-user (maybe-string) "Set the current user inside the spawned container. You can refer to the -@url{https://docs.docker.com/engine/reference/run/#user,upstream} -documentation for semantics.") +@url{https://docs.docker.com/engine/reference/run/#user,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#user-u-user-group,Podman} +upstream documentation for semantics.") (workdir (maybe-string) - "Set the current working for the spawned Shepherd service. + "Set the current working directory for the spawned Shepherd service. You can refer to the -@url{https://docs.docker.com/engine/reference/run/#workdir,upstream} -documentation for semantics.") +@url{https://docs.docker.com/engine/reference/run/#workdir,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#workdir-w-dir,Podman} +upstream documentation for semantics.") (extra-arguments (list '()) "A list of strings, gexps or file-like objects that will be directly passed -to the @command{docker run} invokation." +to the @command{docker run} or @command{podman 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 (list-of-oci-containers? value) + (list-of-oci-records? "containers" oci-container-configuration? value)) + +(define-configuration/no-serialization oci-volume-configuration + (name + (string) + "The name of the OCI volume to provision.") + (labels + (list '()) + "The list of labels that will be used to tag the current volume." + (sanitizer oci-sanitize-labels)) + (extra-arguments + (list '()) + "A list of strings, gexps or file-like objects that will be directly passed +to the @command{docker volume create} or @command{podman volume create} +invocation." + (sanitizer oci-sanitize-extra-arguments))) + +(define (list-of-oci-volumes? value) + (list-of-oci-records? "volumes" oci-volume-configuration? value)) + +(define-configuration/no-serialization oci-network-configuration + (name + (string) + "The name of the OCI network to provision.") + (driver + (maybe-string) + "The driver to manage the network.") + (gateway + (maybe-string) + "IPv4 or IPv6 gateway for the subnet.") + (internal? + (boolean #f) + "Restrict external access to the network") + (ip-range + (maybe-string) + "Allocate container ip from a sub-range in CIDR format.") + (ipam-driver + (maybe-string) + "IP Address Management Driver.") + (ipv6? + (boolean #f) + "Enable IPv6 networking.") + (subnet + (maybe-string) + "Subnet in CIDR format that represents a network segment.") + (labels + (list '()) + "The list of labels that will be used to tag the current volume." + (sanitizer oci-sanitize-labels)) + (extra-arguments + (list '()) + "A list of strings, gexps or file-like objects that will be directly passed +to the @command{docker network create} or @command{podman network create} +invocation." + (sanitizer oci-sanitize-extra-arguments))) + +(define (list-of-oci-networks? value) + (list-of-oci-records? "networks" oci-network-configuration? value)) + +(define-record-type* + oci-configuration + make-oci-configuration + oci-configuration? + this-oci-configuration + + (runtime oci-configuration-runtime + (default 'docker)) + (runtime-cli oci-configuration-runtime-cli + (default #f)) ; package or string + (runtime-extra-arguments oci-configuration-runtime-extra-arguments ; strings or gexps + (default '())) ; or file-like objects + (user oci-configuration-user + (default "oci-container")) + (group oci-configuration-group ; string + (default #f)) + (subuids-range oci-configuration-subuids-range ; subid-range + (default #f)) + (subgids-range oci-configuration-subgids-range ; subid-range + (default #f)) + (containers oci-configuration-containers ; oci-container-configurations + (default '())) + (networks oci-configuration-networks ; oci-network-configurations + (default '())) + (volumes oci-configuration-volumes ; oci-volume-configurations + (default '())) + (verbose? oci-configuration-verbose? + (default #f)) + (home-service? oci-configuration-home-service? + (default for-home?) (innate))) + +(define (package-or-string? value) + (or (package? value) (string? value))) + +(define (oci-configuration-valid? config) + (define runtime-cli + (oci-configuration-runtime-cli config)) + (define group + (oci-configuration-group config)) + (define subuids-range + (oci-configuration-subuids-range config)) + (define subgids-range + (oci-configuration-subgids-range config)) + (and + (symbol? + (oci-sanitize-runtime (oci-configuration-runtime config))) + (or (eq? runtime-cli #f) + (package-or-string? runtime-cli)) + (list? (oci-configuration-runtime-extra-arguments config)) + (string? (oci-configuration-user config)) + (or (eq? group #f) + (string? group)) + (or (eq? subuids-range #f) + (subid-range? subuids-range)) + (or (eq? subgids-range #f) + (subid-range? subgids-range)) + (list-of-oci-containers? + (oci-configuration-containers config)) + (list-of-oci-networks? + (oci-configuration-networks config)) + (list-of-oci-volumes? + (oci-configuration-volumes config)) + (boolean? + (oci-configuration-verbose? config)) + (boolean? + (oci-configuration-home-service? config)))) + +(define (oci-runtime-system-environment runtime user) + (if (eq? runtime 'podman) + (list + #~(string-append + "HOME=" (passwd:dir (getpwnam #$user)))) + #~())) + +(define (oci-runtime-system-group runtime user group) + (if (eq? runtime 'podman) + #~(group:name + (getgrgid + (passwd:gid + (getpwnam #$user)))) + group)) + +(define (oci-runtime-cli runtime runtime-cli path) + "Return a gexp that, when lowered, evaluates to the file system path of the OCI +runtime command requested by the user." + (if (string? runtime-cli) + ;; It is a user defined absolute path + runtime-cli + #~(string-append + #$(if (eq? runtime-cli #f) + path + runtime-cli) + #$(if (eq? 'podman runtime) + "/bin/podman" + "/bin/docker")))) + +(define* (oci-runtime-system-cli config #:key (path "/run/current-system/profile")) + (let ((runtime-cli + (oci-configuration-runtime-cli config)) + (runtime + (oci-configuration-runtime config))) + (oci-runtime-cli runtime runtime-cli path))) + +(define (oci-runtime-home-cli config) + (let ((runtime-cli + (oci-configuration-runtime-cli config)) + (runtime + (oci-configuration-runtime config))) + (oci-runtime-cli runtime runtime-cli + (string-append (getenv "HOME") + "/.guix-home/profile")))) + +(define-configuration/no-serialization oci-extension + (containers + (list-of-oci-containers '()) + "The list of @code{oci-container-configuration} records representing the +containers to add.") + (networks + (list-of-oci-networks '()) + "The list of @code{oci-network-configuration} records representing the +networks to add.") + (volumes + (list-of-oci-volumes '()) + "The list of @code{oci-volume-configuration} records representing the +volumes to add.")) + +(define (oci-image->container-name image) + "Infer the name of an OCI backed Shepherd service from its OCI image." + (basename + (if (string? image) + (first (string-split image #\:)) + (oci-image-repository image)))) + +(define (oci-object-command-shepherd-action object-name invocation) + "Return a Shepherd action printing a given INVOCATION of an OCI command for the +given OBJECT-NAME." + (shepherd-action + (name 'command-line) + (documentation + (format #f "Prints ~a's OCI runtime command line invocation." + object-name)) + (procedure + #~(lambda _ + (format #t "~a~%" #$invocation))))) + +(define (oci-container-shepherd-name runtime config) + "Return the name of an OCI backed Shepherd service based on CONFIG. +The name configured in the configuration record is returned when +CONFIG's name field has a value, otherwise a name is inferred from CONFIG's +image field." + (define name (oci-container-configuration-provision config)) + (define image (oci-container-configuration-image config)) + + (if (maybe-value-set? name) + name + (string-append (symbol->string runtime) "-" + (oci-image->container-name image)))) + +(define (oci-networks-shepherd-name runtime) + "Return the name of the OCI networks provisioning Shepherd service based on +RUNTIME." + (string-append (symbol->string runtime) "-networks")) + +(define (oci-volumes-shepherd-name runtime) + "Return the name of the OCI volumes provisioning Shepherd service based on +RUNTIME." + (string-append (symbol->string runtime) "-volumes")) + +(define (oci-networks-home-shepherd-name runtime) + "Return the name of the OCI volumes provisioning Home Shepherd service based on +RUNTIME." + (string-append "home-" (oci-networks-shepherd-name runtime))) + +(define (oci-volumes-home-shepherd-name runtime) + "Return the name of the OCI volumes provisioning Home Shepherd service based on +RUNTIME." + (string-append "home-" (oci-volumes-shepherd-name runtime))) + +(define (oci-container-configuration->options config) + "Map CONFIG, an oci-container-configuration record, to a gexp that, upon +lowering, will be evaluated to a list of strings containing command line options +for the OCI runtime run command." + (let ((entrypoint + (oci-container-configuration-entrypoint config)) + (network + (oci-container-configuration-network config)) + (user + (oci-container-configuration-container-user config)) + (workdir + (oci-container-configuration-workdir config))) + (apply append + (filter (compose not unspecified?) + `(,(if (maybe-value-set? entrypoint) + `("--entrypoint" ,entrypoint) + '()) + ,(append-map + (lambda (spec) + (list "--env" spec)) + (oci-container-configuration-environment config)) + ,(if (maybe-value-set? network) + `("--network" ,network) + '()) + ,(if (maybe-value-set? user) + `("--user" ,user) + '()) + ,(if (maybe-value-set? workdir) + `("--workdir" ,workdir) + '()) + ,(append-map + (lambda (spec) + (list "-p" spec)) + (oci-container-configuration-ports config)) + ,(append-map + (lambda (spec) + (list "-v" spec)) + (oci-container-configuration-volumes config))))))) + +(define (oci-network-configuration->options config) + "Map CONFIG, an oci-network-configuration record, to a gexp that, upon +lowering, will be evaluated to a list of strings containing command line options +for the OCI runtime network create command." + (let ((driver (oci-network-configuration-driver config)) + (gateway + (oci-network-configuration-gateway config)) + (internal? + (oci-network-configuration-internal? config)) + (ip-range + (oci-network-configuration-ip-range config)) + (ipam-driver + (oci-network-configuration-ipam-driver config)) + (ipv6? + (oci-network-configuration-ipv6? config)) + (subnet + (oci-network-configuration-subnet config))) + (apply append + (filter (compose not unspecified?) + `(,(if (maybe-value-set? driver) + `("--driver" ,driver) + '()) + ,(if (maybe-value-set? gateway) + `("--gateway" ,gateway) + '()) + ,(if internal? + `("--internal") + '()) + ,(if (maybe-value-set? ip-range) + `("--ip-range" ,ip-range) + '()) + ,(if (maybe-value-set? ipam-driver) + `("--ipam-driver" ,ipam-driver) + '()) + ,(if ipv6? + `("--ipv6") + '()) + ,(if (maybe-value-set? subnet) + `("--subnet" ,subnet) + '()) + ,(append-map + (lambda (spec) + (list "--label" spec)) + (oci-network-configuration-labels config))))))) + +(define (oci-volume-configuration->options config) + "Map CONFIG, an oci-volume-configuration record, to a gexp that, upon +lowering, will be evaluated to a list of strings containing command line options +for the OCI runtime volume create command." + (append-map + (lambda (spec) + (list "--label" spec)) + (oci-volume-configuration-labels config))) (define (lower-operating-system os target system) + "Lower OS, an operating-system record, into a tarball containing an OCI image." (mlet* %store-monad ((tarball (lower-object @@ -614,24 +1041,11 @@ (define (lower-operating-system os target 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))))) - +(define (lower-manifest name value options image-reference + target system grafts?) + "Lower VALUE, a manifest record, into a tarball containing an OCI image." (mlet* %store-monad - ((_ (set-grafting - (oci-image-grafts? image))) + ((_ (set-grafting grafts?)) (guile (set-guile-for-build (default-guile))) (profile (profile-derivation value @@ -642,14 +1056,11 @@ (define (lower-manifest name image target system) (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 (lower-oci-image-state name value options reference + image-target image-system grafts?) (define target (if (maybe-value-set? image-target) image-target @@ -662,7 +1073,8 @@ (define (lower-oci-image name image) (run-with-store store (match value ((? manifest? value) - (lower-manifest name image target system)) + (lower-manifest name value options reference + target system grafts?)) ((? operating-system? value) (lower-operating-system value target system)) ((or (? gexp? value) @@ -677,113 +1089,686 @@ (define (lower-oci-image name image) #: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))) +(define (lower-oci-image name image) + "Lower IMAGE, a oci-image record, into a tarball containing an OCI image." + (lower-oci-image-state + name + (oci-image-value image) + (oci-image-pack-options image) + (oci-image-reference image) + (oci-image-target image) + (oci-image-system image) + (oci-image-grafts? image))) + +(define (oci-object-exists? runtime runtime-cli object verbose?) + #~(lambda* (name #:key (format-string "{{.Name}}")) + (use-modules (ice-9 format) + (ice-9 match) + (ice-9 popen) + (ice-9 rdelim) + (srfi srfi-1)) + + (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))) + + #$(if (eq? runtime 'podman) + #~(let ((command + (list #$runtime-cli + #$object "exists" name))) + (when #$verbose? + (format #t "Running~{ ~a~}~%" command)) + (define exit-code (status:exit-val (apply system* command))) + (when #$verbose? + (format #t "Exit code: ~a~%" exit-code)) + (equal? EXIT_SUCCESS exit-code)) + #~(let ((command + (string-append #$runtime-cli + " " #$object " ls --format " + "\"" format-string "\""))) + (when #$verbose? + (format #t "Running ~a~%" command)) + (member name (read-lines (open-input-pipe command))))))) + +(define* (oci-image-loader runtime runtime-cli name image tag #:key (verbose? #f)) + "Return a file-like object that, once lowered, will evaluate to a program able +to load IMAGE through RUNTIME-CLI and to tag it with TAG afterwards." + (let ((tarball (lower-oci-image name image))) (with-imported-modules '((guix build utils)) - (program-file (format #f "~a-image-loader" name) + (program-file + (format #f "~a-image-loader" name) #~(begin (use-modules (guix build utils) + (ice-9 match) (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)) + (ice-9 rdelim) + (srfi srfi-1)) + (define object-exists? + #$(oci-object-exists? runtime runtime-cli "image" verbose?)) + (define load-command + (string-append #$runtime-cli + " load -i " #$tarball)) + + (if (object-exists? #$tag #:format-string "{{.Repository}}:{{.Tag}}") + (format #t "~a image already exists, skipping.~%" #$tag) + (begin + (format #t "Loading image for ~a from ~a...~%" #$name #$tarball) + (when #$verbose? + (format #t "Running ~a~%" load-command)) + (let ((line (read-line + (open-input-pipe load-command)))) + (unless (or (eof-object? line) + (string-null? line)) + (format #t "~a~%" line) + (let* ((repository&tag + (string-drop line + (string-length + "Loaded image: "))) + (tag-command + (list #$runtime-cli "tag" repository&tag #$tag)) + (drop-old-tag-command + (list #$runtime-cli "image" "rm" "-f" repository&tag))) + + (unless (string=? repository&tag #$tag) + (when #$verbose? + (format #t "Running~{ ~a~}~%" tag-command)) + + (let ((exit-code + (status:exit-val (apply system* tag-command)))) + (format #t "Tagged ~a with ~a...~%" #$tarball #$tag) + + (when #$verbose? + (format #t "Exit code: ~a~%" exit-code)) + + (when (equal? EXIT_SUCCESS exit-code) + (when #$verbose? + (format #t "Running~{ ~a~}~%" drop-old-tag-command)) + (let ((drop-exit-code + (status:exit-val (apply system* drop-old-tag-command)))) + (when #$verbose? + (format #t "Exit code: ~a~%" drop-exit-code)))))))))))))))) + +(define (oci-container-run-invocation runtime runtime-cli name command image-reference + options runtime-extra-arguments run-extra-arguments) + "Return a list representing the OCI runtime +invocation for running containers." + ;; run [OPTIONS] IMAGE [COMMAND] [ARG...] + `(,runtime-cli ,@runtime-extra-arguments "run" "--rm" + ,@(if (eq? runtime 'podman) + ;; This is because podman takes some time to + ;; release container names. --replace seems + ;; to be required to be able to restart services. + '("--replace") + '()) + "--name" ,name + ,@options ,@run-extra-arguments + ,image-reference ,@command)) + +(define* (oci-container-entrypoint runtime runtime-cli name image image-reference + invocation #:key (verbose? #f) (pre-script #~())) + "Return a file-like object that, once lowered, will evaluate to the entrypoint +for the Shepherd service that will run IMAGE through RUNTIME-CLI." + (program-file + (string-append "oci-entrypoint-" name) + #~(begin + (use-modules (ice-9 format) + (srfi srfi-1)) + (when #$verbose? + (format #t "Running in verbose mode...~%") + (format #t "Current user: ~a ~a~%" + (getuid) (passwd:name (getpwuid (getuid)))) + (format #t "Current group: ~a ~a~%" + (getgid) (group:name (getgrgid (getgid)))) + (format #t "Current directory ~a~%" (getcwd))) + (define invocation (list #$@invocation)) + #$@pre-script + (when #$verbose? + (format #t "Running~{ ~a~}~%" invocation)) + (apply execlp `(,(first invocation) ,@invocation))))) + +(define* (oci-container-shepherd-service runtime runtime-cli config + #:key + (runtime-environment #~()) + (runtime-extra-arguments '()) + (oci-requirement '()) + (user #f) + (group #f) + (verbose? #f)) + "Return a Shepherd service object that will run the OCI container represented +by CONFIG through RUNTIME-CLI." + (let* ((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)) + (maybe-user (oci-container-configuration-user config)) + (maybe-group (oci-container-configuration-group config)) + (user (if (maybe-value-set? maybe-user) + maybe-user + user)) + (group (if (maybe-value-set? maybe-group) + maybe-group + group)) (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)) + (name + (oci-container-shepherd-name runtime config)) (extra-arguments - (oci-container-configuration-extra-arguments config))) + (oci-container-configuration-extra-arguments config)) + (invocation + (oci-container-run-invocation + runtime runtime-cli name command image-reference + options runtime-extra-arguments extra-arguments)) + (container-action + (lambda* (command #:key (environment-variables #f)) + #~(lambda _ + (fork+exec-command + (list #$@command) + #$@(if user (list #:user user) '()) + #$@(if group (list #:group group) '()) + #$@(if (maybe-value-set? log-file) + (list #:log-file log-file) + '()) + #$@(if (and user (eq? runtime 'podman)) + (list #:directory + #~(passwd:dir (getpwnam #$user))) + '()) + #$@(if environment-variables + (list #:environment-variables + environment-variables) + '())))))) (shepherd-service (provision `(,(string->symbol name))) - (requirement `(dockerd user-processes ,@requirement)) + (requirement `(,@oci-requirement + ,@requirement)) (respawn? respawn?) (auto-start? auto-start?) (documentation (string-append - "Docker backed Shepherd service for " + (oci-runtime-name runtime) " 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)))) + (container-action + (list (oci-container-entrypoint + runtime runtime-cli name image image-reference + invocation #:verbose? verbose? + #:pre-script + (if (oci-image? image) + #~((system* + #$(oci-image-loader + runtime runtime-cli name image + image-reference #:verbose? verbose?))) + #~()))) + #:environment-variables + #~(append + (list #$@host-environment) + (list #$@runtime-environment)))) (stop - #~(lambda _ - (invoke #$docker "rm" "-f" #$name))) + (container-action + (list + (oci-container-entrypoint + runtime runtime-cli name image image-reference + (list runtime-cli "rm" "-f" name) + #:verbose? verbose?)) + #:environment-variables + #~(append + (list #$@host-environment) + (list #$@runtime-environment)))) (actions - (if (oci-image? image) - '() - (append + (append + (list + (oci-object-command-shepherd-action + name #~(string-join (list #$@invocation) " "))) + (if (oci-image? image) + '() (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 + (let ((service-name name)) + (shepherd-action + (name 'pull) + (documentation + (format #f "Pull ~a's image (~a)." + service-name image)) + (procedure + (container-action + (list + (oci-container-entrypoint + runtime runtime-cli service-name image + image-reference + (list runtime-cli "pull" image) + #:verbose? verbose?)) + #:environment-variables + #~(append + (list #$@host-environment) + (list #$@runtime-environment)))))))) + actions))))) + +(define (oci-object-create-invocation object runtime-cli name options + runtime-extra-arguments + create-extra-arguments) + "Return a gexp that, upon lowering, will evaluate to the OCI runtime +invocation for creating networks and volumes." + ;; network|volume create [options] [NAME] + #~(list #$runtime-cli #$@runtime-extra-arguments #$object "create" + #$@options #$@create-extra-arguments #$name)) + +(define (format-oci-invocations invocations) + "Return a gexp that, upon lowering, will evaluate to a formatted message +containing the INVOCATIONS that the OCI runtime will execute to provision +networks or volumes." + #~(string-join (map (lambda (i) (string-join i " ")) + (list #$@invocations)) + "\n")) + +(define* (oci-object-create-script object runtime runtime-cli invocations + #:key (verbose? #f)) + "Return a file-like object that, once lowered, will evaluate to a program able +to create OCI networks and volumes through RUNTIME-CLI." + (define runtime-string (symbol->string runtime)) + (program-file + (string-append runtime-string "-" object "s-create.scm") + #~(begin + (use-modules (ice-9 format) + (ice-9 match) + (ice-9 popen) + (ice-9 rdelim) + (srfi srfi-1)) + + (define object-exists? + #$(oci-object-exists? runtime runtime-cli object verbose?)) + + (for-each + (lambda (invocation) + (define name (last invocation)) + (if (object-exists? name) + (format #t "~a ~a ~a already exists, skipping creation.~%" + #$(oci-runtime-name runtime) name #$object) + (begin + (when #$verbose? + (format #t "Running~{ ~a~}~%" invocation)) + (let ((exit-code (status:exit-val (apply system* invocation)))) + (when #$verbose? + (format #t "Exit code: ~a~%" exit-code)))))) + (list #$@invocations))))) + +(define* (oci-object-shepherd-service object runtime runtime-cli name requirement invocations + #:key + (runtime-environment #~()) + (user #f) + (group #f) + (verbose? #f)) + "Return a Shepherd service object that will create the OBJECTs represented +by INVOCATIONS through RUNTIME-CLI." + (shepherd-service (provision `(,(string->symbol name))) + (requirement requirement) + (one-shot? #t) + (documentation + (string-append + (oci-runtime-name runtime) " " object + " provisioning service")) + (start + #~(lambda _ + (fork+exec-command + (list + #$(oci-object-create-script + object runtime runtime-cli + invocations + #:verbose? verbose?)) + #$@(if user (list #:user user) '()) + #$@(if group (list #:group group) '()) + #:environment-variables + (list #$@runtime-environment)))) + (actions + (list + (oci-object-command-shepherd-action + name (format-oci-invocations invocations)))))) + +(define* (oci-networks-shepherd-service runtime runtime-cli name networks + #:key (user #f) (group #f) (verbose? #f) + (runtime-extra-arguments '()) + (runtime-environment #~()) + (runtime-requirement '())) + "Return a Shepherd service object that will create the networks represented +in CONFIG." + (let ((invocations + (map + (lambda (network) + (oci-object-create-invocation + "network" runtime-cli + (oci-network-configuration-name network) + (oci-network-configuration->options network) + runtime-extra-arguments + (oci-network-configuration-extra-arguments network))) + networks))) + + (oci-object-shepherd-service + "network" runtime runtime-cli name + runtime-requirement invocations + #:user user #:group group #:runtime-environment runtime-environment + #:verbose? verbose?))) + +(define* (oci-volumes-shepherd-service runtime runtime-cli name volumes + #:key (user #f) (group #f) (verbose? #f) + (runtime-extra-arguments '()) + (runtime-environment #~()) + (runtime-requirement '())) + "Return a Shepherd service object that will create the volumes represented +in CONFIG." + (let ((invocations + (map + (lambda (volume) + (oci-object-create-invocation + "volume" runtime-cli + (oci-volume-configuration-name volume) + (oci-volume-configuration->options volume) + runtime-extra-arguments + (oci-volume-configuration-extra-arguments volume))) + volumes))) + + (oci-object-shepherd-service + "volume" runtime runtime-cli name runtime-requirement invocations + #:user user #:group group #:runtime-environment runtime-environment + #:verbose? verbose?))) + +(define (oci-service-accounts config) + (define user (oci-configuration-user config)) + (define maybe-group (oci-configuration-group config)) + (define runtime (oci-configuration-runtime config)) (list (user-account - (name "oci-container") + (name user) (comment "OCI services account") - (group "docker") - (system? #t) - (home-directory "/var/empty") + (group "users") + (supplementary-groups + (list (oci-runtime-group runtime maybe-group))) + (system? (eq? 'docker runtime)) + (home-directory (if (eq? 'podman runtime) + (string-append "/home/" user) + "/var/empty")) + (create-home-directory? (eq? 'podman runtime)) (shell (file-append shadow "/sbin/nologin"))))) + +(define* (oci-state->shepherd-services runtime runtime-cli containers networks volumes + #:key (user #f) (group #f) (verbose? #f) + (networks-name #f) (volumes-name #f) + (runtime-extra-arguments '()) + (runtime-environment #~()) + (runtime-requirement '()) + (containers-requirement '()) + (networks-requirement '()) + (volumes-requirement '())) + "Returns a list of Shepherd services based on the input OCI state." + (let* ((networks-name + (if (string? networks-name) + networks-name + (oci-networks-shepherd-name runtime))) + (networks? + (> (length networks) 0)) + (networks-service + (if networks? + (list + (string->symbol networks-name)) + '())) + (volumes-name + (if (string? volumes-name) + volumes-name + (oci-volumes-shepherd-name runtime))) + (volumes? + (> (length volumes) 0)) + (volumes-service + (if volumes? + (list (string->symbol volumes-name)) + '()))) + (append + (map + (lambda (c) + (oci-container-shepherd-service + runtime runtime-cli c + #:user user + #:group group + #:runtime-environment runtime-environment + #:runtime-extra-arguments runtime-extra-arguments + #:oci-requirement + (append containers-requirement + runtime-requirement + networks-service + volumes-service) + #:verbose? verbose?)) + containers) + (if networks? + (list + (oci-networks-shepherd-service + runtime runtime-cli + networks-name networks + #:user user #:group group + #:runtime-extra-arguments runtime-extra-arguments + #:runtime-environment runtime-environment + #:runtime-requirement (append networks-requirement + runtime-requirement) + #:verbose? verbose?)) + '()) + (if volumes? + (list + (oci-volumes-shepherd-service + runtime runtime-cli + volumes-name volumes + #:user user #:group group + #:runtime-extra-arguments runtime-extra-arguments + #:runtime-environment runtime-environment + #:runtime-requirement (append runtime-requirement + volumes-requirement) + #:verbose? verbose?)) + '())))) + +(define (oci-configuration->shepherd-services config) + (let* ((runtime (oci-configuration-runtime config)) + (system-runtime-cli + (oci-runtime-system-cli config)) + (home-runtime-cli + (oci-runtime-home-cli config)) + (runtime-extra-arguments + (oci-configuration-runtime-extra-arguments config)) + (containers (oci-configuration-containers config)) + (networks (oci-configuration-networks config)) + (volumes (oci-configuration-volumes config)) + (user (oci-configuration-user config)) + (group (oci-runtime-group + runtime (oci-configuration-group config))) + (verbose? (oci-configuration-verbose? config)) + (home-service? + (oci-configuration-home-service? config))) + (if home-service? + (oci-state->shepherd-services runtime home-runtime-cli containers networks volumes + #:verbose? verbose? + #:networks-name + (oci-networks-home-shepherd-name runtime) + #:volumes-name + (oci-volumes-home-shepherd-name runtime)) + (oci-state->shepherd-services runtime system-runtime-cli containers networks volumes + #:user user + #:group + (oci-runtime-system-group runtime user group) + #:verbose? verbose? + #:runtime-extra-arguments + runtime-extra-arguments + #:runtime-environment + (oci-runtime-system-environment runtime user) + #:runtime-requirement + (oci-runtime-system-requirement runtime) + #:networks-requirement '(networking))))) + +(define (oci-service-subids config) + "Return a subids-extension record representing subuids and subgids required by +the rootless Podman backend." + (define (delete-duplicate-ranges ranges) + (delete-duplicates ranges + (lambda args + (apply string=? (map subid-range-name ranges))))) + (define runtime + (oci-configuration-runtime config)) + (define user + (oci-configuration-user config)) + (define subgids (oci-configuration-subgids-range config)) + (define subuids (oci-configuration-subuids-range config)) + (define container-users + (filter (lambda (range) + (and (maybe-value-set? + (subid-range-name range)) + (not (string=? (subid-range-name range) user)))) + (map (lambda (container) + (subid-range + (name + (oci-container-configuration-user container)))) + (oci-configuration-containers config)))) + (define subgid-ranges + (delete-duplicate-ranges + (cons + (if (eq? subgids #f) + (subid-range (name user)) + subgids) + container-users))) + (define subuid-ranges + (delete-duplicate-ranges + (cons + (if (eq? subuids #f) + (subid-range (name user)) + subuids) + container-users))) + + (if (eq? 'podman runtime) + (subids-extension + (subgids + subgid-ranges) + (subuids + subuid-ranges)) + (subids-extension))) + +(define (oci-objects-merge-lst a b object get-name) + (define (contains? value lst) + (member value (map get-name lst))) + (let loop ((merged '()) + (lst (append a b))) + (if (null? lst) + merged + (loop + (let ((element (car lst))) + (when (contains? element merged) + (raise + (formatted-message + (G_ "Duplicated ~a: ~a. ~as names should be unique, please +remove the duplicate.") object (get-name element) object))) + (cons element merged)) + (cdr lst))))) + +(define (oci-extension-merge a b) + (oci-extension + (containers (oci-objects-merge-lst + (oci-extension-containers a) + (oci-extension-containers b) + "container" + (lambda (config) + (define maybe-name (oci-container-configuration-provision config)) + (if (maybe-value-set? maybe-name) + maybe-name + (oci-image->container-name + (oci-container-configuration-image config)))))) + (networks (oci-objects-merge-lst + (oci-extension-networks a) + (oci-extension-networks b) + "network" + oci-network-configuration-name)) + (volumes (oci-objects-merge-lst + (oci-extension-volumes a) + (oci-extension-volumes b) + "volume" + oci-volume-configuration-name)))) + +(define (oci-service-profile runtime runtime-cli) + `(,bash-minimal + ,@(if (string? runtime-cli) + '() + (list + (cond + ((not (eq? runtime-cli #f)) + runtime-cli) + ((eq? 'podman runtime) + podman) + (else + docker-cli)))))) + +(define (oci-service-extension-wrap-validate extension) + (lambda (config) + (if (oci-configuration-valid? config) + (extension config) + (raise + (formatted-message + (G_ "Invalide oci-configuration ~a.") config))))) + +(define (oci-configuration-extend config extension) + (oci-configuration + (inherit config) + (containers + (oci-objects-merge-lst + (oci-configuration-containers config) + (oci-extension-containers extension) + "container" + (lambda (oci-config) + (define runtime + (oci-configuration-runtime config)) + (oci-container-shepherd-name runtime oci-config)))) + (networks (oci-objects-merge-lst + (oci-configuration-networks config) + (oci-extension-networks extension) + "network" + oci-network-configuration-name)) + (volumes (oci-objects-merge-lst + (oci-configuration-volumes config) + (oci-extension-volumes extension) + "volume" + oci-volume-configuration-name)))) + +(define oci-service-type + (service-type (name 'oci) + (extensions + (list + (service-extension profile-service-type + (oci-service-extension-wrap-validate + (lambda (config) + (let ((runtime-cli + (oci-configuration-runtime-cli config)) + (runtime + (oci-configuration-runtime config))) + (oci-service-profile runtime runtime-cli))))) + (service-extension subids-service-type + (oci-service-extension-wrap-validate + oci-service-subids)) + (service-extension account-service-type + (oci-service-extension-wrap-validate + oci-service-accounts)) + (service-extension shepherd-root-service-type + (oci-service-extension-wrap-validate + oci-configuration->shepherd-services)))) + ;; Concatenate OCI object lists. + (compose (lambda (args) + (fold oci-extension-merge + (oci-extension) + args))) + (extend oci-configuration-extend) + (default-value (oci-configuration)) + (description + "This service implements the provisioning of OCI object such +as containers, networks and volumes."))) diff --git a/gnu/services/docker.scm b/gnu/services/docker.scm index 828ceea313a..125e748bb0e 100644 --- a/gnu/services/docker.scm +++ b/gnu/services/docker.scm @@ -31,7 +31,10 @@ (define-module (gnu services docker) #:use-module (gnu system shadow) #:use-module (gnu packages docker) #:use-module (gnu packages linux) ;singularity + #:use-module (guix deprecation) + #:use-module (guix diagnostics) #:use-module (guix gexp) + #:use-module (guix i18n) #:use-module (guix records) #:use-module (srfi srfi-1) #:use-module (ice-9 format) @@ -67,16 +70,18 @@ (define-module (gnu services docker) 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) + oci-container-configuration-extra-arguments) #:export (containerd-configuration containerd-service-type docker-configuration docker-service-type singularity-service-type - oci-container-service-type)) + ;; for backwards compatibility, until the + ;; oci-container-service-type is fully deprecated + oci-container-shepherd-service + oci-container-service-type + %oci-container-accounts)) (define-maybe file-like) @@ -297,17 +302,25 @@ (define singularity-service-type ;;; OCI container. ;;; -(define (configs->shepherd-services configs) - (map oci-container-shepherd-service configs)) +;; for backwards compatibility, until the +;; oci-container-service-type is fully deprecated +(define-deprecated (oci-container-shepherd-service config) + oci-service-type + ((@ (gnu services containers) oci-container-shepherd-service) + 'docker config)) +(define %oci-container-accounts + (filter user-account? (oci-service-accounts (oci-configuration)))) (define oci-container-service-type (service-type (name 'oci-container) - (extensions (list (service-extension profile-service-type - (lambda _ (list docker-cli))) - (service-extension account-service-type - (const %oci-container-accounts)) - (service-extension shepherd-root-service-type - configs->shepherd-services))) + (extensions + (list (service-extension oci-service-type + (lambda (containers) + (warning + (G_ + "'oci-container-service-type' is deprecated, use 'oci-service-type' instead~%")) + (oci-extension + (containers containers)))))) (default-value '()) (extend append) (compose concatenate) diff --git a/gnu/tests/containers.scm b/gnu/tests/containers.scm index 0ecc8ddb126..5e6f39387e7 100644 --- a/gnu/tests/containers.scm +++ b/gnu/tests/containers.scm @@ -27,6 +27,9 @@ (define-module (gnu tests containers) #: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 @@ (define-module (gnu tests containers) #: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 @@ -345,3 +350,995 @@ (define %test-rootless-podman (name "rootless-podman") (description "Test rootless Podman service.") (value (build-tarball&run-rootless-podman-test)))) + + +(define %oci-rootless-podman-os + (simple-operating-system + (service dhcp-client-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-configuration (name "my-network")))) + (volumes + (list (oci-volume-configuration (name "my-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)(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 services herd) + (guix combinators)))) + + (define vm + (virtual-machine + (operating-system os) + (volatile? #f) + (memory-size 1024) + (disk-image-size (* 3000 (expt 2 20))) + (port-forwardings '()))) + + (define test + (with-imported-modules '((gnu build marionette)) + #~(begin + (use-modules (srfi srfi-11) (srfi srfi-64) + (gnu build marionette)) + + (define marionette + ;; Relax timeout to accommodate older systems and + ;; allow for pulling the image. + (make-marionette (list #$vm) #:timeout 60)) + (define out-dir "/tmp") + + (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 "rootless-podman services started successfully" + (begin + (define (run-test) + (marionette-eval + `(begin + (use-modules (ice-9 popen) + (ice-9 match) + (ice-9 rdelim)) + + (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 slurp + (lambda args + (let* ((port (apply open-pipe* OPEN_READ args)) + (output (read-lines port)) + (status (close-pipe port))) + output))) + (let* ((bash + ,(string-append #$bash "/bin/bash")) + (response1 + (slurp bash "-c" + (string-append "ls -la /sys/fs/cgroup | " + "grep -E ' \\./?$' | awk '{ print $4 }'"))) + (response2 (slurp bash "-c" + (string-append "ls -l /sys/fs/cgroup/cgroup" + ".{procs,subtree_control,threads} | " + "awk '{ print $4 }' | sort -u")))) + (list (string-join response1 "\n") (string-join response2 "\n")))) + marionette)) + ;; Allow services to come up on slower machines + (let loop ((attempts 0)) + (if (= attempts 60) + (error "Services didn't come up after more than 60 seconds") + (if (equal? '("cgroup" "cgroup") + (run-test)) + #t + (begin + (sleep 1) + (format #t "Services didn't come up yet, retrying with attempt ~a~%" + (+ 1 attempts)) + (loop (+ 1 attempts)))))))) + + (test-assert "podman-volumes running" + (begin + (define (run-test) + (marionette-eval + `(begin + (use-modules (srfi srfi-1) + (ice-9 popen) + (ice-9 match) + (ice-9 rdelim)) + + (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 (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 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))) + + (match (primitive-fork) + (0 + (dynamic-wind + (const #f) + (lambda () + (setgid (passwd:gid (getpwnam "oci-container"))) + (setuid (passwd:uid (getpw "oci-container"))) + + (let ((response (slurp + "/run/current-system/profile/bin/podman" + "volume" "ls" "-n" "--format" "\"{{.Name}}\"" + "|" "tr" "' '" "'\n'"))) + + (call-with-output-file (string-append ,out-dir "/response") + (lambda (port) + (display (string-join response "\n") port))))) + (lambda () + (primitive-exit 127)))) + (pid + (cdr (waitpid pid)))) + + (wait-for-file (string-append ,out-dir "/response")) + + (stable-sort + (slurp "cat" (string-append ,out-dir "/response")) + string<=?)) + marionette)) + ;; Allow services to come up on slower machines + (let loop ((attempts 0)) + (if (= attempts 80) + (error "Service didn't come up after more than 80 seconds") + (if (equal? '("my-volume") + (run-test)) + #t + (begin + (sleep 1) + (loop (+ 1 attempts)))))))) + + (test-assert "podman-networks running" + (begin + (define (run-test) + (marionette-eval + `(begin + (use-modules (srfi srfi-1) + (ice-9 popen) + (ice-9 match) + (ice-9 rdelim)) + + (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 (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 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))) + + (match (primitive-fork) + (0 + (dynamic-wind + (const #f) + (lambda () + (setgid (passwd:gid (getpwnam "oci-container"))) + (setuid (passwd:uid (getpw "oci-container"))) + + (let ((response (slurp + "/run/current-system/profile/bin/podman" + "network" "ls" "-n" "--format" "\"{{.Name}}\"" + "|" "tr" "' '" "'\n'"))) + + (call-with-output-file (string-append ,out-dir "/response") + (lambda (port) + (display (string-join response "\n") port))))) + (lambda () + (primitive-exit 127)))) + (pid + (cdr (waitpid pid)))) + + (wait-for-file (string-append ,out-dir "/response")) + + (stable-sort + (slurp "cat" (string-append ,out-dir "/response")) + string<=?)) + marionette)) + ;; Allow services to come up on slower machines + (let loop ((attempts 0)) + (if (= attempts 80) + (error "Service didn't come up after more than 80 seconds") + (if (equal? '("my-network" "podman") + (run-test)) + #t + (begin + (sleep 1) + (loop (+ 1 attempts)))))))) + + (test-assert "first container running" + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (wait-for-service 'first #:timeout 120) + #t) + marionette)) + + (test-assert "second container running" + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (wait-for-service 'second #:timeout 120) + #t) + marionette)) + + (test-assert "passing host environment variables" + (begin + (define (run-test) + (marionette-eval + `(begin + (use-modules (srfi srfi-1) + (ice-9 popen) + (ice-9 match) + (ice-9 rdelim)) + + (define (wait-for-file file) + ;; Wait until FILE shows up. + (let loop ((i 60)) + (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 (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 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))) + + (match (primitive-fork) + (0 + (dynamic-wind + (const #f) + (lambda () + (setgid (passwd:gid (getpwnam "oci-container"))) + (setuid (passwd:uid (getpw "oci-container"))) + + (let ((response (slurp + "/run/current-system/profile/bin/podman" + "exec" "first" + "/bin/guile" "-c" "'(display (getenv \"VARIABLE\"))'"))) + (call-with-output-file (string-append ,out-dir "/response") + (lambda (port) + (display (string-join response "\n") port))))) + (lambda () + (primitive-exit 127)))) + (pid + (cdr (waitpid pid)))) + + (wait-for-file (string-append ,out-dir "/response")) + (slurp "cat" (string-append ,out-dir "/response"))) + marionette)) + ;; Allow image to be loaded on slower machines + (let loop ((attempts 0)) + (if (= attempts 180) + (error "Service didn't come up after more than 180 seconds") + (if (equal? (list "value") + (run-test)) + #t + (begin + (sleep 1) + (loop (+ 1 attempts)))))))) + + (test-equal "mounting host files" + '("hello") + (marionette-eval + `(begin + (use-modules (srfi srfi-1) + (ice-9 popen) + (ice-9 match) + (ice-9 rdelim)) + + (define (wait-for-file file) + ;; Wait until FILE shows up. + (let loop ((i 60)) + (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 (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 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))) + + (match (primitive-fork) + (0 + (dynamic-wind + (const #f) + (lambda () + (setgid (passwd:gid (getpwnam "oci-container"))) + (setuid (passwd:uid (getpw "oci-container"))) + + (let ((response (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)))'"))) + (call-with-output-file (string-append ,out-dir "/response") + (lambda (port) + (display (string-join response " ") port))))) + (lambda () + (primitive-exit 127)))) + (pid + (cdr (waitpid pid)))) + + (wait-for-file (string-append ,out-dir "/response")) + (slurp "cat" (string-append ,out-dir "/response"))) + marionette)) + + (test-equal "write to volumes" + '("world") + (marionette-eval + `(begin + (use-modules (srfi srfi-1) + (ice-9 popen) + (ice-9 match) + (ice-9 rdelim)) + + (define (wait-for-file file) + ;; Wait until FILE shows up. + (let loop ((i 60)) + (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 (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 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))) + + (match (primitive-fork) + (0 + (dynamic-wind + (const #f) + (lambda () + (setgid (passwd:gid (getpwnam "oci-container"))) + (setuid (passwd:uid (getpw "oci-container"))) + + (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))))'") + + (let ((response (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)))'"))) + (call-with-output-file (string-append ,out-dir "/response") + (lambda (port) + (display (string-join response " ") port))))) + (lambda () + (primitive-exit 127)))) + (pid + (cdr (waitpid pid)))) + + (wait-for-file (string-append ,out-dir "/response")) + (slurp "cat" (string-append ,out-dir "/response"))) + marionette)) + + (test-equal "can read ports over network" + '("out of office") + (marionette-eval + `(begin + (use-modules (srfi srfi-1) + (ice-9 popen) + (ice-9 match) + (ice-9 rdelim)) + + (define (wait-for-file file) + ;; Wait until FILE shows up. + (let loop ((i 60)) + (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 (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 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))) + + (match (primitive-fork) + (0 + (dynamic-wind + (const #f) + (lambda () + (setgid (passwd:gid (getpwnam "oci-container"))) + (setuid (passwd:uid (getpw "oci-container"))) + + (let ((response (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))'"))) + (call-with-output-file (string-append ,out-dir "/response") + (lambda (port) + (display (string-join response " ") port))))) + (lambda () + (primitive-exit 127)))) + (pid + (cdr (waitpid pid)))) + + (wait-for-file (string-append ,out-dir "/response")) + (slurp "cat" (string-append ,out-dir "/response"))) + 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-os + (simple-operating-system + (service dhcp-client-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-configuration (name "my-network")))) + (volumes + (list (oci-volume-configuration (name "my-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)(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 services herd) + (guix combinators)))) + + (define vm + (virtual-machine + (operating-system os) + (volatile? #f) + (memory-size 1024) + (disk-image-size (* 3000 (expt 2 20))) + (port-forwardings '()))) + + (define test + (with-imported-modules '((gnu build marionette)) + #~(begin + (use-modules (srfi srfi-11) (srfi srfi-64) + (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) + (marionette-eval + `(begin + (use-modules (ice-9 popen) + (ice-9 rdelim)) + + (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 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))) + + (stable-sort + (slurp + "/run/current-system/profile/bin/docker" + "volume" "ls" "--format" "\"{{.Name}}\"") + string<=?)) + + marionette)) + ;; Allow services to come up on slower machines + (let loop ((attempts 0)) + (if (= attempts 80) + (error "Service didn't come up after more than 80 seconds") + (if (equal? '("my-volume") + (run-test)) + #t + (begin + (sleep 1) + (loop (+ 1 attempts)))))))) + + (test-assert "docker-networks running" + (begin + (define (run-test) + (marionette-eval + `(begin + (use-modules (ice-9 popen) + (ice-9 rdelim)) + + (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 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))) + + (stable-sort + (slurp + "/run/current-system/profile/bin/docker" + "network" "ls" "--format" "\"{{.Name}}\"") + string<=?)) + + marionette)) + ;; Allow services to come up on slower machines + (let loop ((attempts 0)) + (if (= attempts 80) + (error "Service didn't come up after more than 80 seconds") + (if (equal? '("bridge" "host" "my-network" "none") + (run-test)) + #t + (begin + (sleep 1) + (loop (+ 1 attempts)))))))) + + (test-assert "first container running" + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (wait-for-service 'first #:timeout 120) + #t) + marionette)) + + (test-assert "second container running" + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (wait-for-service 'second #:timeout 120) + #t) + marionette)) + + (test-assert "passing host environment variables" + (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))) + + (slurp + "/run/current-system/profile/bin/docker" + "exec" "first" + "/bin/guile" "-c" "(display (getenv \"VARIABLE\"))")) + marionette)) + ;; Allow image to be loaded on slower machines + (let loop ((attempts 0)) + (if (= attempts 180) + (error "Service didn't come up after more than 180 seconds") + (if (equal? "value" + (run-test)) + #t + (begin + (sleep 1) + (loop (+ 1 attempts)))))))) + + (test-equal "mounting host files" + "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))) + + (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 \"/shared.txt\" read-line)))")) + marionette)) + + (test-equal "write to volumes" + "world" + (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))) + + (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 ports over network" + "out of office" + (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))) + + (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)))) -- 2.48.1 From unknown Fri Jun 13 11:55:10 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#76081] [PATCH v8 1/5] services: rootless-podman: Use login shell. References: <2f43e635-508c-407a-8309-06e75d492d89@autistici.org> In-Reply-To: <2f43e635-508c-407a-8309-06e75d492d89@autistici.org> Resent-From: Giacomo Leidi Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sun, 09 Mar 2025 01:07:03 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 76081 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 76081@debbugs.gnu.org Cc: Giacomo Leidi Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.17414823891194 (code B ref 76081); Sun, 09 Mar 2025 01:07:03 +0000 Received: (at 76081) by debbugs.gnu.org; 9 Mar 2025 01:06:29 +0000 Received: from localhost ([127.0.0.1]:57382 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tr57c-0000J9-O1 for submit@debbugs.gnu.org; Sat, 08 Mar 2025 20:06:29 -0500 Received: from confino.investici.org ([2a11:7980:1::2:0]:32619) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1tr57Z-0000IY-AV for 76081@debbugs.gnu.org; Sat, 08 Mar 2025 20:06:26 -0500 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org; s=stigmate; t=1741482382; bh=AJ4/OJL3IyQG00I5i1Z/KH7n+uwTOfq3PFWqIhSVXsw=; h=From:To:Cc:Subject:Date:From; b=J0v3+JL7rRNTDwEmPNYqmhINDY7Zw19ydBYBALNr49hB/0S53okIhiZKEQbfYS5m0 Y0HWMTxesXDY5RCgbuuMk25Byozsbz0ZapKOMWY0WSJl97YPitdV0ufZTK5NEZ9pW6 VoyPZv4hPA55wGHOR3Dq6HT42cvg7lWVhWOdgT4Q= Received: from mx1.investici.org (unknown [127.0.0.1]) by confino.investici.org (Postfix) with ESMTP id 4Z9MKp4jpqz11NM; Sun, 9 Mar 2025 01:06:22 +0000 (UTC) Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19]) (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with ESMTPSA id 4Z9MKp3Q1mz11NJ; Sun, 9 Mar 2025 01:06:22 +0000 (UTC) From: Giacomo Leidi Date: Sun, 9 Mar 2025 02:06:11 +0100 Message-ID: <36e9d9e4474b8d547a86a0225e89f0039af39970.1741482375.git.goodoldpaul@autistici.org> X-Mailer: git-send-email 2.48.1 MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Spam-Score: -0.0 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) This commit allows for having PATH set when changing the owner of /sys/fs/group. * gnu/services/containers.scm (crgroups-fs-owner): Use login shell. Change-Id: I9510c637a5332325e05ca5ebc9dfd4de32685c50 --- gnu/services/containers.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm index b3cd109ce6c..d5a211765a6 100644 --- a/gnu/services/containers.scm +++ b/gnu/services/containers.scm @@ -140,7 +140,7 @@ (define (cgroups-fs-owner-entrypoint config) (rootless-podman-configuration-group-name config)) (program-file "cgroups2-fs-owner-entrypoint" #~(system* - (string-append #+bash-minimal "/bin/bash") "-c" + (string-append #+bash-minimal "/bin/bash") "-l" "-c" (string-append "echo Setting /sys/fs/cgroup " "group ownership to " #$group " && chown -v " "root:" #$group " /sys/fs/cgroup && " base-commit: 5adfe1b8e92ff332656bcc7a9d71a35306b3411e -- 2.48.1 From unknown Fri Jun 13 11:55:10 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#76081] [PATCH v8 4/5] tests: Use lower-oci-image-state in container tests. Resent-From: Giacomo Leidi Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sun, 09 Mar 2025 01:07:03 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 76081 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 76081@debbugs.gnu.org Cc: Giacomo Leidi Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.17414823901208 (code B ref 76081); Sun, 09 Mar 2025 01:07:03 +0000 Received: (at 76081) by debbugs.gnu.org; 9 Mar 2025 01:06:30 +0000 Received: from localhost ([127.0.0.1]:57384 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tr57d-0000JE-4f for submit@debbugs.gnu.org; Sat, 08 Mar 2025 20:06:30 -0500 Received: from confino.investici.org ([93.190.126.19]:22917) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1tr57Z-0000Ib-9l for 76081@debbugs.gnu.org; Sat, 08 Mar 2025 20:06:27 -0500 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org; s=stigmate; t=1741482383; bh=OA+jF6nMN1H/fbeqERhZSvlXDfNZ/EM7zWgOCJPe3Mg=; h=From:To:Cc:Subject:Date:In-Reply-To:References:From; b=d3e6ZneUAN+y+ZnyVH9sadsoxifWXk9lS1voExqV8mWbOZ4iu1cs5wxbzjeoZSR94 +TZExxFg62UUuoD1KBeRJxUsLML/ShW2VPhR0T6BqhgqgQoDkPh4fbSmWlteXLHaR+ 0z9aHPFqsYazk9n4cP7wOM8QZgvQWFgSJLIG5IsE= Received: from mx1.investici.org (unknown [127.0.0.1]) by confino.investici.org (Postfix) with ESMTP id 4Z9MKq66Ljz11NV; Sun, 9 Mar 2025 01:06:23 +0000 (UTC) Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19]) (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with ESMTPSA id 4Z9MKq57M0z11NJ; Sun, 9 Mar 2025 01:06:23 +0000 (UTC) From: Giacomo Leidi Date: Sun, 9 Mar 2025 02:06:14 +0100 Message-ID: <2801dce6518c3f6e99d76ec7010c8108114c224d.1741482375.git.goodoldpaul@autistici.org> X-Mailer: git-send-email 2.48.1 In-Reply-To: <36e9d9e4474b8d547a86a0225e89f0039af39970.1741482375.git.goodoldpaul@autistici.org> References: <36e9d9e4474b8d547a86a0225e89f0039af39970.1741482375.git.goodoldpaul@autistici.org> MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Spam-Score: -0.7 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.7 (-) This patch replaces boilerplate in container related tests with oci-image plumbing from (gnu services containers). * gnu/services/containers.scm: Export lower-oci-image-state. * gnu/tests/containers.scm (%oci-tarball): New variable; (run-rootless-podman-test): use %oci-tarball; (build-tarball&run-rootless-podman-test): drop procedure. * gnu/tests/docker.scm (%docker-tarball): New variable; (build-tarball&run-docker-test): use %docker-tarball; (%docker-system-tarball): New variable; (build-tarball&run-docker-system-test): new procedure. Change-Id: Iad6f0704aee188d89464c83722dea0bb7adb084a --- gnu/services/containers.scm | 2 + gnu/tests/containers.scm | 80 ++++++++++++++--------------- gnu/tests/docker.scm | 100 ++++++++++++++++++++---------------- 3 files changed, 95 insertions(+), 87 deletions(-) diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm index a78be00f038..700c7b63603 100644 --- a/gnu/services/containers.scm +++ b/gnu/services/containers.scm @@ -75,6 +75,8 @@ (define-module (gnu services containers) oci-image-system oci-image-grafts? + lower-oci-image-state + oci-container-configuration oci-container-configuration? oci-container-configuration-fields diff --git a/gnu/tests/containers.scm b/gnu/tests/containers.scm index 5e6f39387e7..8cdd86e7ae3 100644 --- a/gnu/tests/containers.scm +++ b/gnu/tests/containers.scm @@ -69,13 +69,47 @@ (define %rootless-podman-os (supplementary-groups '("wheel" "netdev" "cgroup" "audio" "video"))))))) -(define (run-rootless-podman-test oci-tarball) +(define %oci-tarball + (lower-oci-image-state + "guile-guest" + (packages->manifest + (list + guile-3.0 guile-json-3 + (package + (name "guest-script") + (version "0") + (source #f) + (build-system trivial-build-system) + (arguments `(#:guile ,guile-3.0 + #:builder + (let ((out (assoc-ref %outputs "out"))) + (mkdir out) + (call-with-output-file (string-append out "/a.scm") + (lambda (port) + (display "(display \"hello world\n\")" port))) + #t))) + (synopsis "Display hello world using Guile") + (description "This package displays the text \"hello world\" on the +standard output device and then enters a new line.") + (home-page #f) + (license license:public-domain)))) + '(#:entry-point "bin/guile" + #:localstatedir? #t + #:extra-options (#:image-tag "guile-guest") + #:symlinks (("/bin/Guile" -> "bin/guile") + ("aa.scm" -> "a.scm"))) + "guile-guest" + (%current-target-system) + (%current-system) + #f)) + +(define (run-rootless-podman-test) (define os (marionette-operating-system (operating-system-with-gc-roots %rootless-podman-os - (list oci-tarball)) + (list %oci-tarball)) #:imported-modules '((gnu services herd) (guix combinators)))) @@ -254,7 +288,7 @@ (define (run-rootless-podman-test oci-tarball) (let* ((loaded (slurp ,(string-append #$podman "/bin/podman") "load" "-i" - ,#$oci-tarball)) + ,#$%oci-tarball)) (repository&tag "localhost/guile-guest:latest") (response1 (slurp ,(string-append #$podman "/bin/podman") @@ -307,49 +341,11 @@ (define (run-rootless-podman-test oci-tarball) (gexp->derivation "rootless-podman-test" test)) -(define (build-tarball&run-rootless-podman-test) - (mlet* %store-monad - ((_ (set-grafting #f)) - (guile (set-guile-for-build (default-guile))) - (guest-script-package -> - (package - (name "guest-script") - (version "0") - (source #f) - (build-system trivial-build-system) - (arguments `(#:guile ,guile-3.0 - #:builder - (let ((out (assoc-ref %outputs "out"))) - (mkdir out) - (call-with-output-file (string-append out "/a.scm") - (lambda (port) - (display "(display \"hello world\n\")" port))) - #t))) - (synopsis "Display hello world using Guile") - (description "This package displays the text \"hello world\" on the -standard output device and then enters a new line.") - (home-page #f) - (license license:public-domain))) - (profile (profile-derivation (packages->manifest - (list guile-3.0 guile-json-3 - guest-script-package)) - #:hooks '() - #:locales? #f)) - (tarball (pack:docker-image - "docker-pack" profile - #:symlinks '(("/bin/Guile" -> "bin/guile") - ("aa.scm" -> "a.scm")) - #:extra-options - '(#:image-tag "guile-guest") - #:entry-point "bin/guile" - #:localstatedir? #t))) - (run-rootless-podman-test tarball))) - (define %test-rootless-podman (system-test (name "rootless-podman") (description "Test rootless Podman service.") - (value (build-tarball&run-rootless-podman-test)))) + (value (run-rootless-podman-test)))) (define %oci-rootless-podman-os diff --git a/gnu/tests/docker.scm b/gnu/tests/docker.scm index 5dcf05a17e3..07edd9d5341 100644 --- a/gnu/tests/docker.scm +++ b/gnu/tests/docker.scm @@ -26,6 +26,7 @@ (define-module (gnu tests docker) #:use-module (gnu system image) #:use-module (gnu system vm) #:use-module (gnu services) + #:use-module (gnu services containers) #:use-module (gnu services dbus) #:use-module (gnu services networking) #:use-module (gnu services docker) @@ -57,6 +58,40 @@ (define %docker-os (service containerd-service-type) (service docker-service-type))) +(define %docker-tarball + (lower-oci-image-state + "guile-guest" + (packages->manifest + (list + guile-3.0 guile-json-3 + (package + (name "guest-script") + (version "0") + (source #f) + (build-system trivial-build-system) + (arguments `(#:guile ,guile-3.0 + #:builder + (let ((out (assoc-ref %outputs "out"))) + (mkdir out) + (call-with-output-file (string-append out "/a.scm") + (lambda (port) + (display "(display \"hello world\n\")" port))) + #t))) + (synopsis "Display hello world using Guile") + (description "This package displays the text \"hello world\" on the +standard output device and then enters a new line.") + (home-page #f) + (license license:public-domain)))) + '(#:entry-point "bin/guile" + #:localstatedir? #t + #:extra-options (#:image-tag "guile-guest") + #:symlinks (("/bin/Guile" -> "bin/guile") + ("aa.scm" -> "a.scm"))) + "guile-guest" + (%current-target-system) + (%current-system) + #f)) + (define (run-docker-test docker-tarball) "Load DOCKER-TARBALL as Docker image and run it in a Docker container, inside %DOCKER-OS." @@ -173,40 +208,7 @@ (define (run-docker-test docker-tarball) (gexp->derivation "docker-test" test)) (define (build-tarball&run-docker-test) - (mlet* %store-monad - ((_ (set-grafting #f)) - (guile (set-guile-for-build (default-guile))) - (guest-script-package -> - (package - (name "guest-script") - (version "0") - (source #f) - (build-system trivial-build-system) - (arguments `(#:guile ,guile-3.0 - #:builder - (let ((out (assoc-ref %outputs "out"))) - (mkdir out) - (call-with-output-file (string-append out "/a.scm") - (lambda (port) - (display "(display \"hello world\n\")" port))) - #t))) - (synopsis "Display hello world using Guile") - (description "This package displays the text \"hello world\" on the -standard output device and then enters a new line.") - (home-page #f) - (license license:public-domain))) - (profile (profile-derivation (packages->manifest - (list guile-3.0 guile-json-3 - guest-script-package)) - #:hooks '() - #:locales? #f)) - (tarball (pack:docker-image - "docker-pack" profile - #:symlinks '(("/bin/Guile" -> "bin/guile") - ("aa.scm" -> "a.scm")) - #:entry-point "bin/guile" - #:localstatedir? #t))) - (run-docker-test tarball))) + (run-docker-test %docker-tarball)) (define %test-docker (system-test @@ -215,8 +217,22 @@ (define %test-docker (value (build-tarball&run-docker-test)))) +(define %docker-system-tarball + (lower-oci-image-state + "guix-system-guest" + (operating-system + (inherit (simple-operating-system)) + ;; Use locales for a single libc to + ;; reduce space requirements. + (locale-libcs (list glibc))) + '() + "guix-system-guest" + (%current-target-system) + (%current-system) + #f)) + (define (run-docker-system-test tarball) - "Load DOCKER-TARBALL as Docker image and run it in a Docker container, + "Load TARBALL as Docker image and run it in a Docker container, inside %DOCKER-OS." (define os (marionette-operating-system @@ -333,21 +349,15 @@ (define (run-docker-system-test tarball) (gexp->derivation "docker-system-test" test)) +(define (build-tarball&run-docker-system-test) + (run-docker-system-test %docker-system-tarball)) + (define %test-docker-system (system-test (name "docker-system") (description "Run a system image as produced by @command{guix system docker-image} inside Docker.") - (value (with-monad %store-monad - (>>= (lower-object - (system-image (os->image - (operating-system - (inherit (simple-operating-system)) - ;; Use locales for a single libc to - ;; reduce space requirements. - (locale-libcs (list glibc))) - #:type docker-image-type))) - run-docker-system-test))))) + (value (build-tarball&run-docker-system-test)))) (define %oci-os -- 2.48.1 From unknown Fri Jun 13 11:55:10 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#76081] [PATCH v8 5/5] home: Add home-oci-service-type. Resent-From: Giacomo Leidi Original-Sender: "Debbugs-submit" Resent-CC: andrew@trop.in, janneke@gnu.org, ludo@gnu.org, maxim.cournoyer@gmail.com, tanguy@bioneland.org, guix-patches@gnu.org Resent-Date: Sun, 09 Mar 2025 01:07:04 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 76081 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 76081@debbugs.gnu.org Cc: Giacomo Leidi , Andrew Tropin , Janneke Nieuwenhuizen , Ludovic =?UTF-8?Q?Court=C3=A8s?= , Maxim Cournoyer , Tanguy Le Carrour X-Debbugs-Original-Xcc: Andrew Tropin , Janneke Nieuwenhuizen , Ludovic =?UTF-8?Q?Court=C3=A8s?= , Maxim Cournoyer , Tanguy Le Carrour Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.17414823911214 (code B ref 76081); Sun, 09 Mar 2025 01:07:04 +0000 Received: (at 76081) by debbugs.gnu.org; 9 Mar 2025 01:06:31 +0000 Received: from localhost ([127.0.0.1]:57386 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tr57e-0000JR-5a for submit@debbugs.gnu.org; Sat, 08 Mar 2025 20:06:31 -0500 Received: from confino.investici.org ([2a11:7980:1::2:0]:43993) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1tr57Z-0000Id-CW for 76081@debbugs.gnu.org; Sat, 08 Mar 2025 20:06:27 -0500 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org; s=stigmate; t=1741482384; bh=M48IKbYcoh+yVWFUUliCPB3CIz3BAUfXQ15AWJnNPUU=; h=From:To:Cc:Subject:Date:In-Reply-To:References:From; b=dk1hva4SBhqkpFjss9zXPo6IL+cR7j02CW/zJ4rbx6VG12f7feKHdiPAQfldGgaYu MdBTUiOpmrBneNM5I80sOVjpghVhJMwfBc4jwUvDKQL8qKQ51xfOlcLXlqQbPh4ztL I+bxvGVd5fuH3TcBiaIkHkZRIj9HtYje1bPCtFl8= Received: from mx1.investici.org (unknown [127.0.0.1]) by confino.investici.org (Postfix) with ESMTP id 4Z9MKr1jvNz11Nd; Sun, 9 Mar 2025 01:06:24 +0000 (UTC) Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19]) (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with ESMTPSA id 4Z9MKr0jRNz11NJ; Sun, 9 Mar 2025 01:06:24 +0000 (UTC) From: Giacomo Leidi Date: Sun, 9 Mar 2025 02:06:15 +0100 Message-ID: X-Mailer: git-send-email 2.48.1 In-Reply-To: <36e9d9e4474b8d547a86a0225e89f0039af39970.1741482375.git.goodoldpaul@autistici.org> References: <36e9d9e4474b8d547a86a0225e89f0039af39970.1741482375.git.goodoldpaul@autistici.org> MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit X-Spam-Score: -0.0 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) * gnu/home/service/containers.scm: New file; * gnu/local.mk (GNU_SYSTEM_MODULES): Add it. * doc/guix.texi (OCI backed services): Document it. Change-Id: I8ce5b301e8032d0a7b2a9ca46752738cdee1f030 --- doc/guix.texi | 114 +++++++++++++++++++++++++++++++ gnu/home/services/containers.scm | 50 ++++++++++++++ gnu/local.mk | 1 + gnu/services/containers.scm | 5 ++ 4 files changed, 170 insertions(+) create mode 100644 gnu/home/services/containers.scm diff --git a/doc/guix.texi b/doc/guix.texi index 8686380669b..7ed469f7920 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -50403,6 +50403,120 @@ Miscellaneous Home Services (dicod-configuration @dots{}))) @end lisp +@subsubheading OCI backed services + +@cindex OCI-backed, for Home +The @code{(gnu home services containers)} module provides the following service: + +@defvar home-oci-service-type +This is the type of the service that allows to manage your OCI containers with +the same consistent interface you use for your other Home Shepherd services. +@end defvar + +This service is a direct mapping of the @code{oci-service-type} system +service (@pxref{Miscellaneous Services, OCI backed services}). You can +use it like this: + +@lisp +(use-modules (gnu services containers) + (gnu home services containers)) + +(simple-service 'home-oci-provisioning + home-oci-service-type + (oci-extension + (volumes + (list + (oci-volume-configuration (name "prometheus")) + (oci-volume-configuration (name "grafana")))) + (networks + (list + (oci-network-configuration (name "monitoring")))) + (containers + (list + (oci-container-configuration + (network "monitoring") + (image + (oci-image + (repository "guile") + (tag "3") + (value (specifications->manifest '("guile"))) + (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile")) + #:max-layers 2)))) + (entrypoint "/bin/guile") + (command + '("-c" "(display \"hello!\n\")"))) + (oci-container-configuration + (image "prom/prometheus") + (network "monitoring") + (ports + '(("9000" . "9000") + ("9090" . "9090"))) + (volumes + (list + '(("prometheus" . "/var/lib/prometheus"))))) + (oci-container-configuration + (image "grafana/grafana:10.0.1") + (network "monitoring") + (volumes + '(("grafana:/var/lib/grafana")))))))) + +@end lisp + +You may specify a custom configuration by providing a +@code{oci-configuration} record, exactly like for +@code{oci-service-type}, but wrapping it in @code{for-home}: + +@lisp +(use-modules (gnu services) + (gnu services containers) + (gnu home services containers)) + +(service home-oci-service-type + (for-home + (oci-configuration + (runtime 'podman) + (verbose? #t)))) + +(simple-service 'home-oci-provisioning + home-oci-service-type + (oci-extension + (volumes + (list + (oci-volume-configuration (name "prometheus")) + (oci-volume-configuration (name "grafana")))) + (networks + (list + (oci-network-configuration (name "monitoring")))) + (containers + (list + (oci-container-configuration + (network "monitoring") + (image + (oci-image + (repository "guile") + (tag "3") + (value (specifications->manifest '("guile"))) + (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile")) + #:max-layers 2)))) + (entrypoint "/bin/guile") + (command + '("-c" "(display \"hello!\n\")"))) + (oci-container-configuration + (image "prom/prometheus") + (network "monitoring") + (ports + '(("9000" . "9000") + ("9090" . "9090"))) + (volumes + (list + '(("prometheus" . "/var/lib/prometheus"))))) + (oci-container-configuration + (image "grafana/grafana:10.0.1") + (network "monitoring") + (volumes + '(("grafana:/var/lib/grafana")))))))) +@end lisp + @node Invoking guix home @section Invoking @command{guix home} diff --git a/gnu/home/services/containers.scm b/gnu/home/services/containers.scm new file mode 100644 index 00000000000..938dde2f37a --- /dev/null +++ b/gnu/home/services/containers.scm @@ -0,0 +1,50 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2025 Giacomo Leidi +;;; +;;; 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 . + +(define-module (gnu home services containers) + #:use-module (gnu home services) + #:use-module (gnu home services shepherd) + #:use-module (gnu services) + #:use-module (gnu services configuration) + #:use-module (gnu services containers) + #:use-module (guix gexp) + #:use-module (guix packages) + #:use-module (srfi srfi-1) + #:export (home-oci-service-type)) + +(define home-oci-service-type + (service-type (inherit (system->home-service-type oci-service-type)) + (extensions + (list + (service-extension home-profile-service-type + (oci-service-extension-wrap-validate + (lambda (config) + (let ((runtime-cli + (oci-configuration-runtime-cli config)) + (runtime + (oci-configuration-runtime config))) + (oci-service-profile runtime runtime-cli))))) + (service-extension home-shepherd-service-type + (oci-service-extension-wrap-validate + oci-configuration->shepherd-services)))) + (extend + (lambda (config extension) + (for-home + (oci-configuration + (inherit (oci-configuration-extend config extension)))))) + (default-value (for-home (oci-configuration))))) diff --git a/gnu/local.mk b/gnu/local.mk index 9082ed04bfe..e0d1a25a607 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -103,6 +103,7 @@ GNU_SYSTEM_MODULES = \ %D%/home.scm \ %D%/home/services.scm \ %D%/home/services/admin.scm \ + %D%/home/services/containers.scm \ %D%/home/services/desktop.scm \ %D%/home/services/dict.scm \ %D%/home/services/dotfiles.scm \ diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm index 700c7b63603..002bbc1057b 100644 --- a/gnu/services/containers.scm +++ b/gnu/services/containers.scm @@ -762,6 +762,9 @@ (define-configuration/no-serialization oci-network-configuration (define (list-of-oci-networks? value) (list-of-oci-records? "networks" oci-network-configuration? value)) +;; (for-home (oci-configuration ...)) is not able to replace for-home? with #t, +;; pk prints #f. Once for-home will be able to work with (gnu services configuration) the +;; record can be migrated back to define-configuration. (define-record-type* oci-configuration make-oci-configuration @@ -796,6 +799,8 @@ (define-record-type* (define (package-or-string? value) (or (package? value) (string? value))) +;; TODO: This procedure can be dropped once we switch to define-configuration for +;; oci-configuration. (define (oci-configuration-valid? config) (define runtime-cli (oci-configuration-runtime-cli config)) -- 2.48.1 From unknown Fri Jun 13 11:55:10 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#76081] [PATCH v8 2/5] services: oci-container-configuration: Move to (gnu services containers). Resent-From: Giacomo Leidi Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sun, 09 Mar 2025 01:07:04 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 76081 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 76081@debbugs.gnu.org Cc: Giacomo Leidi Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.17414824011235 (code B ref 76081); Sun, 09 Mar 2025 01:07:04 +0000 Received: (at 76081) by debbugs.gnu.org; 9 Mar 2025 01:06:41 +0000 Received: from localhost ([127.0.0.1]:57388 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tr57n-0000Jp-6E for submit@debbugs.gnu.org; Sat, 08 Mar 2025 20:06:41 -0500 Received: from confino.investici.org ([2a11:7980:1::2:0]:50417) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1tr57Z-0000IZ-Cd for 76081@debbugs.gnu.org; Sat, 08 Mar 2025 20:06:29 -0500 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org; s=stigmate; t=1741482383; bh=5w1pguUy5euk/p6I7KBfaqhA/lWVRKQOsLxduTGYZqY=; h=From:To:Cc:Subject:Date:In-Reply-To:References:From; b=n6AxZ2HVYVPW9xmWASiPyYFkZMXDVQPI+Z6E0N4Mj2UpzghD1hWHVAxjibPFf2kWC 18KAR1PFcP+yb4LCJcfH/uSshfifcqv1LQGSVzvFnLumUFAICn2moaRqI3HFNjxyY0 P/crJdliXiMElEevKxI6Y5b2Tof4QvDmZgN6TXmg= Received: from mx1.investici.org (unknown [127.0.0.1]) by confino.investici.org (Postfix) with ESMTP id 4Z9MKq0TGnz11NQ; Sun, 9 Mar 2025 01:06:23 +0000 (UTC) Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19]) (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with ESMTPSA id 4Z9MKp6Ctmz11NJ; Sun, 9 Mar 2025 01:06:22 +0000 (UTC) From: Giacomo Leidi Date: Sun, 9 Mar 2025 02:06:12 +0100 Message-ID: <5ea9ef46b656b23c6213ec086084fd572b10816a.1741482375.git.goodoldpaul@autistici.org> X-Mailer: git-send-email 2.48.1 In-Reply-To: <36e9d9e4474b8d547a86a0225e89f0039af39970.1741482375.git.goodoldpaul@autistici.org> References: <36e9d9e4474b8d547a86a0225e89f0039af39970.1741482375.git.goodoldpaul@autistici.org> MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit X-Spam-Score: -0.0 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) 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 +;;; Copyright © 2024, 2025 Giacomo Leidi ;;; ;;; This file is part of GNU Guix. ;;; @@ -17,19 +17,31 @@ ;;; along with GNU Guix. If not, see . (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 ;;; Copyright © 2020 Jesse Dowell ;;; Copyright © 2021 Brice Waegeneire -;;; Copyright © 2023, 2024 Giacomo Leidi +;;; Copyright © 2023, 2024, 2025 Giacomo Leidi ;;; ;;; This file is part of GNU Guix. ;;; @@ -23,72 +23,60 @@ ;;; along with GNU Guix. If not, see . (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 ;;; Copyright © 2019-2023 Ludovic Courtès -;;; Copyright © 2024 Giacomo Leidi +;;; Copyright © 2024, 2025 Giacomo Leidi ;;; ;;; 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 From unknown Fri Jun 13 11:55:10 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#76081] OCI provisioning service Resent-From: paul Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Tue, 18 Mar 2025 17:51:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 76081 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 76081@debbugs.gnu.org Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.174232025929006 (code B ref 76081); Tue, 18 Mar 2025 17:51:02 +0000 Received: (at 76081) by debbugs.gnu.org; 18 Mar 2025 17:50:59 +0000 Received: from localhost ([127.0.0.1]:43067 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tub5f-0007Xl-Ap for submit@debbugs.gnu.org; Tue, 18 Mar 2025 13:50:59 -0400 Received: from confino.investici.org ([93.190.126.19]:20399) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1tub5b-0007X2-1S for 76081@debbugs.gnu.org; Tue, 18 Mar 2025 13:50:57 -0400 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org; s=stigmate; t=1742320253; bh=X/JkmbaEmBYfUmsgN95hA9CQm1ouYKVgwEOH67dxITI=; h=Date:Subject:From:To:References:In-Reply-To:From; b=TC0z5LkdEoBLdF65by052/dLwQsh8vbCRSdZOQSEr/hhlDqFpPz3UGe1Zqgp5Gmc3 MHCTlFziuHCeDe50+KL++RYKgEH9cpufvbbnp0x8AD8CI5zXlc/9n9lQp9481tMfHv 6qmpC5gX78s6hDmrGlwH/4XvC4jx7Yf5U+fG2Z/U= Received: from mx1.investici.org (unknown [127.0.0.1]) by confino.investici.org (Postfix) with ESMTP id 4ZHKBj0VH3z11d3 for <76081@debbugs.gnu.org>; Tue, 18 Mar 2025 17:50:53 +0000 (UTC) Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19]) (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with ESMTPSA id 4ZHKBh75Bkz11cm for <76081@debbugs.gnu.org>; Tue, 18 Mar 2025 17:50:52 +0000 (UTC) Message-ID: <020bb939-819c-4de3-bc04-ef0f33855c90@autistici.org> Date: Tue, 18 Mar 2025 18:50:14 +0100 MIME-Version: 1.0 User-Agent: Icedove Daily From: paul References: <274b98ea-1af9-4f0f-af58-8fa755feb73b@autistici.org> <397afc1f-b638-430a-b9e7-7de4721bca45@autistici.org> Content-Language: en-US In-Reply-To: Content-Type: text/plain; charset=UTF-8; format=flowed Content-Transfer-Encoding: 8bit X-Spam-Score: -0.7 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.7 (-) Hi, On 3/9/25 01:27, paul wrote: > Hi, > > On 3/4/25 13:39, paul wrote: >> Hi, >> >> On 2/27/25 00:01, paul wrote: >>> Hi guix, >>> >>> On 2/18/25 02:20, paul wrote: >>>> Hi, >>>> >>>> On 2/12/25 02:09, paul wrote: >>>>> Hi guix, >>>>> >>>>> On 2/9/25 21:38, paul wrote: >>>>>> I'm sending a v3 fixing a bug in the merge algorithm for volumes >>>>>> and networks. >>>>>> >>>>>> On 2/9/25 20:14, paul wrote: >>>>>>> Hi, >>>>>>> >>>>>>> I'm about to send a v2. v2 compared to the first revision features: >>>>>>> >>>>>>> >>>>>>> - it actually compiles all the times :) (rev 1 referenced >>>>>>> oci-image too early for it to be working and generated a compile >>>>>>> time error, if you recompiled it sometimes went away so I >>>>>>> thought it was a problem of my setup. CI caught this) >>>>>>> - it allows more values to be overridden by eventual users of >>>>>>> the Scheme API >>>>>>> - it allows passing extra arguments directly after each podman >>>>>>> or docker invokation, allowing for example for overriding podman >>>>>>> --root and similar options. >>>>>>> >>>>>>> All of these tests should pass: >>>>>>> >>>>>>> guix shell -D guix -CPW -- make check-system >>>>>>> TESTS="oci-container oci-service-rootless-podman docker >>>>>>> docker-system rootless-podman oci-service-docker" >>>>>>> >>>>> I'm sending a v4 changing slightly the image loader, the same >>>>> tests as before are supposed to pass. Now the Home service [0] is >>>>> working for me with rootless podman. I'll try it on different >>>>> distros if I manage to. >>>> >>>> I'm sending a v5 implementing a Home service. The changes compared >>>> to v4 are pretty trivial as the plumbing was already there, the >>>> only downside is that I'm not able to use for-home? in >>>> define-configuration, so I had to reimplement oci-configuration >>>> with (guix records) and had to reimplement some validation (gnu >>>> services configuration) would figure out magically. >>> >>> I'm sending  a v6. Compared to v5 it resolves the conflicts with >>> master and it should fix the stop action for rootless podman backed >>> services. >> >> I'm sending a v7 fixing the restart action for podman backed services. > > I'm sending a v8 fixing some further bugs wrt to the start and stop of > podman backed services. In the hope of making the review easier, I'm sending a v9 that is completely the same of v8 in terms of changes but with smaller commits. Hopefully this makes it easier to review changes, please let me know if I can do anything to ease the workload for reviewers of this patch set. Thank you for your work, cheers giacomo From unknown Fri Jun 13 11:55:10 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#76081] [PATCH v9 3/7] tests: oci-container: Set explicit timeouts. Resent-From: Giacomo Leidi Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Tue, 18 Mar 2025 17:53:03 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 76081 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 76081@debbugs.gnu.org Cc: Giacomo Leidi Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.174232032829604 (code B ref 76081); Tue, 18 Mar 2025 17:53:03 +0000 Received: (at 76081) by debbugs.gnu.org; 18 Mar 2025 17:52:08 +0000 Received: from localhost ([127.0.0.1]:43077 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tub6l-0007hP-C5 for submit@debbugs.gnu.org; Tue, 18 Mar 2025 13:52:08 -0400 Received: from confino.investici.org ([93.190.126.19]:59583) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1tub6E-0007cW-1n for 76081@debbugs.gnu.org; Tue, 18 Mar 2025 13:51:34 -0400 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org; s=stigmate; t=1742320293; bh=HzRTYHO2F4KMK9qeHra0pSyBzvuUEie4gJwFMFBOzbo=; h=From:To:Cc:Subject:Date:In-Reply-To:References:From; b=kcz+YOX2B/ixrnute8XqlKeRrVXkZR/AyQyuPN2JcGasCJOH+2lCV3QTzM2XgDJvD lZiTt0B+YNZ3oftrPPv6mvnL22csYLpvKH8hq03iDnCuXNuBKJv4UnxiX7WuViyS59 jMaUHvzmtHNpccvkY5Xd7u2Cm6ORmTw/homp3t0Y= Received: from mx1.investici.org (unknown [127.0.0.1]) by confino.investici.org (Postfix) with ESMTP id 4ZHKCT1567z11d4; Tue, 18 Mar 2025 17:51:33 +0000 (UTC) Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19]) (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with ESMTPSA id 4ZHKCQ2n0Cz11cm; Tue, 18 Mar 2025 17:51:30 +0000 (UTC) From: Giacomo Leidi Date: Tue, 18 Mar 2025 18:51:08 +0100 Message-ID: X-Mailer: git-send-email 2.48.1 In-Reply-To: <15af7d63ead9dfad272154c09bdfda718da1047c.1742320272.git.goodoldpaul@autistici.org> References: <15af7d63ead9dfad272154c09bdfda718da1047c.1742320272.git.goodoldpaul@autistici.org> MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit X-Spam-Score: -0.7 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.7 (-) * gnu/tests/docker.scm: Simplify %test-oci-container test case and add explicit timeouts to tests outcomes. --- gnu/tests/docker.scm | 99 ++++++++++++++++++-------------------------- 1 file changed, 41 insertions(+), 58 deletions(-) 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 ;;; Copyright © 2019-2023 Ludovic Courtès -;;; Copyright © 2024 Giacomo Leidi +;;; Copyright © 2024, 2025 Giacomo Leidi ;;; ;;; 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 From unknown Fri Jun 13 11:55:10 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#76081] [PATCH v9 4/7] services: Add oci-service-type. Resent-From: Giacomo Leidi Original-Sender: "Debbugs-submit" Resent-CC: ludo@gnu.org, maxim.cournoyer@gmail.com, guix-patches@gnu.org Resent-Date: Tue, 18 Mar 2025 17:53:05 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 76081 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 76081@debbugs.gnu.org Cc: Giacomo Leidi , Ludovic =?UTF-8?Q?Court=C3=A8s?= , Maxim Cournoyer X-Debbugs-Original-Xcc: Ludovic =?UTF-8?Q?Court=C3=A8s?= , Maxim Cournoyer Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.174232032829610 (code B ref 76081); Tue, 18 Mar 2025 17:53:05 +0000 Received: (at 76081) by debbugs.gnu.org; 18 Mar 2025 17:52:08 +0000 Received: from localhost ([127.0.0.1]:43079 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tub6m-0007hR-64 for submit@debbugs.gnu.org; Tue, 18 Mar 2025 13:52:08 -0400 Received: from confino.investici.org ([2a11:7980:1::2:0]:56063) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1tub6F-0007cc-C9 for 76081@debbugs.gnu.org; Tue, 18 Mar 2025 13:51:35 -0400 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org; s=stigmate; t=1742320293; bh=qC8u7mne2ffbrfQs41Rdd3Yp1wFxxukOCgah0j0nmRM=; h=From:To:Cc:Subject:Date:In-Reply-To:References:From; b=U+cUuxuaOOW6Ry5OlvO+xaVxsVwbawoBD0dIsRxO7UR12+vtKeARPne3hsgsUp74K wfynZl78Bb3dF5ms1SFKvFX3Wv0QUlLMDe2aQAp1UunkkC3FLMQdvdSZJcQcULnKIv phyyE2J/I6miDUtnj6NLVFnnW/JxkKNLD0wYUltw= Received: from mx1.investici.org (unknown [127.0.0.1]) by confino.investici.org (Postfix) with ESMTP id 4ZHKCT4qZxz11dd; Tue, 18 Mar 2025 17:51:33 +0000 (UTC) Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19]) (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with ESMTPSA id 4ZHKCT33jbz11cm; Tue, 18 Mar 2025 17:51:33 +0000 (UTC) From: Giacomo Leidi Date: Tue, 18 Mar 2025 18:51:09 +0100 Message-ID: <20663568040d1345979b6166caabcb4be1b28d10.1742320272.git.goodoldpaul@autistici.org> X-Mailer: git-send-email 2.48.1 In-Reply-To: <15af7d63ead9dfad272154c09bdfda718da1047c.1742320272.git.goodoldpaul@autistici.org> References: <15af7d63ead9dfad272154c09bdfda718da1047c.1742320272.git.goodoldpaul@autistici.org> MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" 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/services/containers.scm (%oci-supported-runtimes): New variable; (oci-runtime-cli): new variable; (oci-runtime-name): new variable; (oci-network-configuration): new variable; (oci-volume-configuration): new variable; (oci-configuration): new variable; (oci-extension): new variable; (oci-networks-shepherd-name): new variable; (oci-service-type): new variable; (oci-state->shepherd-services): new variable. * doc/guix.texi: Document it. * gnu/tests/containers.scm: Test it. * gnu/services/docker.scm: Deprecate the oci-container-service-type. Change-Id: I656b3db85832e42d53072fcbfb91d1226f39ef38 --- doc/guix.texi | 306 +++++++-- gnu/services/containers.scm | 1300 ++++++++++++++++++++++++++++++----- gnu/services/docker.scm | 37 +- gnu/tests/containers.scm | 999 ++++++++++++++++++++++++++- 4 files changed, 2390 insertions(+), 252 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index 04885593328..521ea28dd5a 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -42914,59 +42914,162 @@ Miscellaneous Services @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: given an -@acronym{Open Container Initiative, OCI} container image, it will run it in a +Should you wish to manage your @acronym{Open Container Initiative, OCI} containers +with the same consistent interface you use for your other Shepherd services, +@var{oci-service-type} is the tool to use: given an +OCI container image, it will run it in a Shepherd service. One example where this is useful: it lets you run services -that are available as Docker/OCI images but not yet packaged for Guix. +that are available as OCI images but not yet packaged for Guix. -@defvar oci-container-service-type +@defvar oci-service-type -This is a thin wrapper around Docker's CLI that executes OCI images backed +This is a thin wrapper around Docker's or Podman's CLI that executes OCI images backed processes as Shepherd Services. @lisp -(service oci-container-service-type - (list - (oci-container-configuration - (network "host") - (image - (oci-image - (repository "guile") - (tag "3") - (value (specifications->manifest '("guile"))) - (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile")) - #:max-layers 2)))) - (entrypoint "/bin/guile") - (command - '("-c" "(display \"hello!\n\")"))) - (oci-container-configuration - (image "prom/prometheus") - (ports - '(("9000" . "9000") - ("9090" . "9090")))) - (oci-container-configuration - (image "grafana/grafana:10.0.1") - (network "host") - (volumes - '("/var/lib/grafana:/var/lib/grafana"))))) +(simple-service 'oci-provisioning + oci-service-type + (oci-extension + (networks + (list + (oci-network-configuration (name "monitoring")))) + (containers + (list + (oci-container-configuration + (network "monitoring") + (image + (oci-image + (repository "guile") + (tag "3") + (value (specifications->manifest '("guile"))) + (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile")) + #:max-layers 2)))) + (entrypoint "/bin/guile") + (command + '("-c" "(display \"hello!\n\")"))) + (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 In this example three different Shepherd services are going to be added to the system. Each @code{oci-container-configuration} record translates to a -@code{docker run} invocation and its fields directly map to options. You can -refer to the -@url{https://docs.docker.com/engine/reference/commandline/run,upstream} -documentation for the semantics of each value. If the images are not found, -they will be -@url{https://docs.docker.com/engine/reference/commandline/pull/,pulled}. The +@command{docker run} or @command{podman run} invocation and its fields directly +map to options. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html,Podman} +upstream documentation for semantics of each value. If the images are not found, +they will be pulled. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/pull/,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-pull.1.html,Podman} +upstream documentation for semantics. The services with @code{(network "host")} are going to be attached to the host network and are supposed to behave like native processes with regard to networking. @end defvar +@c %start of fragment + +@deftp {Data Type} oci-configuration +Available @code{oci-configuration} fields are: + +@table @asis +@item @code{runtime} (default: @code{'docker}) (type: symbol) +The OCI runtime to use to run commands. It can be either @code{'docker} or +@code{'podman}. + +@item @code{runtime-cli} (type: maybe-package-or-string) +The OCI runtime command line to be installed in the system profile and used +to provision OCI resources, it can be either a package or a string representing +an absolute path to the runtime binary entrypoint. When unset it will default +to @code{docker-cli} package for the @code{'docker} runtime or to @code{podman} +package for the @code{'podman} runtime. + +@item @code{runtime-extra-arguments} (default: @code{'()}) (type: list) +A list of strings, gexps or file-like objects that will be placed +after each @command{docker} or @command{podman} invokation. + +@item @code{user} (type: maybe-string) +The user name under whose authority OCI commands will be run. This field will +override the @code{user} field of @code{oci-configuration}. + +@item @code{group} (type: maybe-string) +The group name under whose authority OCI commands will be run. When +using the @code{'podman} OCI runtime, this field will be ignored and the +default group of the user configured in the @code{user} field will be used. +This field will override the @code{group} field of @code{oci-configuration}. + +@item @code{subuids-range} (type: maybe-subid-range) +An optional @code{subid-range} record allocating subuids for the user from +the @code{user} field. When unset, with the rootless Podman OCI runtime, it +defaults to @code{(subid-range (name "oci-container"))}. + +@item @code{subgids-range} (type: maybe-subid-range) +An optional @code{subid-range} record allocating subgids for the user from +the @code{user} field. When unset, with the rootless Podman OCI runtime, it +defaults to @code{(subid-range (name "oci-container"))}. + +@item @code{containers} (default: @code{'()}) (type: list-of-oci-containers) +The list of @code{oci-container-configuration} records representing the +containers to provision. Most users are supposed not to use this field and use +the @code{oci-extension} record instead. + +@item @code{networks} (default: @code{'()}) (type: list-of-oci-networks) +The list of @code{oci-network-configuration} records representing the +containers to provision. Most users are supposed not to use this field and use +the @code{oci-extension} record instead. + +@item @code{volumes} (default: @code{'()}) (type: list-of-oci-volumes) +The list of @code{oci-volumes-configuration} records representing the +containers to provision. Most users are supposed not to use this field and use +the @code{oci-extension} record instead. + +@item @code{verbose?} (default: @code{#f}) (type: boolean) +When true, additional output will be printed, allowing to better follow the +flow of execution. + +@end table + +@end deftp + + +@c %end of fragment + +@c %start of fragment + +@deftp {Data Type} oci-extension +Available @code{oci-extension} fields are: + +@table @asis +@item @code{containers} (default: @code{'()}) (type: list-of-oci-containers) +The list of @code{oci-container-configuration} records representing the +containers to provision. + +@item @code{networks} (default: @code{'()}) (type: list-of-oci-networks) +The list of @code{oci-network-configuration} records representing the +containers to provision. + +@item @code{volumes} (default: @code{'()}) (type: list-of-oci-volumes) +The list of @code{oci-volumes-configuration} records representing the +containers to provision. + +@end table + +@end deftp + + +@c %end of fragment + + @c %start of fragment @deftp {Data Type} oci-container-configuration @@ -42986,16 +43089,16 @@ Miscellaneous Services Overwrite the default entrypoint (@code{ENTRYPOINT}) of the image. @item @code{host-environment} (default: @code{'()}) (type: 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 +Set environment variables in the host environment where @command{docker run} +or @command{podman run} are invoked. This is especially useful to pass secrets +from the host to the container without having them on the OCI runtime command line, +for example: by setting the @code{MYSQL_PASSWORD} on the host and by passing @code{--env MYSQL_PASSWORD} through the @code{extra-arguments} field, it is possible to securely set values in the container environment. This field's value can be a list of pairs or strings, even mixed: @lisp -(list '("LANGUAGE\" . "eo:ca:eu") +(list '("LANGUAGE" . "eo:ca:eu") "JAVA_HOME=/opt/java") @end lisp @@ -43003,22 +43106,24 @@ Miscellaneous Services directly to @code{make-forkexec-constructor}. @item @code{environment} (default: @code{'()}) (type: list) -Set environment variables. This can be a list of pairs or strings, even mixed: +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 -@uref{https://docs.docker.com/engine/reference/commandline/run/#env,upstream} -documentation for semantics. +Pair members can be strings, gexps or file-like objects. Strings are passed +directly to the OCI runtime CLI. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run/#env,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#env-e-env,Podman} +upstream documentation for semantics. @item @code{image} (type: 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{oci-image} record. Strings are resolved by the OCI runtime, +and follow the usual format @code{myregistry.local:5000/testing/test-image:tag}. @item @code{provision} (default: @code{""}) (type: string) @@ -43046,7 +43151,7 @@ Miscellaneous Services by the service. @item @code{network} (default: @code{""}) (type: string) -Set a Docker network for the spawned container. +Set an OCI 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 @@ -43057,10 +43162,11 @@ Miscellaneous Services "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 -@uref{https://docs.docker.com/engine/reference/commandline/run/#publish,upstream} -documentation for semantics. +Pair members can be strings, gexps or file-like objects. Strings are passed +directly to the OCI runtime CLI. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run/#publish,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#publish-p-ip-hostport-containerport-protocol,Podman} +upstream documentation for semantics. @item @code{volumes} (default: @code{'()}) (type: list) Set volume mappings for the spawned container. This can be a @@ -43071,25 +43177,97 @@ Miscellaneous Services "/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 -@uref{https://docs.docker.com/engine/reference/commandline/run/#volume,upstream} -documentation for semantics. +Pair members can be strings, gexps or file-like objects. Strings are passed +directly to the OCI runtime CLI. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run/#volume,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#volume-v-source-volume-host-dir-container-dir-options,Podman} +upstream documentation for semantics. @item @code{container-user} (default: @code{""}) (type: 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. +@url{https://docs.docker.com/engine/reference/run/#user,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#user-u-user-group,Podman} +upstream documentation for semantics. @item @code{workdir} (default: @code{""}) (type: string) Set the current working directory for the spawned Shepherd service. You can refer to the -@url{https://docs.docker.com/engine/reference/run/#workdir,upstream} -documentation for semantics. +@url{https://docs.docker.com/engine/reference/run/#workdir,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#workdir-w-dir,Podman} +upstream documentation for semantics. + +@item @code{extra-arguments} (default: @code{'()}) (type: list) +A list of strings, gexps or file-like objects that will be directly passed +to the @command{docker run} or @command{podman run} invokation. + +@end table + +@end deftp + + +@c %end of fragment + +@c %start of fragment + +@deftp {Data Type} oci-network-configuration +Available @code{oci-network-configuration} fields are: + +@table @asis +@item @code{name} (type: string) +The name of the OCI network to provision. + +@item @code{driver} (type: maybe-string) +The driver to manage the network. + +@item @code{gateway} (type: maybe-string) +IPv4 or IPv6 gateway for the subnet. + +@item @code{internal?} (default: @code{#f}) (type: boolean) +Restrict external access to the network + +@item @code{ip-range} (type: maybe-string) +Allocate container ip from a sub-range in CIDR format. + +@item @code{ipam-driver} (type: maybe-string) +IP Address Management Driver. + +@item @code{ipv6?} (default: @code{#f}) (type: boolean) +Enable IPv6 networking. + +@item @code{subnet} (type: maybe-string) +Subnet in CIDR format that represents a network segment. + +@item @code{labels} (default: @code{'()}) (type: list) +The list of labels that will be used to tag the current volume. + +@item @code{extra-arguments} (default: @code{'()}) (type: list) +A list of strings, gexps or file-like objects that will be directly passed +to the @command{docker network create} or @command{podman network create} +invokation. + +@end table + +@end deftp + + +@c %end of fragment + +@c %start of fragment + +@deftp {Data Type} oci-volume-configuration +Available @code{oci-volume-configuration} fields are: + +@table @asis +@item @code{name} (type: string) +The name of the OCI volume to provision. + +@item @code{labels} (default: @code{'()}) (type: list) +The list of labels that will be used to tag the current volume. @item @code{extra-arguments} (default: @code{'()}) (type: list) -A list of strings, gexps or file-like objects that will be directly -passed to the @command{docker run} invocation. +A list of strings, gexps or file-like objects that will be directly passed +to the @command{docker volume create} or @command{podman volume create} +invokation. @end table diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm index 24f31c756b8..d1ebfa1736c 100644 --- a/gnu/services/containers.scm +++ b/gnu/services/containers.scm @@ -41,6 +41,7 @@ (define-module (gnu services containers) #:use-module ((guix scripts pack) #:prefix pack:) #:use-module (guix store) #:use-module (srfi srfi-1) + #:use-module (ice-9 format) #:use-module (ice-9 match) #:export (rootless-podman-configuration rootless-podman-configuration? @@ -96,8 +97,78 @@ (define-module (gnu services containers) oci-container-configuration-workdir oci-container-configuration-extra-arguments + list-of-oci-containers? + list-of-oci-networks? + list-of-oci-volumes? + + %oci-supported-runtimes + oci-sanitize-runtime + oci-runtime-system-environment + oci-runtime-system-extra-arguments + oci-runtime-system-requirement + oci-runtime-cli + oci-runtime-system-cli + oci-runtime-home-cli + oci-runtime-name + oci-runtime-group + + oci-network-configuration + oci-network-configuration? + oci-network-configuration-fields + oci-network-configuration-name + oci-network-configuration-driver + oci-network-configuration-gateway + oci-network-configuration-internal? + oci-network-configuration-ip-range + oci-network-configuration-ipam-driver + oci-network-configuration-ipv6? + oci-network-configuration-subnet + oci-network-configuration-labels + oci-network-configuration-extra-arguments + + oci-volume-configuration + oci-volume-configuration? + oci-volume-configuration-fields + oci-volume-configuration-name + oci-volume-configuration-labels + oci-volume-configuration-extra-arguments + + oci-configuration + oci-configuration? + oci-configuration-runtime + oci-configuration-runtime-cli + oci-configuration-runtime-extra-arguments + oci-configuration-user + oci-configuration-group + oci-configuration-containers + oci-configuration-networks + oci-configuration-volumes + oci-configuration-verbose? + oci-configuration-valid? + + oci-extension + oci-extension? + oci-extension-fields + oci-extension-containers + oci-extension-networks + oci-extension-volumes + + oci-container-shepherd-name + oci-networks-shepherd-name + oci-networks-home-shepherd-name + oci-volumes-shepherd-name + oci-volumes-home-shepherd-name + oci-container-shepherd-service - %oci-container-accounts)) + oci-objects-merge-lst + oci-extension-merge + oci-service-type + oci-service-accounts + oci-service-profile + oci-service-subids + oci-state->shepherd-services + oci-configuration->shepherd-services + oci-configuration-extend)) (define (gexp-or-string? value) (or (gexp? value) @@ -296,9 +367,42 @@ (define rootless-podman-service-type ;;; -;;; OCI container. +;;; OCI provisioning service. ;;; +(define %oci-supported-runtimes + '(docker podman)) + +(define (oci-runtime-system-requirement runtime) + "Return a list of Shepherd service names required by a given OCI runtime, +before it is able to run containers." + (if (eq? 'podman runtime) + '(cgroups2-fs-owner cgroups2-limits + rootless-podman-shared-root-fs user-processes) + '(dockerd user-processes))) + +(define (oci-runtime-name runtime) + "Return a human readable name for a given OCI runtime." + (if (eq? 'podman runtime) + "Podman" "Docker")) + +(define (oci-runtime-group runtime maybe-group) + "Implement the logic behind selection of the group that is to be used by +Shepherd to execute OCI commands." + (if (not (maybe-value-set? maybe-group)) + (if (eq? 'podman runtime) + "cgroup" + "docker") + maybe-group)) + +(define (oci-sanitize-runtime value) + (unless (member value %oci-supported-runtimes) + (raise + (formatted-message + (G_ "OCI runtime must be a symbol and one of ~a, +but ~a was found") %oci-supported-runtimes value))) + value) + (define (oci-sanitize-pair pair delimiter) (define (valid? member) (or (string? member) @@ -347,6 +451,11 @@ (define (oci-sanitize-volumes value) ;; '(("/mnt/dir" . "/dir") "/run/current-system/profile:/java") (oci-sanitize-mixed-list "volumes" value ":")) +(define (oci-sanitize-labels value) + ;; Expected spec format: + ;; '(("foo" . "bar") "foo=bar") + (oci-sanitize-mixed-list "labels" value "=")) + (define (oci-sanitize-shepherd-actions value) (map (lambda (el) @@ -374,10 +483,15 @@ (define (oci-sanitize-extra-arguments value) value)) (define (oci-image-reference image) - (if (string? image) - image - (string-append (oci-image-repository image) - ":" (oci-image-tag image)))) + "Return a string OCI image reference representing IMAGE." + (define reference + (if (string? image) + image + (string-append (oci-image-repository image) + ":" (oci-image-tag image)))) + (if (> (length (string-split reference #\/)) 1) + reference + (string-append "localhost/" reference))) (define (oci-lowerable-image? image) (or (manifest? image) @@ -392,7 +506,19 @@ (define (string-or-oci-image? image) (define list-of-symbols? (list-of symbol?)) +(define (list-of-oci-records? name predicate value) + (map + (lambda (el) + (if (predicate el) + el + (raise + (formatted-message + (G_ "~a contains an illegal value: ~a") name el)))) + value)) + (define-maybe/no-serialization string) +(define-maybe/no-serialization package) +(define-maybe/no-serialization subid-range) (define-configuration/no-serialization oci-image (repository @@ -437,11 +563,15 @@ (define-configuration/no-serialization oci-image (define-configuration/no-serialization oci-container-configuration (user - (string "oci-container") - "The user under whose authority docker commands will be run.") + (maybe-string) + "The user name under whose authority OCI commands will be run. This field will +override the @code{user} field of @code{oci-configuration}.") (group - (string "docker") - "The group under whose authority docker commands will be run.") + (maybe-string) + "The group name under whose authority OCI commands will be run. When +using the @code{'podman} OCI runtime, this field will be ignored and the +default group of the user configured in the @code{user} field will be used. +This field will override the @code{group} field of @code{oci-configuration}.") (command (list-of-strings '()) "Overwrite the default command (@code{CMD}) of the image.") @@ -451,9 +581,9 @@ (define-configuration/no-serialization oci-container-configuration (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 +or @command{podman run} are invoked. This is especially useful to pass secrets +from the host to the container without having them on the OCI runtime command line, +for example: by setting the @code{MYSQL_PASSWORD} on the host and by passing @code{--env MYSQL_PASSWORD} through the @code{extra-arguments} field, it is possible to securely set values in the container environment. This field's value can be a list of pairs or strings, even mixed: @@ -477,15 +607,16 @@ (define-configuration/no-serialization oci-container-configuration @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." +directly to the OCI runtime CLI. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run/#env,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#env-e-env,Podman} +upstream documentation for semantics." (sanitizer oci-sanitize-environment)) (image (string-or-oci-image) "The image used to build the container. It can be a string or an -@code{oci-image} record. Strings are resolved by the Docker -Engine, and follow the usual format +@code{oci-image} record. Strings are resolved by the OCI runtime, +and follow the usual format @code{myregistry.local:5000/testing/test-image:tag}.") (provision (maybe-string) @@ -514,7 +645,7 @@ (define-configuration/no-serialization oci-container-configuration (sanitizer oci-sanitize-shepherd-actions)) (network (maybe-string) - "Set a Docker network for the spawned container.") + "Set an OCI network for the spawned container.") (ports (list '()) "Set the port or port ranges to expose from the spawned container. This can @@ -526,9 +657,10 @@ (define-configuration/no-serialization oci-container-configuration @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." +directly to the OCI runtime CLI. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run/#publish,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#publish-p-ip-hostport-containerport-protocol,Podman} +upstream documentation for semantics." (sanitizer oci-sanitize-ports)) (volumes (list '()) @@ -541,71 +673,348 @@ (define-configuration/no-serialization oci-container-configuration @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." +directly to the OCI runtime CLI. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run/#volume,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#volume-v-source-volume-host-dir-container-dir-options,Podman} +upstream documentation for semantics." (sanitizer oci-sanitize-volumes)) (container-user (maybe-string) "Set the current user inside the spawned container. You can refer to the -@url{https://docs.docker.com/engine/reference/run/#user,upstream} -documentation for semantics.") +@url{https://docs.docker.com/engine/reference/run/#user,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#user-u-user-group,Podman} +upstream documentation for semantics.") (workdir (maybe-string) - "Set the current working for the spawned Shepherd service. + "Set the current working directory for the spawned Shepherd service. You can refer to the -@url{https://docs.docker.com/engine/reference/run/#workdir,upstream} -documentation for semantics.") +@url{https://docs.docker.com/engine/reference/run/#workdir,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#workdir-w-dir,Podman} +upstream documentation for semantics.") (extra-arguments (list '()) "A list of strings, gexps or file-like objects that will be directly passed -to the @command{docker run} invokation." +to the @command{docker run} or @command{podman 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 (list-of-oci-containers? value) + (list-of-oci-records? "containers" oci-container-configuration? value)) + +(define-configuration/no-serialization oci-volume-configuration + (name + (string) + "The name of the OCI volume to provision.") + (labels + (list '()) + "The list of labels that will be used to tag the current volume." + (sanitizer oci-sanitize-labels)) + (extra-arguments + (list '()) + "A list of strings, gexps or file-like objects that will be directly passed +to the @command{docker volume create} or @command{podman volume create} +invocation." + (sanitizer oci-sanitize-extra-arguments))) + +(define (list-of-oci-volumes? value) + (list-of-oci-records? "volumes" oci-volume-configuration? value)) + +(define-configuration/no-serialization oci-network-configuration + (name + (string) + "The name of the OCI network to provision.") + (driver + (maybe-string) + "The driver to manage the network.") + (gateway + (maybe-string) + "IPv4 or IPv6 gateway for the subnet.") + (internal? + (boolean #f) + "Restrict external access to the network") + (ip-range + (maybe-string) + "Allocate container ip from a sub-range in CIDR format.") + (ipam-driver + (maybe-string) + "IP Address Management Driver.") + (ipv6? + (boolean #f) + "Enable IPv6 networking.") + (subnet + (maybe-string) + "Subnet in CIDR format that represents a network segment.") + (labels + (list '()) + "The list of labels that will be used to tag the current volume." + (sanitizer oci-sanitize-labels)) + (extra-arguments + (list '()) + "A list of strings, gexps or file-like objects that will be directly passed +to the @command{docker network create} or @command{podman network create} +invocation." + (sanitizer oci-sanitize-extra-arguments))) + +(define (list-of-oci-networks? value) + (list-of-oci-records? "networks" oci-network-configuration? value)) + +(define (package-or-string? value) + (or (package? value) (string? value))) + +(define-maybe/no-serialization package-or-string) + +(define-configuration/no-serialization oci-configuration + (runtime + (symbol 'docker) + "The OCI runtime to use to run commands. It can be either @code{'docker} or +@code{'podman}." + (sanitizer oci-sanitize-runtime)) + (runtime-cli + (maybe-package-or-string) + "The OCI runtime command line to be installed in the system profile and used +to provision OCI resources, it can be either a package or a string representing +an absolute path to the runtime binary entrypoint. When unset it will default +to @code{docker-cli} package for the @code{'docker} runtime or to @code{podman} +package for the @code{'podman} runtime.") + (runtime-extra-arguments + (list '()) + "A list of strings, gexps or file-like objects that will be placed +after each @command{docker} or @command{podman} invokation.") + (user + (string "oci-container") + "The user name under whose authority OCI runtime commands will be run.") + (group + (maybe-string) + "The group name under whose authority OCI commands will be run. When +using the @code{'podman} OCI runtime, this field will be ignored and the +default group of the user configured in the @code{user} field will be used.") + (subuids-range + (maybe-subid-range) + "An optional @code{subid-range} record allocating subuids for the user from +the @code{user} field. When unset, with the rootless Podman OCI runtime, it +defaults to @code{(subid-range (name \"oci-container\"))}.") + (subgids-range + (maybe-subid-range) + "An optional @code{subid-range} record allocating subgids for the user from +the @code{user} field. When unset, with the rootless Podman OCI runtime, it +defaults to @code{(subid-range (name \"oci-container\"))}.") + (containers + (list-of-oci-containers '()) + "The list of @code{oci-container-configuration} records representing the +containers to provision. Most users are supposed not to use this field and use +the @code{oci-extension} record instead.") + (networks + (list-of-oci-networks '()) + "The list of @code{oci-network-configuration} records representing the +networks to provision. Most users are supposed not to use this field and use +the @code{oci-extension} record instead.") + (volumes + (list-of-oci-volumes '()) + "The list of @code{oci-volume-configuration} records representing the +volumes to provision. Most users are supposed not to use this field and use +the @code{oci-extension} record instead.") + (verbose? + (boolean #f) + "When true, additional output will be printed, allowing to better follow the +flow of execution.")) + +(define (oci-runtime-system-environment runtime user) + (if (eq? runtime 'podman) + (list + #~(string-append + "HOME=" (passwd:dir (getpwnam #$user)))) + #~())) + +(define (oci-runtime-cli runtime runtime-cli path) + "Return a gexp that, when lowered, evaluates to the file system path of the OCI +runtime command requested by the user." + (if (string? runtime-cli) + ;; It is a user defined absolute path + runtime-cli + #~(string-append + #$(if (not (maybe-value-set? runtime-cli)) + path + runtime-cli) + #$(if (eq? 'podman runtime) + "/bin/podman" + "/bin/docker")))) + +(define* (oci-runtime-system-cli config #:key (path "/run/current-system/profile")) + (let ((runtime-cli + (oci-configuration-runtime-cli config)) + (runtime + (oci-configuration-runtime config))) + (oci-runtime-cli runtime runtime-cli path))) + +(define (oci-runtime-home-cli config) + (let ((runtime-cli + (oci-configuration-runtime-cli config)) + (runtime + (oci-configuration-runtime config))) + (oci-runtime-cli runtime runtime-cli + (string-append (getenv "HOME") + "/.guix-home/profile")))) + +(define-configuration/no-serialization oci-extension + (containers + (list-of-oci-containers '()) + "The list of @code{oci-container-configuration} records representing the +containers to add.") + (networks + (list-of-oci-networks '()) + "The list of @code{oci-network-configuration} records representing the +networks to add.") + (volumes + (list-of-oci-volumes '()) + "The list of @code{oci-volume-configuration} records representing the +volumes to add.")) + +(define (oci-image->container-name image) + "Infer the name of an OCI backed Shepherd service from its OCI image." + (basename + (if (string? image) + (first (string-split image #\:)) + (oci-image-repository image)))) + +(define (oci-object-command-shepherd-action object-name invocation) + "Return a Shepherd action printing a given INVOCATION of an OCI command for the +given OBJECT-NAME." + (shepherd-action + (name 'command-line) + (documentation + (format #f "Prints ~a's OCI runtime command line invocation." + object-name)) + (procedure + #~(lambda _ + (format #t "~a~%" #$invocation))))) + +(define (oci-container-shepherd-name runtime config) + "Return the name of an OCI backed Shepherd service based on CONFIG. +The name configured in the configuration record is returned when +CONFIG's name field has a value, otherwise a name is inferred from CONFIG's +image field." + (define name (oci-container-configuration-provision config)) + (define image (oci-container-configuration-image config)) + + (if (maybe-value-set? name) + name + (string-append (symbol->string runtime) "-" + (oci-image->container-name image)))) + +(define (oci-networks-shepherd-name runtime) + "Return the name of the OCI networks provisioning Shepherd service based on +RUNTIME." + (string-append (symbol->string runtime) "-networks")) + +(define (oci-volumes-shepherd-name runtime) + "Return the name of the OCI volumes provisioning Shepherd service based on +RUNTIME." + (string-append (symbol->string runtime) "-volumes")) + +(define (oci-networks-home-shepherd-name runtime) + "Return the name of the OCI volumes provisioning Home Shepherd service based on +RUNTIME." + (string-append "home-" (oci-networks-shepherd-name runtime))) + +(define (oci-volumes-home-shepherd-name runtime) + "Return the name of the OCI volumes provisioning Home Shepherd service based on +RUNTIME." + (string-append "home-" (oci-volumes-shepherd-name runtime))) + +(define (oci-container-configuration->options config) + "Map CONFIG, an oci-container-configuration record, to a gexp that, upon +lowering, will be evaluated to a list of strings containing command line options +for the OCI runtime run command." + (let ((entrypoint + (oci-container-configuration-entrypoint config)) + (network + (oci-container-configuration-network config)) + (user + (oci-container-configuration-container-user config)) + (workdir + (oci-container-configuration-workdir config))) + (apply append + (filter (compose not unspecified?) + `(,(if (maybe-value-set? entrypoint) + `("--entrypoint" ,entrypoint) + '()) + ,(append-map + (lambda (spec) + (list "--env" spec)) + (oci-container-configuration-environment config)) + ,(if (maybe-value-set? network) + `("--network" ,network) + '()) + ,(if (maybe-value-set? user) + `("--user" ,user) + '()) + ,(if (maybe-value-set? workdir) + `("--workdir" ,workdir) + '()) + ,(append-map + (lambda (spec) + (list "-p" spec)) + (oci-container-configuration-ports config)) + ,(append-map + (lambda (spec) + (list "-v" spec)) + (oci-container-configuration-volumes config))))))) + +(define (oci-network-configuration->options config) + "Map CONFIG, an oci-network-configuration record, to a gexp that, upon +lowering, will be evaluated to a list of strings containing command line options +for the OCI runtime network create command." + (let ((driver (oci-network-configuration-driver config)) + (gateway + (oci-network-configuration-gateway config)) + (internal? + (oci-network-configuration-internal? config)) + (ip-range + (oci-network-configuration-ip-range config)) + (ipam-driver + (oci-network-configuration-ipam-driver config)) + (ipv6? + (oci-network-configuration-ipv6? config)) + (subnet + (oci-network-configuration-subnet config))) + (apply append + (filter (compose not unspecified?) + `(,(if (maybe-value-set? driver) + `("--driver" ,driver) + '()) + ,(if (maybe-value-set? gateway) + `("--gateway" ,gateway) + '()) + ,(if internal? + `("--internal") + '()) + ,(if (maybe-value-set? ip-range) + `("--ip-range" ,ip-range) + '()) + ,(if (maybe-value-set? ipam-driver) + `("--ipam-driver" ,ipam-driver) + '()) + ,(if ipv6? + `("--ipv6") + '()) + ,(if (maybe-value-set? subnet) + `("--subnet" ,subnet) + '()) + ,(append-map + (lambda (spec) + (list "--label" spec)) + (oci-network-configuration-labels config))))))) + +(define (oci-volume-configuration->options config) + "Map CONFIG, an oci-volume-configuration record, to a gexp that, upon +lowering, will be evaluated to a list of strings containing command line options +for the OCI runtime volume create command." + (append-map + (lambda (spec) + (list "--label" spec)) + (oci-volume-configuration-labels config))) (define (lower-operating-system os target system) + "Lower OS, an operating-system record, into a tarball containing an OCI image." (mlet* %store-monad ((tarball (lower-object @@ -614,24 +1023,11 @@ (define (lower-operating-system os target 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))))) - +(define (lower-manifest name value options image-reference + target system grafts?) + "Lower VALUE, a manifest record, into a tarball containing an OCI image." (mlet* %store-monad - ((_ (set-grafting - (oci-image-grafts? image))) + ((_ (set-grafting grafts?)) (guile (set-guile-for-build (default-guile))) (profile (profile-derivation value @@ -642,14 +1038,11 @@ (define (lower-manifest name image target system) (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 (lower-oci-image-state name value options reference + image-target image-system grafts?) (define target (if (maybe-value-set? image-target) image-target @@ -662,7 +1055,8 @@ (define (lower-oci-image name image) (run-with-store store (match value ((? manifest? value) - (lower-manifest name image target system)) + (lower-manifest name value options reference + target system grafts?)) ((? operating-system? value) (lower-operating-system value target system)) ((or (? gexp? value) @@ -677,113 +1071,669 @@ (define (lower-oci-image name image) #: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))) +(define (lower-oci-image name image) + "Lower IMAGE, a oci-image record, into a tarball containing an OCI image." + (lower-oci-image-state + name + (oci-image-value image) + (oci-image-pack-options image) + (oci-image-reference image) + (oci-image-target image) + (oci-image-system image) + (oci-image-grafts? image))) + +(define (oci-object-exists? runtime runtime-cli object verbose?) + #~(lambda* (name #:key (format-string "{{.Name}}")) + (use-modules (ice-9 format) + (ice-9 match) + (ice-9 popen) + (ice-9 rdelim) + (srfi srfi-1)) + + (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))) + + #$(if (eq? runtime 'podman) + #~(let ((command + (list #$runtime-cli + #$object "exists" name))) + (when #$verbose? + (format #t "Running~{ ~a~}~%" command)) + (define exit-code (status:exit-val (apply system* command))) + (when #$verbose? + (format #t "Exit code: ~a~%" exit-code)) + (equal? EXIT_SUCCESS exit-code)) + #~(let ((command + (string-append #$runtime-cli + " " #$object " ls --format " + "\"" format-string "\""))) + (when #$verbose? + (format #t "Running ~a~%" command)) + (member name (read-lines (open-input-pipe command))))))) + +(define* (oci-image-loader runtime runtime-cli name image tag #:key (verbose? #f)) + "Return a file-like object that, once lowered, will evaluate to a program able +to load IMAGE through RUNTIME-CLI and to tag it with TAG afterwards." + (let ((tarball (lower-oci-image name image))) (with-imported-modules '((guix build utils)) - (program-file (format #f "~a-image-loader" name) + (program-file + (format #f "~a-image-loader" name) #~(begin (use-modules (guix build utils) + (ice-9 match) (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)) + (ice-9 rdelim) + (srfi srfi-1)) + (define object-exists? + #$(oci-object-exists? runtime runtime-cli "image" verbose?)) + (define load-command + (string-append #$runtime-cli + " load -i " #$tarball)) + + (if (object-exists? #$tag #:format-string "{{.Repository}}:{{.Tag}}") + (format #t "~a image already exists, skipping.~%" #$tag) + (begin + (format #t "Loading image for ~a from ~a...~%" #$name #$tarball) + (when #$verbose? + (format #t "Running ~a~%" load-command)) + (let ((line (read-line + (open-input-pipe load-command)))) + (unless (or (eof-object? line) + (string-null? line)) + (format #t "~a~%" line) + (let* ((repository&tag + (string-drop line + (string-length + "Loaded image: "))) + (tag-command + (list #$runtime-cli "tag" repository&tag #$tag)) + (drop-old-tag-command + (list #$runtime-cli "image" "rm" "-f" repository&tag))) + + (unless (string=? repository&tag #$tag) + (when #$verbose? + (format #t "Running~{ ~a~}~%" tag-command)) + + (let ((exit-code + (status:exit-val (apply system* tag-command)))) + (format #t "Tagged ~a with ~a...~%" #$tarball #$tag) + + (when #$verbose? + (format #t "Exit code: ~a~%" exit-code)) + + (when (equal? EXIT_SUCCESS exit-code) + (when #$verbose? + (format #t "Running~{ ~a~}~%" drop-old-tag-command)) + (let ((drop-exit-code + (status:exit-val (apply system* drop-old-tag-command)))) + (when #$verbose? + (format #t "Exit code: ~a~%" drop-exit-code)))))))))))))))) + +(define (oci-container-run-invocation runtime runtime-cli name command image-reference + options runtime-extra-arguments run-extra-arguments) + "Return a list representing the OCI runtime +invocation for running containers." + ;; run [OPTIONS] IMAGE [COMMAND] [ARG...] + `(,runtime-cli ,@runtime-extra-arguments "run" "--rm" + ,@(if (eq? runtime 'podman) + ;; This is because podman takes some time to + ;; release container names. --replace seems + ;; to be required to be able to restart services. + '("--replace") + '()) + "--name" ,name + ,@options ,@run-extra-arguments + ,image-reference ,@command)) + +(define* (oci-container-entrypoint runtime runtime-cli name image image-reference + invocation #:key (verbose? #f) (pre-script #~())) + "Return a file-like object that, once lowered, will evaluate to the entrypoint +for the Shepherd service that will run IMAGE through RUNTIME-CLI." + (program-file + (string-append "oci-entrypoint-" name) + #~(begin + (use-modules (ice-9 format) + (srfi srfi-1)) + (when #$verbose? + (format #t "Running in verbose mode...~%") + (format #t "Current user: ~a ~a~%" + (getuid) (passwd:name (getpwuid (getuid)))) + (format #t "Current group: ~a ~a~%" + (getgid) (group:name (getgrgid (getgid)))) + (format #t "Current directory ~a~%" (getcwd))) + (define invocation (list #$@invocation)) + #$@pre-script + (when #$verbose? + (format #t "Running~{ ~a~}~%" invocation)) + (apply execlp `(,(first invocation) ,@invocation))))) + +(define* (oci-container-shepherd-service runtime runtime-cli config + #:key + (runtime-environment #~()) + (runtime-extra-arguments '()) + (oci-requirement '()) + (user #f) + (group #f) + (verbose? #f)) + "Return a Shepherd service object that will run the OCI container represented +by CONFIG through RUNTIME-CLI." + (let* ((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)) + (maybe-user (oci-container-configuration-user config)) + (maybe-group (oci-container-configuration-group config)) + (user (if (maybe-value-set? maybe-user) + maybe-user + user)) + (group (if (maybe-value-set? maybe-group) + maybe-group + group)) (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)) + (name + (oci-container-shepherd-name runtime config)) (extra-arguments - (oci-container-configuration-extra-arguments config))) + (oci-container-configuration-extra-arguments config)) + (invocation + (oci-container-run-invocation + runtime runtime-cli name command image-reference + options runtime-extra-arguments extra-arguments)) + (container-action + (lambda* (command #:key (environment-variables #f)) + #~(lambda _ + (fork+exec-command + (list #$@command) + #$@(if user (list #:user user) '()) + #$@(if group (list #:group group) '()) + #$@(if (maybe-value-set? log-file) + (list #:log-file log-file) + '()) + #$@(if (and user (eq? runtime 'podman)) + (list #:directory + #~(passwd:dir (getpwnam #$user))) + '()) + #$@(if environment-variables + (list #:environment-variables + environment-variables) + '())))))) (shepherd-service (provision `(,(string->symbol name))) - (requirement `(dockerd user-processes ,@requirement)) + (requirement `(,@oci-requirement + ,@requirement)) (respawn? respawn?) (auto-start? auto-start?) (documentation (string-append - "Docker backed Shepherd service for " + (oci-runtime-name runtime) " 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)))) + (container-action + (list (oci-container-entrypoint + runtime runtime-cli name image image-reference + invocation #:verbose? verbose? + #:pre-script + (if (oci-image? image) + #~((system* + #$(oci-image-loader + runtime runtime-cli name image + image-reference #:verbose? verbose?))) + #~()))) + #:environment-variables + #~(append + (list #$@host-environment) + (list #$@runtime-environment)))) (stop - #~(lambda _ - (invoke #$docker "rm" "-f" #$name))) + (container-action + (list + (oci-container-entrypoint + runtime runtime-cli name image image-reference + (list runtime-cli "rm" "-f" name) + #:verbose? verbose?)) + #:environment-variables + #~(append + (list #$@host-environment) + (list #$@runtime-environment)))) (actions - (if (oci-image? image) - '() - (append + (append + (list + (oci-object-command-shepherd-action + name #~(string-join (list #$@invocation) " "))) + (if (oci-image? image) + '() (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 + (let ((service-name name)) + (shepherd-action + (name 'pull) + (documentation + (format #f "Pull ~a's image (~a)." + service-name image)) + (procedure + (container-action + (list + (oci-container-entrypoint + runtime runtime-cli service-name image + image-reference + (list runtime-cli "pull" image) + #:verbose? verbose?)) + #:environment-variables + #~(append + (list #$@host-environment) + (list #$@runtime-environment)))))))) + actions))))) + +(define (oci-object-create-invocation object runtime-cli name options + runtime-extra-arguments + create-extra-arguments) + "Return a gexp that, upon lowering, will evaluate to the OCI runtime +invocation for creating networks and volumes." + ;; network|volume create [options] [NAME] + #~(list #$runtime-cli #$@runtime-extra-arguments #$object "create" + #$@options #$@create-extra-arguments #$name)) + +(define (format-oci-invocations invocations) + "Return a gexp that, upon lowering, will evaluate to a formatted message +containing the INVOCATIONS that the OCI runtime will execute to provision +networks or volumes." + #~(string-join (map (lambda (i) (string-join i " ")) + (list #$@invocations)) + "\n")) + +(define* (oci-object-create-script object runtime runtime-cli invocations + #:key (verbose? #f)) + "Return a file-like object that, once lowered, will evaluate to a program able +to create OCI networks and volumes through RUNTIME-CLI." + (define runtime-string (symbol->string runtime)) + (program-file + (string-append runtime-string "-" object "s-create.scm") + #~(begin + (use-modules (ice-9 format) + (ice-9 match) + (ice-9 popen) + (ice-9 rdelim) + (srfi srfi-1)) + + (define object-exists? + #$(oci-object-exists? runtime runtime-cli object verbose?)) + + (for-each + (lambda (invocation) + (define name (last invocation)) + (if (object-exists? name) + (format #t "~a ~a ~a already exists, skipping creation.~%" + #$(oci-runtime-name runtime) name #$object) + (begin + (when #$verbose? + (format #t "Running~{ ~a~}~%" invocation)) + (let ((exit-code (status:exit-val (apply system* invocation)))) + (when #$verbose? + (format #t "Exit code: ~a~%" exit-code)))))) + (list #$@invocations))))) + +(define* (oci-object-shepherd-service object runtime runtime-cli name requirement invocations + #:key + (runtime-environment #~()) + (user #f) + (group #f) + (verbose? #f)) + "Return a Shepherd service object that will create the OBJECTs represented +by INVOCATIONS through RUNTIME-CLI." + (shepherd-service (provision `(,(string->symbol name))) + (requirement requirement) + (one-shot? #t) + (documentation + (string-append + (oci-runtime-name runtime) " " object + " provisioning service")) + (start + #~(lambda _ + (fork+exec-command + (list + #$(oci-object-create-script + object runtime runtime-cli + invocations + #:verbose? verbose?)) + #$@(if user (list #:user user) '()) + #$@(if group (list #:group group) '()) + #:environment-variables + (list #$@runtime-environment)))) + (actions + (list + (oci-object-command-shepherd-action + name (format-oci-invocations invocations)))))) + +(define* (oci-networks-shepherd-service runtime runtime-cli name networks + #:key (user #f) (group #f) (verbose? #f) + (runtime-extra-arguments '()) + (runtime-environment #~()) + (runtime-requirement '())) + "Return a Shepherd service object that will create the networks represented +in CONFIG." + (let ((invocations + (map + (lambda (network) + (oci-object-create-invocation + "network" runtime-cli + (oci-network-configuration-name network) + (oci-network-configuration->options network) + runtime-extra-arguments + (oci-network-configuration-extra-arguments network))) + networks))) + + (oci-object-shepherd-service + "network" runtime runtime-cli name + runtime-requirement invocations + #:user user #:group group #:runtime-environment runtime-environment + #:verbose? verbose?))) + +(define* (oci-volumes-shepherd-service runtime runtime-cli name volumes + #:key (user #f) (group #f) (verbose? #f) + (runtime-extra-arguments '()) + (runtime-environment #~()) + (runtime-requirement '())) + "Return a Shepherd service object that will create the volumes represented +in CONFIG." + (let ((invocations + (map + (lambda (volume) + (oci-object-create-invocation + "volume" runtime-cli + (oci-volume-configuration-name volume) + (oci-volume-configuration->options volume) + runtime-extra-arguments + (oci-volume-configuration-extra-arguments volume))) + volumes))) + + (oci-object-shepherd-service + "volume" runtime runtime-cli name runtime-requirement invocations + #:user user #:group group #:runtime-environment runtime-environment + #:verbose? verbose?))) + +(define (oci-service-accounts config) + (define user (oci-configuration-user config)) + (define maybe-group (oci-configuration-group config)) + (define runtime (oci-configuration-runtime config)) (list (user-account - (name "oci-container") + (name user) (comment "OCI services account") - (group "docker") - (system? #t) - (home-directory "/var/empty") + (group "users") + (supplementary-groups + (list (oci-runtime-group runtime maybe-group))) + (system? (eq? 'docker runtime)) + (home-directory (if (eq? 'podman runtime) + (string-append "/home/" user) + "/var/empty")) + (create-home-directory? (eq? 'podman runtime)) (shell (file-append shadow "/sbin/nologin"))))) + +(define* (oci-state->shepherd-services runtime runtime-cli containers networks volumes + #:key (user #f) (group #f) (verbose? #f) + (networks-name #f) (volumes-name #f) + (runtime-extra-arguments '()) + (runtime-environment #~()) + (runtime-requirement '()) + (containers-requirement '()) + (networks-requirement '()) + (volumes-requirement '())) + "Returns a list of Shepherd services based on the input OCI state." + (let* ((networks-name + (if (string? networks-name) + networks-name + (oci-networks-shepherd-name runtime))) + (networks? + (> (length networks) 0)) + (networks-service + (if networks? + (list + (string->symbol networks-name)) + '())) + (volumes-name + (if (string? volumes-name) + volumes-name + (oci-volumes-shepherd-name runtime))) + (volumes? + (> (length volumes) 0)) + (volumes-service + (if volumes? + (list (string->symbol volumes-name)) + '()))) + (append + (map + (lambda (c) + (oci-container-shepherd-service + runtime runtime-cli c + #:user user + #:group group + #:runtime-environment runtime-environment + #:runtime-extra-arguments runtime-extra-arguments + #:oci-requirement + (append containers-requirement + runtime-requirement + networks-service + volumes-service) + #:verbose? verbose?)) + containers) + (if networks? + (list + (oci-networks-shepherd-service + runtime runtime-cli + networks-name networks + #:user user #:group group + #:runtime-extra-arguments runtime-extra-arguments + #:runtime-environment runtime-environment + #:runtime-requirement (append networks-requirement + runtime-requirement) + #:verbose? verbose?)) + '()) + (if volumes? + (list + (oci-volumes-shepherd-service + runtime runtime-cli + volumes-name volumes + #:user user #:group group + #:runtime-extra-arguments runtime-extra-arguments + #:runtime-environment runtime-environment + #:runtime-requirement (append runtime-requirement + volumes-requirement) + #:verbose? verbose?)) + '())))) + +(define (oci-configuration->shepherd-services config) + (let* ((runtime (oci-configuration-runtime config)) + (system-runtime-cli + (oci-runtime-system-cli config)) + (home-runtime-cli + (oci-runtime-home-cli config)) + (runtime-extra-arguments + (oci-configuration-runtime-extra-arguments config)) + (containers (oci-configuration-containers config)) + (networks (oci-configuration-networks config)) + (volumes (oci-configuration-volumes config)) + (user (oci-configuration-user config)) + (group + (if (eq? runtime 'podman) + #~(group:name + (getgrgid + (passwd:gid + (getpwnam #$user)))) + (oci-runtime-group config (oci-configuration-group config)))) + (verbose? (oci-configuration-verbose? config))) + (oci-state->shepherd-services runtime system-runtime-cli containers networks volumes + #:user user + #:group group + #:verbose? verbose? + #:runtime-extra-arguments + runtime-extra-arguments + #:runtime-environment + (oci-runtime-system-environment runtime user) + #:runtime-requirement + (oci-runtime-system-requirement runtime) + #:networks-requirement '(networking)))) + +(define (oci-service-subids config) + "Return a subids-extension record representing subuids and subgids required by +the rootless Podman backend." + (define (delete-duplicate-ranges ranges) + (delete-duplicates ranges + (lambda args + (apply string=? (map subid-range-name ranges))))) + (define runtime + (oci-configuration-runtime config)) + (define user + (oci-configuration-user config)) + (define subgids (oci-configuration-subgids-range config)) + (define subuids (oci-configuration-subuids-range config)) + (define container-users + (filter (lambda (range) + (and (maybe-value-set? + (subid-range-name range)) + (not (string=? (subid-range-name range) user)))) + (map (lambda (container) + (subid-range + (name + (oci-container-configuration-user container)))) + (oci-configuration-containers config)))) + (define subgid-ranges + (delete-duplicate-ranges + (cons + (if (not (maybe-value-set? subgids)) + (subid-range (name user)) + subgids) + container-users))) + (define subuid-ranges + (delete-duplicate-ranges + (cons + (if (not (maybe-value-set? subuids)) + (subid-range (name user)) + subuids) + container-users))) + + (if (eq? 'podman runtime) + (subids-extension + (subgids + subgid-ranges) + (subuids + subuid-ranges)) + (subids-extension))) + +(define (oci-objects-merge-lst a b object get-name) + (define (contains? value lst) + (member value (map get-name lst))) + (let loop ((merged '()) + (lst (append a b))) + (if (null? lst) + merged + (loop + (let ((element (car lst))) + (when (contains? element merged) + (raise + (formatted-message + (G_ "Duplicated ~a: ~a. ~as names should be unique, please +remove the duplicate.") object (get-name element) object))) + (cons element merged)) + (cdr lst))))) + +(define (oci-extension-merge a b) + (oci-extension + (containers (oci-objects-merge-lst + (oci-extension-containers a) + (oci-extension-containers b) + "container" + (lambda (config) + (define maybe-name (oci-container-configuration-provision config)) + (if (maybe-value-set? maybe-name) + maybe-name + (oci-image->container-name + (oci-container-configuration-image config)))))) + (networks (oci-objects-merge-lst + (oci-extension-networks a) + (oci-extension-networks b) + "network" + oci-network-configuration-name)) + (volumes (oci-objects-merge-lst + (oci-extension-volumes a) + (oci-extension-volumes b) + "volume" + oci-volume-configuration-name)))) + +(define (oci-service-profile runtime runtime-cli) + `(,bash-minimal + ,@(if (string? runtime-cli) + '() + (list + (cond + ((maybe-value-set? runtime-cli) + runtime-cli) + ((eq? 'podman runtime) + podman) + (else + docker-cli)))))) + +(define (oci-configuration-extend config extension) + (oci-configuration + (inherit config) + (containers + (oci-objects-merge-lst + (oci-configuration-containers config) + (oci-extension-containers extension) + "container" + (lambda (oci-config) + (define runtime + (oci-configuration-runtime config)) + (oci-container-shepherd-name runtime oci-config)))) + (networks (oci-objects-merge-lst + (oci-configuration-networks config) + (oci-extension-networks extension) + "network" + oci-network-configuration-name)) + (volumes (oci-objects-merge-lst + (oci-configuration-volumes config) + (oci-extension-volumes extension) + "volume" + oci-volume-configuration-name)))) + +(define oci-service-type + (service-type (name 'oci) + (extensions + (list + (service-extension profile-service-type + (lambda (config) + (let ((runtime-cli + (oci-configuration-runtime-cli config)) + (runtime + (oci-configuration-runtime config))) + (oci-service-profile runtime runtime-cli)))) + (service-extension subids-service-type + oci-service-subids) + (service-extension account-service-type + oci-service-accounts) + (service-extension shepherd-root-service-type + oci-configuration->shepherd-services))) + ;; Concatenate OCI object lists. + (compose (lambda (args) + (fold oci-extension-merge + (oci-extension) + args))) + (extend oci-configuration-extend) + (default-value (oci-configuration)) + (description + "This service implements the provisioning of OCI object such +as containers, networks and volumes."))) diff --git a/gnu/services/docker.scm b/gnu/services/docker.scm index 828ceea313a..125e748bb0e 100644 --- a/gnu/services/docker.scm +++ b/gnu/services/docker.scm @@ -31,7 +31,10 @@ (define-module (gnu services docker) #:use-module (gnu system shadow) #:use-module (gnu packages docker) #:use-module (gnu packages linux) ;singularity + #:use-module (guix deprecation) + #:use-module (guix diagnostics) #:use-module (guix gexp) + #:use-module (guix i18n) #:use-module (guix records) #:use-module (srfi srfi-1) #:use-module (ice-9 format) @@ -67,16 +70,18 @@ (define-module (gnu services docker) 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) + oci-container-configuration-extra-arguments) #:export (containerd-configuration containerd-service-type docker-configuration docker-service-type singularity-service-type - oci-container-service-type)) + ;; for backwards compatibility, until the + ;; oci-container-service-type is fully deprecated + oci-container-shepherd-service + oci-container-service-type + %oci-container-accounts)) (define-maybe file-like) @@ -297,17 +302,25 @@ (define singularity-service-type ;;; OCI container. ;;; -(define (configs->shepherd-services configs) - (map oci-container-shepherd-service configs)) +;; for backwards compatibility, until the +;; oci-container-service-type is fully deprecated +(define-deprecated (oci-container-shepherd-service config) + oci-service-type + ((@ (gnu services containers) oci-container-shepherd-service) + 'docker config)) +(define %oci-container-accounts + (filter user-account? (oci-service-accounts (oci-configuration)))) (define oci-container-service-type (service-type (name 'oci-container) - (extensions (list (service-extension profile-service-type - (lambda _ (list docker-cli))) - (service-extension account-service-type - (const %oci-container-accounts)) - (service-extension shepherd-root-service-type - configs->shepherd-services))) + (extensions + (list (service-extension oci-service-type + (lambda (containers) + (warning + (G_ + "'oci-container-service-type' is deprecated, use 'oci-service-type' instead~%")) + (oci-extension + (containers containers)))))) (default-value '()) (extend append) (compose concatenate) diff --git a/gnu/tests/containers.scm b/gnu/tests/containers.scm index 0ecc8ddb126..5e6f39387e7 100644 --- a/gnu/tests/containers.scm +++ b/gnu/tests/containers.scm @@ -27,6 +27,9 @@ (define-module (gnu tests containers) #: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 @@ (define-module (gnu tests containers) #: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 @@ -345,3 +350,995 @@ (define %test-rootless-podman (name "rootless-podman") (description "Test rootless Podman service.") (value (build-tarball&run-rootless-podman-test)))) + + +(define %oci-rootless-podman-os + (simple-operating-system + (service dhcp-client-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-configuration (name "my-network")))) + (volumes + (list (oci-volume-configuration (name "my-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)(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 services herd) + (guix combinators)))) + + (define vm + (virtual-machine + (operating-system os) + (volatile? #f) + (memory-size 1024) + (disk-image-size (* 3000 (expt 2 20))) + (port-forwardings '()))) + + (define test + (with-imported-modules '((gnu build marionette)) + #~(begin + (use-modules (srfi srfi-11) (srfi srfi-64) + (gnu build marionette)) + + (define marionette + ;; Relax timeout to accommodate older systems and + ;; allow for pulling the image. + (make-marionette (list #$vm) #:timeout 60)) + (define out-dir "/tmp") + + (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 "rootless-podman services started successfully" + (begin + (define (run-test) + (marionette-eval + `(begin + (use-modules (ice-9 popen) + (ice-9 match) + (ice-9 rdelim)) + + (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 slurp + (lambda args + (let* ((port (apply open-pipe* OPEN_READ args)) + (output (read-lines port)) + (status (close-pipe port))) + output))) + (let* ((bash + ,(string-append #$bash "/bin/bash")) + (response1 + (slurp bash "-c" + (string-append "ls -la /sys/fs/cgroup | " + "grep -E ' \\./?$' | awk '{ print $4 }'"))) + (response2 (slurp bash "-c" + (string-append "ls -l /sys/fs/cgroup/cgroup" + ".{procs,subtree_control,threads} | " + "awk '{ print $4 }' | sort -u")))) + (list (string-join response1 "\n") (string-join response2 "\n")))) + marionette)) + ;; Allow services to come up on slower machines + (let loop ((attempts 0)) + (if (= attempts 60) + (error "Services didn't come up after more than 60 seconds") + (if (equal? '("cgroup" "cgroup") + (run-test)) + #t + (begin + (sleep 1) + (format #t "Services didn't come up yet, retrying with attempt ~a~%" + (+ 1 attempts)) + (loop (+ 1 attempts)))))))) + + (test-assert "podman-volumes running" + (begin + (define (run-test) + (marionette-eval + `(begin + (use-modules (srfi srfi-1) + (ice-9 popen) + (ice-9 match) + (ice-9 rdelim)) + + (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 (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 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))) + + (match (primitive-fork) + (0 + (dynamic-wind + (const #f) + (lambda () + (setgid (passwd:gid (getpwnam "oci-container"))) + (setuid (passwd:uid (getpw "oci-container"))) + + (let ((response (slurp + "/run/current-system/profile/bin/podman" + "volume" "ls" "-n" "--format" "\"{{.Name}}\"" + "|" "tr" "' '" "'\n'"))) + + (call-with-output-file (string-append ,out-dir "/response") + (lambda (port) + (display (string-join response "\n") port))))) + (lambda () + (primitive-exit 127)))) + (pid + (cdr (waitpid pid)))) + + (wait-for-file (string-append ,out-dir "/response")) + + (stable-sort + (slurp "cat" (string-append ,out-dir "/response")) + string<=?)) + marionette)) + ;; Allow services to come up on slower machines + (let loop ((attempts 0)) + (if (= attempts 80) + (error "Service didn't come up after more than 80 seconds") + (if (equal? '("my-volume") + (run-test)) + #t + (begin + (sleep 1) + (loop (+ 1 attempts)))))))) + + (test-assert "podman-networks running" + (begin + (define (run-test) + (marionette-eval + `(begin + (use-modules (srfi srfi-1) + (ice-9 popen) + (ice-9 match) + (ice-9 rdelim)) + + (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 (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 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))) + + (match (primitive-fork) + (0 + (dynamic-wind + (const #f) + (lambda () + (setgid (passwd:gid (getpwnam "oci-container"))) + (setuid (passwd:uid (getpw "oci-container"))) + + (let ((response (slurp + "/run/current-system/profile/bin/podman" + "network" "ls" "-n" "--format" "\"{{.Name}}\"" + "|" "tr" "' '" "'\n'"))) + + (call-with-output-file (string-append ,out-dir "/response") + (lambda (port) + (display (string-join response "\n") port))))) + (lambda () + (primitive-exit 127)))) + (pid + (cdr (waitpid pid)))) + + (wait-for-file (string-append ,out-dir "/response")) + + (stable-sort + (slurp "cat" (string-append ,out-dir "/response")) + string<=?)) + marionette)) + ;; Allow services to come up on slower machines + (let loop ((attempts 0)) + (if (= attempts 80) + (error "Service didn't come up after more than 80 seconds") + (if (equal? '("my-network" "podman") + (run-test)) + #t + (begin + (sleep 1) + (loop (+ 1 attempts)))))))) + + (test-assert "first container running" + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (wait-for-service 'first #:timeout 120) + #t) + marionette)) + + (test-assert "second container running" + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (wait-for-service 'second #:timeout 120) + #t) + marionette)) + + (test-assert "passing host environment variables" + (begin + (define (run-test) + (marionette-eval + `(begin + (use-modules (srfi srfi-1) + (ice-9 popen) + (ice-9 match) + (ice-9 rdelim)) + + (define (wait-for-file file) + ;; Wait until FILE shows up. + (let loop ((i 60)) + (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 (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 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))) + + (match (primitive-fork) + (0 + (dynamic-wind + (const #f) + (lambda () + (setgid (passwd:gid (getpwnam "oci-container"))) + (setuid (passwd:uid (getpw "oci-container"))) + + (let ((response (slurp + "/run/current-system/profile/bin/podman" + "exec" "first" + "/bin/guile" "-c" "'(display (getenv \"VARIABLE\"))'"))) + (call-with-output-file (string-append ,out-dir "/response") + (lambda (port) + (display (string-join response "\n") port))))) + (lambda () + (primitive-exit 127)))) + (pid + (cdr (waitpid pid)))) + + (wait-for-file (string-append ,out-dir "/response")) + (slurp "cat" (string-append ,out-dir "/response"))) + marionette)) + ;; Allow image to be loaded on slower machines + (let loop ((attempts 0)) + (if (= attempts 180) + (error "Service didn't come up after more than 180 seconds") + (if (equal? (list "value") + (run-test)) + #t + (begin + (sleep 1) + (loop (+ 1 attempts)))))))) + + (test-equal "mounting host files" + '("hello") + (marionette-eval + `(begin + (use-modules (srfi srfi-1) + (ice-9 popen) + (ice-9 match) + (ice-9 rdelim)) + + (define (wait-for-file file) + ;; Wait until FILE shows up. + (let loop ((i 60)) + (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 (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 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))) + + (match (primitive-fork) + (0 + (dynamic-wind + (const #f) + (lambda () + (setgid (passwd:gid (getpwnam "oci-container"))) + (setuid (passwd:uid (getpw "oci-container"))) + + (let ((response (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)))'"))) + (call-with-output-file (string-append ,out-dir "/response") + (lambda (port) + (display (string-join response " ") port))))) + (lambda () + (primitive-exit 127)))) + (pid + (cdr (waitpid pid)))) + + (wait-for-file (string-append ,out-dir "/response")) + (slurp "cat" (string-append ,out-dir "/response"))) + marionette)) + + (test-equal "write to volumes" + '("world") + (marionette-eval + `(begin + (use-modules (srfi srfi-1) + (ice-9 popen) + (ice-9 match) + (ice-9 rdelim)) + + (define (wait-for-file file) + ;; Wait until FILE shows up. + (let loop ((i 60)) + (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 (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 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))) + + (match (primitive-fork) + (0 + (dynamic-wind + (const #f) + (lambda () + (setgid (passwd:gid (getpwnam "oci-container"))) + (setuid (passwd:uid (getpw "oci-container"))) + + (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))))'") + + (let ((response (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)))'"))) + (call-with-output-file (string-append ,out-dir "/response") + (lambda (port) + (display (string-join response " ") port))))) + (lambda () + (primitive-exit 127)))) + (pid + (cdr (waitpid pid)))) + + (wait-for-file (string-append ,out-dir "/response")) + (slurp "cat" (string-append ,out-dir "/response"))) + marionette)) + + (test-equal "can read ports over network" + '("out of office") + (marionette-eval + `(begin + (use-modules (srfi srfi-1) + (ice-9 popen) + (ice-9 match) + (ice-9 rdelim)) + + (define (wait-for-file file) + ;; Wait until FILE shows up. + (let loop ((i 60)) + (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 (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 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))) + + (match (primitive-fork) + (0 + (dynamic-wind + (const #f) + (lambda () + (setgid (passwd:gid (getpwnam "oci-container"))) + (setuid (passwd:uid (getpw "oci-container"))) + + (let ((response (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))'"))) + (call-with-output-file (string-append ,out-dir "/response") + (lambda (port) + (display (string-join response " ") port))))) + (lambda () + (primitive-exit 127)))) + (pid + (cdr (waitpid pid)))) + + (wait-for-file (string-append ,out-dir "/response")) + (slurp "cat" (string-append ,out-dir "/response"))) + 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-os + (simple-operating-system + (service dhcp-client-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-configuration (name "my-network")))) + (volumes + (list (oci-volume-configuration (name "my-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)(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 services herd) + (guix combinators)))) + + (define vm + (virtual-machine + (operating-system os) + (volatile? #f) + (memory-size 1024) + (disk-image-size (* 3000 (expt 2 20))) + (port-forwardings '()))) + + (define test + (with-imported-modules '((gnu build marionette)) + #~(begin + (use-modules (srfi srfi-11) (srfi srfi-64) + (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) + (marionette-eval + `(begin + (use-modules (ice-9 popen) + (ice-9 rdelim)) + + (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 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))) + + (stable-sort + (slurp + "/run/current-system/profile/bin/docker" + "volume" "ls" "--format" "\"{{.Name}}\"") + string<=?)) + + marionette)) + ;; Allow services to come up on slower machines + (let loop ((attempts 0)) + (if (= attempts 80) + (error "Service didn't come up after more than 80 seconds") + (if (equal? '("my-volume") + (run-test)) + #t + (begin + (sleep 1) + (loop (+ 1 attempts)))))))) + + (test-assert "docker-networks running" + (begin + (define (run-test) + (marionette-eval + `(begin + (use-modules (ice-9 popen) + (ice-9 rdelim)) + + (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 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))) + + (stable-sort + (slurp + "/run/current-system/profile/bin/docker" + "network" "ls" "--format" "\"{{.Name}}\"") + string<=?)) + + marionette)) + ;; Allow services to come up on slower machines + (let loop ((attempts 0)) + (if (= attempts 80) + (error "Service didn't come up after more than 80 seconds") + (if (equal? '("bridge" "host" "my-network" "none") + (run-test)) + #t + (begin + (sleep 1) + (loop (+ 1 attempts)))))))) + + (test-assert "first container running" + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (wait-for-service 'first #:timeout 120) + #t) + marionette)) + + (test-assert "second container running" + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (wait-for-service 'second #:timeout 120) + #t) + marionette)) + + (test-assert "passing host environment variables" + (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))) + + (slurp + "/run/current-system/profile/bin/docker" + "exec" "first" + "/bin/guile" "-c" "(display (getenv \"VARIABLE\"))")) + marionette)) + ;; Allow image to be loaded on slower machines + (let loop ((attempts 0)) + (if (= attempts 180) + (error "Service didn't come up after more than 180 seconds") + (if (equal? "value" + (run-test)) + #t + (begin + (sleep 1) + (loop (+ 1 attempts)))))))) + + (test-equal "mounting host files" + "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))) + + (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 \"/shared.txt\" read-line)))")) + marionette)) + + (test-equal "write to volumes" + "world" + (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))) + + (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 ports over network" + "out of office" + (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))) + + (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)))) -- 2.48.1 From unknown Fri Jun 13 11:55:10 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#76081] [PATCH v9 5/7] tests: Use lower-oci-image-state in container tests. Resent-From: Giacomo Leidi Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Tue, 18 Mar 2025 17:53:09 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 76081 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 76081@debbugs.gnu.org Cc: Giacomo Leidi Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.174232032929618 (code B ref 76081); Tue, 18 Mar 2025 17:53:09 +0000 Received: (at 76081) by debbugs.gnu.org; 18 Mar 2025 17:52:09 +0000 Received: from localhost ([127.0.0.1]:43080 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tub6m-0007hX-9Q for submit@debbugs.gnu.org; Tue, 18 Mar 2025 13:52:09 -0400 Received: from confino.investici.org ([2a11:7980:1::2:0]:21841) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1tub6F-0007ce-J2 for 76081@debbugs.gnu.org; Tue, 18 Mar 2025 13:51:36 -0400 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org; s=stigmate; t=1742320294; bh=/3wm1tMXIgU4KT1kvz1WhzIRH1XipEQlymAUa9c0zZ8=; h=From:To:Cc:Subject:Date:In-Reply-To:References:From; b=lFedZCvGPkgHjcsAR0z27G6t1n3nv4bzB2H2gXNCS6SfavEsGEH+sz8vh68DeDMzD RbAV6oFqaKltZml6md40+4HV6Mo3DfO51I55uaaPHvV2MKUTmYEgAq9z9qgKcrxnbc Oz/oOEAbOTjSZKZW7tMg/z5BKYBXK9oKvwZ5b/Sk= Received: from mx1.investici.org (unknown [127.0.0.1]) by confino.investici.org (Postfix) with ESMTP id 4ZHKCV0LkGz11cn; Tue, 18 Mar 2025 17:51:34 +0000 (UTC) Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19]) (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with ESMTPSA id 4ZHKCT6P6Sz11cm; Tue, 18 Mar 2025 17:51:33 +0000 (UTC) From: Giacomo Leidi Date: Tue, 18 Mar 2025 18:51:10 +0100 Message-ID: <5e11bb8d29e14d75e1b09166efdda8932bb95e7b.1742320272.git.goodoldpaul@autistici.org> X-Mailer: git-send-email 2.48.1 In-Reply-To: <15af7d63ead9dfad272154c09bdfda718da1047c.1742320272.git.goodoldpaul@autistici.org> References: <15af7d63ead9dfad272154c09bdfda718da1047c.1742320272.git.goodoldpaul@autistici.org> MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Spam-Score: -0.0 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) This patch replaces boilerplate in container related tests with oci-image plumbing from (gnu services containers). * gnu/services/containers.scm: Export lower-oci-image-state. * gnu/tests/containers.scm (%oci-tarball): New variable; (run-rootless-podman-test): use %oci-tarball; (build-tarball&run-rootless-podman-test): drop procedure. * gnu/tests/docker.scm (%docker-tarball): New variable; (build-tarball&run-docker-test): use %docker-tarball; (%docker-system-tarball): New variable; (build-tarball&run-docker-system-test): new procedure. Change-Id: Iad6f0704aee188d89464c83722dea0bb7adb084a --- gnu/services/containers.scm | 2 + gnu/tests/containers.scm | 80 ++++++++++++++--------------- gnu/tests/docker.scm | 100 ++++++++++++++++++++---------------- 3 files changed, 95 insertions(+), 87 deletions(-) diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm index d1ebfa1736c..5dac8e80f22 100644 --- a/gnu/services/containers.scm +++ b/gnu/services/containers.scm @@ -74,6 +74,8 @@ (define-module (gnu services containers) oci-image-system oci-image-grafts? + lower-oci-image-state + oci-container-configuration oci-container-configuration? oci-container-configuration-fields diff --git a/gnu/tests/containers.scm b/gnu/tests/containers.scm index 5e6f39387e7..8cdd86e7ae3 100644 --- a/gnu/tests/containers.scm +++ b/gnu/tests/containers.scm @@ -69,13 +69,47 @@ (define %rootless-podman-os (supplementary-groups '("wheel" "netdev" "cgroup" "audio" "video"))))))) -(define (run-rootless-podman-test oci-tarball) +(define %oci-tarball + (lower-oci-image-state + "guile-guest" + (packages->manifest + (list + guile-3.0 guile-json-3 + (package + (name "guest-script") + (version "0") + (source #f) + (build-system trivial-build-system) + (arguments `(#:guile ,guile-3.0 + #:builder + (let ((out (assoc-ref %outputs "out"))) + (mkdir out) + (call-with-output-file (string-append out "/a.scm") + (lambda (port) + (display "(display \"hello world\n\")" port))) + #t))) + (synopsis "Display hello world using Guile") + (description "This package displays the text \"hello world\" on the +standard output device and then enters a new line.") + (home-page #f) + (license license:public-domain)))) + '(#:entry-point "bin/guile" + #:localstatedir? #t + #:extra-options (#:image-tag "guile-guest") + #:symlinks (("/bin/Guile" -> "bin/guile") + ("aa.scm" -> "a.scm"))) + "guile-guest" + (%current-target-system) + (%current-system) + #f)) + +(define (run-rootless-podman-test) (define os (marionette-operating-system (operating-system-with-gc-roots %rootless-podman-os - (list oci-tarball)) + (list %oci-tarball)) #:imported-modules '((gnu services herd) (guix combinators)))) @@ -254,7 +288,7 @@ (define (run-rootless-podman-test oci-tarball) (let* ((loaded (slurp ,(string-append #$podman "/bin/podman") "load" "-i" - ,#$oci-tarball)) + ,#$%oci-tarball)) (repository&tag "localhost/guile-guest:latest") (response1 (slurp ,(string-append #$podman "/bin/podman") @@ -307,49 +341,11 @@ (define (run-rootless-podman-test oci-tarball) (gexp->derivation "rootless-podman-test" test)) -(define (build-tarball&run-rootless-podman-test) - (mlet* %store-monad - ((_ (set-grafting #f)) - (guile (set-guile-for-build (default-guile))) - (guest-script-package -> - (package - (name "guest-script") - (version "0") - (source #f) - (build-system trivial-build-system) - (arguments `(#:guile ,guile-3.0 - #:builder - (let ((out (assoc-ref %outputs "out"))) - (mkdir out) - (call-with-output-file (string-append out "/a.scm") - (lambda (port) - (display "(display \"hello world\n\")" port))) - #t))) - (synopsis "Display hello world using Guile") - (description "This package displays the text \"hello world\" on the -standard output device and then enters a new line.") - (home-page #f) - (license license:public-domain))) - (profile (profile-derivation (packages->manifest - (list guile-3.0 guile-json-3 - guest-script-package)) - #:hooks '() - #:locales? #f)) - (tarball (pack:docker-image - "docker-pack" profile - #:symlinks '(("/bin/Guile" -> "bin/guile") - ("aa.scm" -> "a.scm")) - #:extra-options - '(#:image-tag "guile-guest") - #:entry-point "bin/guile" - #:localstatedir? #t))) - (run-rootless-podman-test tarball))) - (define %test-rootless-podman (system-test (name "rootless-podman") (description "Test rootless Podman service.") - (value (build-tarball&run-rootless-podman-test)))) + (value (run-rootless-podman-test)))) (define %oci-rootless-podman-os diff --git a/gnu/tests/docker.scm b/gnu/tests/docker.scm index 5dcf05a17e3..07edd9d5341 100644 --- a/gnu/tests/docker.scm +++ b/gnu/tests/docker.scm @@ -26,6 +26,7 @@ (define-module (gnu tests docker) #:use-module (gnu system image) #:use-module (gnu system vm) #:use-module (gnu services) + #:use-module (gnu services containers) #:use-module (gnu services dbus) #:use-module (gnu services networking) #:use-module (gnu services docker) @@ -57,6 +58,40 @@ (define %docker-os (service containerd-service-type) (service docker-service-type))) +(define %docker-tarball + (lower-oci-image-state + "guile-guest" + (packages->manifest + (list + guile-3.0 guile-json-3 + (package + (name "guest-script") + (version "0") + (source #f) + (build-system trivial-build-system) + (arguments `(#:guile ,guile-3.0 + #:builder + (let ((out (assoc-ref %outputs "out"))) + (mkdir out) + (call-with-output-file (string-append out "/a.scm") + (lambda (port) + (display "(display \"hello world\n\")" port))) + #t))) + (synopsis "Display hello world using Guile") + (description "This package displays the text \"hello world\" on the +standard output device and then enters a new line.") + (home-page #f) + (license license:public-domain)))) + '(#:entry-point "bin/guile" + #:localstatedir? #t + #:extra-options (#:image-tag "guile-guest") + #:symlinks (("/bin/Guile" -> "bin/guile") + ("aa.scm" -> "a.scm"))) + "guile-guest" + (%current-target-system) + (%current-system) + #f)) + (define (run-docker-test docker-tarball) "Load DOCKER-TARBALL as Docker image and run it in a Docker container, inside %DOCKER-OS." @@ -173,40 +208,7 @@ (define (run-docker-test docker-tarball) (gexp->derivation "docker-test" test)) (define (build-tarball&run-docker-test) - (mlet* %store-monad - ((_ (set-grafting #f)) - (guile (set-guile-for-build (default-guile))) - (guest-script-package -> - (package - (name "guest-script") - (version "0") - (source #f) - (build-system trivial-build-system) - (arguments `(#:guile ,guile-3.0 - #:builder - (let ((out (assoc-ref %outputs "out"))) - (mkdir out) - (call-with-output-file (string-append out "/a.scm") - (lambda (port) - (display "(display \"hello world\n\")" port))) - #t))) - (synopsis "Display hello world using Guile") - (description "This package displays the text \"hello world\" on the -standard output device and then enters a new line.") - (home-page #f) - (license license:public-domain))) - (profile (profile-derivation (packages->manifest - (list guile-3.0 guile-json-3 - guest-script-package)) - #:hooks '() - #:locales? #f)) - (tarball (pack:docker-image - "docker-pack" profile - #:symlinks '(("/bin/Guile" -> "bin/guile") - ("aa.scm" -> "a.scm")) - #:entry-point "bin/guile" - #:localstatedir? #t))) - (run-docker-test tarball))) + (run-docker-test %docker-tarball)) (define %test-docker (system-test @@ -215,8 +217,22 @@ (define %test-docker (value (build-tarball&run-docker-test)))) +(define %docker-system-tarball + (lower-oci-image-state + "guix-system-guest" + (operating-system + (inherit (simple-operating-system)) + ;; Use locales for a single libc to + ;; reduce space requirements. + (locale-libcs (list glibc))) + '() + "guix-system-guest" + (%current-target-system) + (%current-system) + #f)) + (define (run-docker-system-test tarball) - "Load DOCKER-TARBALL as Docker image and run it in a Docker container, + "Load TARBALL as Docker image and run it in a Docker container, inside %DOCKER-OS." (define os (marionette-operating-system @@ -333,21 +349,15 @@ (define (run-docker-system-test tarball) (gexp->derivation "docker-system-test" test)) +(define (build-tarball&run-docker-system-test) + (run-docker-system-test %docker-system-tarball)) + (define %test-docker-system (system-test (name "docker-system") (description "Run a system image as produced by @command{guix system docker-image} inside Docker.") - (value (with-monad %store-monad - (>>= (lower-object - (system-image (os->image - (operating-system - (inherit (simple-operating-system)) - ;; Use locales for a single libc to - ;; reduce space requirements. - (locale-libcs (list glibc))) - #:type docker-image-type))) - run-docker-system-test))))) + (value (build-tarball&run-docker-system-test)))) (define %oci-os -- 2.48.1 From unknown Fri Jun 13 11:55:10 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#76081] [PATCH v9 1/7] services: rootless-podman: Use login shell. References: <2f43e635-508c-407a-8309-06e75d492d89@autistici.org> In-Reply-To: <2f43e635-508c-407a-8309-06e75d492d89@autistici.org> Resent-From: Giacomo Leidi Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Tue, 18 Mar 2025 17:53:11 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 76081 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 76081@debbugs.gnu.org Cc: Giacomo Leidi Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.174232035029751 (code B ref 76081); Tue, 18 Mar 2025 17:53:11 +0000 Received: (at 76081) by debbugs.gnu.org; 18 Mar 2025 17:52:30 +0000 Received: from localhost ([127.0.0.1]:43082 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tub77-0007jl-G7 for submit@debbugs.gnu.org; Tue, 18 Mar 2025 13:52:30 -0400 Received: from confino.investici.org ([93.190.126.19]:36385) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1tub6D-0007cH-5k for 76081@debbugs.gnu.org; Tue, 18 Mar 2025 13:51:33 -0400 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org; s=stigmate; t=1742320289; bh=8gJyOKA+4fXouDtzt4hPNvCopbTmW/qpZs43sizr4d0=; h=From:To:Cc:Subject:Date:From; b=iEGeEnJ+XMxTjmr2KtCcmjGDmVMTHxWqhT/+BudnHatnlW4JHj1pA0/ilGXOHWEh+ Q+L9mgZgA1EPLi28+4KrxGpzUlBwugvwbuEQaSDoAnSvGB8MTuoVOUj+GVBgwt9rxi BdcMpcGo2/nvDiBuHgHi1t+/VPBnthz68jAHx/M4= Received: from mx1.investici.org (unknown [127.0.0.1]) by confino.investici.org (Postfix) with ESMTP id 4ZHKCP5HLhz11cn; Tue, 18 Mar 2025 17:51:29 +0000 (UTC) Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19]) (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with ESMTPSA id 4ZHKCP4C66z11cm; Tue, 18 Mar 2025 17:51:29 +0000 (UTC) From: Giacomo Leidi Date: Tue, 18 Mar 2025 18:51:06 +0100 Message-ID: <15af7d63ead9dfad272154c09bdfda718da1047c.1742320272.git.goodoldpaul@autistici.org> X-Mailer: git-send-email 2.48.1 MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Spam-Score: -0.7 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.7 (-) This commit allows for having PATH set when changing the owner of /sys/fs/group. * gnu/services/containers.scm (crgroups-fs-owner): Use login shell. Change-Id: I9510c637a5332325e05ca5ebc9dfd4de32685c50 --- gnu/services/containers.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm index b3cd109ce6c..d5a211765a6 100644 --- a/gnu/services/containers.scm +++ b/gnu/services/containers.scm @@ -140,7 +140,7 @@ (define (cgroups-fs-owner-entrypoint config) (rootless-podman-configuration-group-name config)) (program-file "cgroups2-fs-owner-entrypoint" #~(system* - (string-append #+bash-minimal "/bin/bash") "-c" + (string-append #+bash-minimal "/bin/bash") "-l" "-c" (string-append "echo Setting /sys/fs/cgroup " "group ownership to " #$group " && chown -v " "root:" #$group " /sys/fs/cgroup && " base-commit: 9879a7d75279762c7634f1a585794442ea2f0503 -- 2.48.1 From unknown Fri Jun 13 11:55:10 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#76081] [PATCH v9 2/7] services: oci-container-configuration: Move to (gnu services containers). Resent-From: Giacomo Leidi Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Tue, 18 Mar 2025 17:53:12 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 76081 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 76081@debbugs.gnu.org Cc: Giacomo Leidi Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.174232035429783 (code B ref 76081); Tue, 18 Mar 2025 17:53:12 +0000 Received: (at 76081) by debbugs.gnu.org; 18 Mar 2025 17:52:34 +0000 Received: from localhost ([127.0.0.1]:43084 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tub78-0007jo-7U for submit@debbugs.gnu.org; Tue, 18 Mar 2025 13:52:33 -0400 Received: from confino.investici.org ([93.190.126.19]:44949) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1tub6D-0007cL-CG for 76081@debbugs.gnu.org; Tue, 18 Mar 2025 13:51:36 -0400 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org; s=stigmate; t=1742320290; bh=bWiorRi+IXwRYJjyNsYQ0mrdmTXS3QuGkZwZmxfXCB8=; h=From:To:Cc:Subject:Date:In-Reply-To:References:From; b=j1mzjNTbjOSrDN1xZM4frZdthoyflVNntMvXNa6My1YvYT5k+FEm2DDCB+uykhYIb posXVB3dlFQf3qOvdj/xLFeNsGtfqnl4YZXCV0djRqXjJTLR2SYyvzTRj5ML/VlKsl fPQCo3Ei2SIo4Zulvr85Ab0gy8iJdQVrOcD5C054= Received: from mx1.investici.org (unknown [127.0.0.1]) by confino.investici.org (Postfix) with ESMTP id 4ZHKCQ1C7tz11d3; Tue, 18 Mar 2025 17:51:30 +0000 (UTC) Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19]) (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with ESMTPSA id 4ZHKCP6xp6z11cm; Tue, 18 Mar 2025 17:51:29 +0000 (UTC) From: Giacomo Leidi Date: Tue, 18 Mar 2025 18:51:07 +0100 Message-ID: X-Mailer: git-send-email 2.48.1 In-Reply-To: <15af7d63ead9dfad272154c09bdfda718da1047c.1742320272.git.goodoldpaul@autistici.org> References: <15af7d63ead9dfad272154c09bdfda718da1047c.1742320272.git.goodoldpaul@autistici.org> MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit X-Spam-Score: -0.7 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.7 (-) 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. Change-Id: Iae599dd5cc7442eb632f0c1b3b12f6b928397ae7 --- gnu/services/containers.scm | 549 +++++++++++++++++++++++++++++++++- gnu/services/docker.scm | 577 +++--------------------------------- 2 files changed, 584 insertions(+), 542 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 +;;; Copyright © 2024, 2025 Giacomo Leidi ;;; ;;; This file is part of GNU Guix. ;;; @@ -17,19 +17,31 @@ ;;; along with GNU Guix. If not, see . (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 ;;; Copyright © 2020 Jesse Dowell ;;; Copyright © 2021 Brice Waegeneire -;;; Copyright © 2023, 2024 Giacomo Leidi +;;; Copyright © 2023, 2024, 2025 Giacomo Leidi ;;; ;;; This file is part of GNU Guix. ;;; @@ -23,72 +23,60 @@ ;;; along with GNU Guix. If not, see . (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)) -- 2.48.1 From unknown Fri Jun 13 11:55:10 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#76081] [PATCH v9 7/7] home: Add home-oci-service-type. Resent-From: Giacomo Leidi Original-Sender: "Debbugs-submit" Resent-CC: andrew@trop.in, janneke@gnu.org, ludo@gnu.org, maxim.cournoyer@gmail.com, tanguy@bioneland.org, guix-patches@gnu.org Resent-Date: Tue, 18 Mar 2025 17:53:12 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 76081 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 76081@debbugs.gnu.org Cc: Giacomo Leidi , Andrew Tropin , Janneke Nieuwenhuizen , Ludovic =?UTF-8?Q?Court=C3=A8s?= , Maxim Cournoyer , Tanguy Le Carrour X-Debbugs-Original-Xcc: Andrew Tropin , Janneke Nieuwenhuizen , Ludovic =?UTF-8?Q?Court=C3=A8s?= , Maxim Cournoyer , Tanguy Le Carrour Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.174232035729824 (code B ref 76081); Tue, 18 Mar 2025 17:53:12 +0000 Received: (at 76081) by debbugs.gnu.org; 18 Mar 2025 17:52:37 +0000 Received: from localhost ([127.0.0.1]:43086 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tub7B-0007kJ-Ok for submit@debbugs.gnu.org; Tue, 18 Mar 2025 13:52:36 -0400 Received: from confino.investici.org ([93.190.126.19]:62429) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1tub6F-0007cm-N7 for 76081@debbugs.gnu.org; Tue, 18 Mar 2025 13:51:37 -0400 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org; s=stigmate; t=1742320294; bh=YIWVLEeDQajQFrSs7DsdCZ73N1HG9vBfN0Oi1S3Sg9o=; h=From:To:Cc:Subject:Date:In-Reply-To:References:From; b=Gb+khoiLm6q38CJBazFIE1Z+W08VeR32hYqXG6IJkITz8sFlBsaG1XTaeuB+2Kez6 L3QvBDmrCwjtrfFr2XsS6jH+iuDbWkTP195/LTwFjaFwaP8oY/8nbMy0glbgr6z9/g BGYINanT35Jb6dAHuXypUGZYYvm1BJPqWwm69MFc= Received: from mx1.investici.org (unknown [127.0.0.1]) by confino.investici.org (Postfix) with ESMTP id 4ZHKCV61t1z11d4; Tue, 18 Mar 2025 17:51:34 +0000 (UTC) Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19]) (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with ESMTPSA id 4ZHKCV50PTz11cm; Tue, 18 Mar 2025 17:51:34 +0000 (UTC) From: Giacomo Leidi Date: Tue, 18 Mar 2025 18:51:12 +0100 Message-ID: <43bf916116776f60f35cfbce848540c43607c589.1742320272.git.goodoldpaul@autistici.org> X-Mailer: git-send-email 2.48.1 In-Reply-To: <15af7d63ead9dfad272154c09bdfda718da1047c.1742320272.git.goodoldpaul@autistici.org> References: <15af7d63ead9dfad272154c09bdfda718da1047c.1742320272.git.goodoldpaul@autistici.org> MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit X-Spam-Score: -0.7 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.7 (-) * gnu/home/service/containers.scm: New file; * gnu/local.mk (GNU_SYSTEM_MODULES): Add it. * doc/guix.texi (OCI backed services): Document it. Change-Id: I8ce5b301e8032d0a7b2a9ca46752738cdee1f030 --- doc/guix.texi | 114 +++++++++++++++++++++++++++++++ gnu/home/services/containers.scm | 50 ++++++++++++++ gnu/local.mk | 1 + 3 files changed, 165 insertions(+) create mode 100644 gnu/home/services/containers.scm diff --git a/doc/guix.texi b/doc/guix.texi index 521ea28dd5a..8f3017c2f69 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -50478,6 +50478,120 @@ Miscellaneous Home Services (dicod-configuration @dots{}))) @end lisp +@subsubheading OCI backed services + +@cindex OCI-backed, for Home +The @code{(gnu home services containers)} module provides the following service: + +@defvar home-oci-service-type +This is the type of the service that allows to manage your OCI containers with +the same consistent interface you use for your other Home Shepherd services. +@end defvar + +This service is a direct mapping of the @code{oci-service-type} system +service (@pxref{Miscellaneous Services, OCI backed services}). You can +use it like this: + +@lisp +(use-modules (gnu services containers) + (gnu home services containers)) + +(simple-service 'home-oci-provisioning + home-oci-service-type + (oci-extension + (volumes + (list + (oci-volume-configuration (name "prometheus")) + (oci-volume-configuration (name "grafana")))) + (networks + (list + (oci-network-configuration (name "monitoring")))) + (containers + (list + (oci-container-configuration + (network "monitoring") + (image + (oci-image + (repository "guile") + (tag "3") + (value (specifications->manifest '("guile"))) + (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile")) + #:max-layers 2)))) + (entrypoint "/bin/guile") + (command + '("-c" "(display \"hello!\n\")"))) + (oci-container-configuration + (image "prom/prometheus") + (network "monitoring") + (ports + '(("9000" . "9000") + ("9090" . "9090"))) + (volumes + (list + '(("prometheus" . "/var/lib/prometheus"))))) + (oci-container-configuration + (image "grafana/grafana:10.0.1") + (network "monitoring") + (volumes + '(("grafana:/var/lib/grafana")))))))) + +@end lisp + +You may specify a custom configuration by providing a +@code{oci-configuration} record, exactly like for +@code{oci-service-type}, but wrapping it in @code{for-home}: + +@lisp +(use-modules (gnu services) + (gnu services containers) + (gnu home services containers)) + +(service home-oci-service-type + (for-home + (oci-configuration + (runtime 'podman) + (verbose? #t)))) + +(simple-service 'home-oci-provisioning + home-oci-service-type + (oci-extension + (volumes + (list + (oci-volume-configuration (name "prometheus")) + (oci-volume-configuration (name "grafana")))) + (networks + (list + (oci-network-configuration (name "monitoring")))) + (containers + (list + (oci-container-configuration + (network "monitoring") + (image + (oci-image + (repository "guile") + (tag "3") + (value (specifications->manifest '("guile"))) + (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile")) + #:max-layers 2)))) + (entrypoint "/bin/guile") + (command + '("-c" "(display \"hello!\n\")"))) + (oci-container-configuration + (image "prom/prometheus") + (network "monitoring") + (ports + '(("9000" . "9000") + ("9090" . "9090"))) + (volumes + (list + '(("prometheus" . "/var/lib/prometheus"))))) + (oci-container-configuration + (image "grafana/grafana:10.0.1") + (network "monitoring") + (volumes + '(("grafana:/var/lib/grafana")))))))) +@end lisp + @node Invoking guix home @section Invoking @command{guix home} diff --git a/gnu/home/services/containers.scm b/gnu/home/services/containers.scm new file mode 100644 index 00000000000..938dde2f37a --- /dev/null +++ b/gnu/home/services/containers.scm @@ -0,0 +1,50 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2025 Giacomo Leidi +;;; +;;; 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 . + +(define-module (gnu home services containers) + #:use-module (gnu home services) + #:use-module (gnu home services shepherd) + #:use-module (gnu services) + #:use-module (gnu services configuration) + #:use-module (gnu services containers) + #:use-module (guix gexp) + #:use-module (guix packages) + #:use-module (srfi srfi-1) + #:export (home-oci-service-type)) + +(define home-oci-service-type + (service-type (inherit (system->home-service-type oci-service-type)) + (extensions + (list + (service-extension home-profile-service-type + (oci-service-extension-wrap-validate + (lambda (config) + (let ((runtime-cli + (oci-configuration-runtime-cli config)) + (runtime + (oci-configuration-runtime config))) + (oci-service-profile runtime runtime-cli))))) + (service-extension home-shepherd-service-type + (oci-service-extension-wrap-validate + oci-configuration->shepherd-services)))) + (extend + (lambda (config extension) + (for-home + (oci-configuration + (inherit (oci-configuration-extend config extension)))))) + (default-value (for-home (oci-configuration))))) diff --git a/gnu/local.mk b/gnu/local.mk index 01d13a11ae8..0f6502d979b 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -103,6 +103,7 @@ GNU_SYSTEM_MODULES = \ %D%/home.scm \ %D%/home/services.scm \ %D%/home/services/admin.scm \ + %D%/home/services/containers.scm \ %D%/home/services/desktop.scm \ %D%/home/services/dict.scm \ %D%/home/services/dotfiles.scm \ -- 2.48.1 From unknown Fri Jun 13 11:55:10 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#76081] [PATCH v9 6/7] services: oci: Migrate oci-configuration to (guix records). Resent-From: Giacomo Leidi Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Tue, 18 Mar 2025 17:53:13 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 76081 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 76081@debbugs.gnu.org Cc: Giacomo Leidi Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.174232036029850 (code B ref 76081); Tue, 18 Mar 2025 17:53:13 +0000 Received: (at 76081) by debbugs.gnu.org; 18 Mar 2025 17:52:40 +0000 Received: from localhost ([127.0.0.1]:43088 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tub7F-0007ky-0F for submit@debbugs.gnu.org; Tue, 18 Mar 2025 13:52:39 -0400 Received: from confino.investici.org ([2a11:7980:1::2:0]:44921) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1tub6F-0007cf-KK for 76081@debbugs.gnu.org; Tue, 18 Mar 2025 13:51:37 -0400 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org; s=stigmate; t=1742320294; bh=D1NpWLth5uLaBEsr3PkyNDiQ76GkGhDklVUyzpvsoVQ=; h=From:To:Cc:Subject:Date:In-Reply-To:References:From; b=njfjEa5vbZwvHiOxIhv3spuEiEnDS5RUU3pwjXy+f+6VJcjlUsIqAscH3pFfvJq3O oCcKWFFLIwJpnZdUBW1QqiLiktRr44oBKQVgvZFy67VlDz+DDbcPCSN9jPDJam/mZw wDpzUe8dxAy8qiyBjICWTvR43aOCUDgkXv1fr4rQ= Received: from mx1.investici.org (unknown [127.0.0.1]) by confino.investici.org (Postfix) with ESMTP id 4ZHKCV3Cn5z11dw; Tue, 18 Mar 2025 17:51:34 +0000 (UTC) Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19]) (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with ESMTPSA id 4ZHKCV1vynz11cm; Tue, 18 Mar 2025 17:51:34 +0000 (UTC) From: Giacomo Leidi Date: Tue, 18 Mar 2025 18:51:11 +0100 Message-ID: X-Mailer: git-send-email 2.48.1 In-Reply-To: <15af7d63ead9dfad272154c09bdfda718da1047c.1742320272.git.goodoldpaul@autistici.org> References: <15af7d63ead9dfad272154c09bdfda718da1047c.1742320272.git.goodoldpaul@autistici.org> MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Spam-Score: -0.0 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) This commit migrates oci-configuration to (guix records) singe it appears (for-home (oci-configuration ...)) does not work as expected with (gnu services configuration). This is supposed to be completely transparent for users and can be reverted in the future once this has been implemented. * gnu/service/containers.scm: Migrate oci-configuration to (guix records). --- gnu/services/containers.scm | 199 +++++++++++++++++++++--------------- 1 file changed, 117 insertions(+), 82 deletions(-) diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm index 5dac8e80f22..7a44e1c0f7c 100644 --- a/gnu/services/containers.scm +++ b/gnu/services/containers.scm @@ -39,6 +39,7 @@ (define-module (gnu services containers) #:use-module (guix packages) #:use-module (guix profiles) #:use-module ((guix scripts pack) #:prefix pack:) + #:use-module (guix records) #:use-module (guix store) #:use-module (srfi srfi-1) #:use-module (ice-9 format) @@ -164,6 +165,7 @@ (define-module (gnu services containers) oci-container-shepherd-service oci-objects-merge-lst oci-extension-merge + oci-service-extension-wrap-validate oci-service-type oci-service-accounts oci-service-profile @@ -391,7 +393,7 @@ (define (oci-runtime-name runtime) (define (oci-runtime-group runtime maybe-group) "Implement the logic behind selection of the group that is to be used by Shepherd to execute OCI commands." - (if (not (maybe-value-set? maybe-group)) + (if (eq? maybe-group #f) (if (eq? 'podman runtime) "cgroup" "docker") @@ -762,62 +764,74 @@ (define (list-of-oci-networks? value) (define (package-or-string? value) (or (package? value) (string? value))) -(define-maybe/no-serialization package-or-string) - -(define-configuration/no-serialization oci-configuration - (runtime - (symbol 'docker) - "The OCI runtime to use to run commands. It can be either @code{'docker} or -@code{'podman}." - (sanitizer oci-sanitize-runtime)) - (runtime-cli - (maybe-package-or-string) - "The OCI runtime command line to be installed in the system profile and used -to provision OCI resources, it can be either a package or a string representing -an absolute path to the runtime binary entrypoint. When unset it will default -to @code{docker-cli} package for the @code{'docker} runtime or to @code{podman} -package for the @code{'podman} runtime.") - (runtime-extra-arguments - (list '()) - "A list of strings, gexps or file-like objects that will be placed -after each @command{docker} or @command{podman} invokation.") - (user - (string "oci-container") - "The user name under whose authority OCI runtime commands will be run.") - (group - (maybe-string) - "The group name under whose authority OCI commands will be run. When -using the @code{'podman} OCI runtime, this field will be ignored and the -default group of the user configured in the @code{user} field will be used.") - (subuids-range - (maybe-subid-range) - "An optional @code{subid-range} record allocating subuids for the user from -the @code{user} field. When unset, with the rootless Podman OCI runtime, it -defaults to @code{(subid-range (name \"oci-container\"))}.") - (subgids-range - (maybe-subid-range) - "An optional @code{subid-range} record allocating subgids for the user from -the @code{user} field. When unset, with the rootless Podman OCI runtime, it -defaults to @code{(subid-range (name \"oci-container\"))}.") - (containers - (list-of-oci-containers '()) - "The list of @code{oci-container-configuration} records representing the -containers to provision. Most users are supposed not to use this field and use -the @code{oci-extension} record instead.") - (networks - (list-of-oci-networks '()) - "The list of @code{oci-network-configuration} records representing the -networks to provision. Most users are supposed not to use this field and use -the @code{oci-extension} record instead.") - (volumes - (list-of-oci-volumes '()) - "The list of @code{oci-volume-configuration} records representing the -volumes to provision. Most users are supposed not to use this field and use -the @code{oci-extension} record instead.") - (verbose? - (boolean #f) - "When true, additional output will be printed, allowing to better follow the -flow of execution.")) +;; (for-home (oci-configuration ...)) is not able to replace for-home? with #t, +;; pk prints #f. Once for-home will be able to work with (gnu services configuration) the +;; record can be migrated back to define-configuration. +(define-record-type* + oci-configuration + make-oci-configuration + oci-configuration? + this-oci-configuration + + (runtime oci-configuration-runtime + (default 'docker)) + (runtime-cli oci-configuration-runtime-cli + (default #f)) ; package or string + (runtime-extra-arguments oci-configuration-runtime-extra-arguments ; strings or gexps + (default '())) ; or file-like objects + (user oci-configuration-user + (default "oci-container")) + (group oci-configuration-group ; string + (default #f)) + (subuids-range oci-configuration-subuids-range ; subid-range + (default #f)) + (subgids-range oci-configuration-subgids-range ; subid-range + (default #f)) + (containers oci-configuration-containers ; oci-container-configurations + (default '())) + (networks oci-configuration-networks ; oci-network-configurations + (default '())) + (volumes oci-configuration-volumes ; oci-volume-configurations + (default '())) + (verbose? oci-configuration-verbose? + (default #f)) + (home-service? oci-configuration-home-service? + (default for-home?) (innate))) + +;; TODO: This procedure can be dropped once we switch to define-configuration for +;; oci-configuration. +(define (oci-configuration-valid? config) + (define runtime-cli + (oci-configuration-runtime-cli config)) + (define group + (oci-configuration-group config)) + (define subuids-range + (oci-configuration-subuids-range config)) + (define subgids-range + (oci-configuration-subgids-range config)) + (and + (symbol? + (oci-sanitize-runtime (oci-configuration-runtime config))) + (or (eq? runtime-cli #f) + (package-or-string? runtime-cli)) + (list? (oci-configuration-runtime-extra-arguments config)) + (string? (oci-configuration-user config)) + (or (eq? group #f) + (string? group)) + (or (eq? subuids-range #f) + (subid-range? subuids-range)) + (or (eq? subgids-range #f) + (subid-range? subgids-range)) + (list-of-oci-containers? + (oci-configuration-containers config)) + (list-of-oci-networks? + (oci-configuration-networks config)) + (list-of-oci-volumes? + (oci-configuration-volumes config)) + (boolean? + (oci-configuration-verbose? config)) + (boolean? + (oci-configuration-home-service? config)))) (define (oci-runtime-system-environment runtime user) (if (eq? runtime 'podman) @@ -833,7 +847,7 @@ (define (oci-runtime-cli runtime runtime-cli path) ;; It is a user defined absolute path runtime-cli #~(string-append - #$(if (not (maybe-value-set? runtime-cli)) + #$(if (eq? runtime-cli #f) path runtime-cli) #$(if (eq? 'podman runtime) @@ -1577,18 +1591,27 @@ (define (oci-configuration->shepherd-services config) (passwd:gid (getpwnam #$user)))) (oci-runtime-group config (oci-configuration-group config)))) - (verbose? (oci-configuration-verbose? config))) - (oci-state->shepherd-services runtime system-runtime-cli containers networks volumes - #:user user - #:group group - #:verbose? verbose? - #:runtime-extra-arguments - runtime-extra-arguments - #:runtime-environment - (oci-runtime-system-environment runtime user) - #:runtime-requirement - (oci-runtime-system-requirement runtime) - #:networks-requirement '(networking)))) + (verbose? (oci-configuration-verbose? config)) + (home-service? + (oci-configuration-home-service? config))) + (if home-service? + (oci-state->shepherd-services runtime home-runtime-cli containers networks volumes + #:verbose? verbose? + #:networks-name + (oci-networks-home-shepherd-name runtime) + #:volumes-name + (oci-volumes-home-shepherd-name runtime)) + (oci-state->shepherd-services runtime system-runtime-cli containers networks volumes + #:user user + #:group group + #:verbose? verbose? + #:runtime-extra-arguments + runtime-extra-arguments + #:runtime-environment + (oci-runtime-system-environment runtime user) + #:runtime-requirement + (oci-runtime-system-requirement runtime) + #:networks-requirement '(networking))))) (define (oci-service-subids config) "Return a subids-extension record representing subuids and subgids required by @@ -1616,14 +1639,14 @@ (define (oci-service-subids config) (define subgid-ranges (delete-duplicate-ranges (cons - (if (not (maybe-value-set? subgids)) + (if (eq? subgids #f) (subid-range (name user)) subgids) container-users))) (define subuid-ranges (delete-duplicate-ranges (cons - (if (not (maybe-value-set? subuids)) + (if (eq? subuids #f) (subid-range (name user)) subuids) container-users))) @@ -1682,13 +1705,21 @@ (define (oci-service-profile runtime runtime-cli) '() (list (cond - ((maybe-value-set? runtime-cli) + ((not (eq? runtime-cli #f)) runtime-cli) ((eq? 'podman runtime) podman) (else docker-cli)))))) +(define (oci-service-extension-wrap-validate extension) + (lambda (config) + (if (oci-configuration-valid? config) + (extension config) + (raise + (formatted-message + (G_ "Invalide oci-configuration ~a.") config))))) + (define (oci-configuration-extend config extension) (oci-configuration (inherit config) @@ -1717,18 +1748,22 @@ (define oci-service-type (extensions (list (service-extension profile-service-type - (lambda (config) - (let ((runtime-cli - (oci-configuration-runtime-cli config)) - (runtime - (oci-configuration-runtime config))) - (oci-service-profile runtime runtime-cli)))) + (oci-service-extension-wrap-validate + (lambda (config) + (let ((runtime-cli + (oci-configuration-runtime-cli config)) + (runtime + (oci-configuration-runtime config))) + (oci-service-profile runtime runtime-cli))))) (service-extension subids-service-type - oci-service-subids) + (oci-service-extension-wrap-validate + oci-service-subids)) (service-extension account-service-type - oci-service-accounts) + (oci-service-extension-wrap-validate + oci-service-accounts)) (service-extension shepherd-root-service-type - oci-configuration->shepherd-services))) + (oci-service-extension-wrap-validate + oci-configuration->shepherd-services)))) ;; Concatenate OCI object lists. (compose (lambda (args) (fold oci-extension-merge -- 2.48.1 From unknown Fri Jun 13 11:55:10 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#76081] OCI provisioning service Resent-From: paul Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Mon, 05 May 2025 07:55:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 76081 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 76081@debbugs.gnu.org Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.174643170131737 (code B ref 76081); Mon, 05 May 2025 07:55:02 +0000 Received: (at 76081) by debbugs.gnu.org; 5 May 2025 07:55:01 +0000 Received: from localhost ([127.0.0.1]:38258 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1uBqfF-0008Ff-5M for submit@debbugs.gnu.org; Mon, 05 May 2025 03:55:01 -0400 Received: from confino.investici.org ([2a11:7980:1::2:0]:56059) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1uBqf8-0008FH-17 for 76081@debbugs.gnu.org; Mon, 05 May 2025 03:54:58 -0400 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org; s=stigmate; t=1746431690; bh=3FlANTOrBjQfXl5z8SzCQ6RzJRlnKGxoLHpZ4vGZNJU=; h=Date:Subject:From:To:References:In-Reply-To:From; b=AGdKTXrMKoPHdul0IiOC7fOK9bK6n5ndwKdhLUAKMlIBQvzAXM7GCI3uaMlBu0kOW 6HTo+elam5FEOWP0AADaBwnOPO1/PhQuLBQvWKM5z83f6NUvbusdupApZcKfxFmS9W XHvu7YzTsRAbWkQkTHHCFMkLKSfkxhXBJ6M1Ces8= Received: from mx1.investici.org (unknown [127.0.0.1]) by confino.investici.org (Postfix) with ESMTP id 4ZrYhp5Hhfz1193 for <76081@debbugs.gnu.org>; Mon, 5 May 2025 07:54:50 +0000 (UTC) Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19]) (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with ESMTPSA id 4ZrYhp4f7qz1158 for <76081@debbugs.gnu.org>; Mon, 5 May 2025 07:54:50 +0000 (UTC) Message-ID: <06196cdd-ac29-4a03-b09c-98aed5f85a39@autistici.org> Date: Mon, 5 May 2025 09:54:49 +0200 MIME-Version: 1.0 User-Agent: Icedove Daily From: paul References: <274b98ea-1af9-4f0f-af58-8fa755feb73b@autistici.org> <397afc1f-b638-430a-b9e7-7de4721bca45@autistici.org> <020bb939-819c-4de3-bc04-ef0f33855c90@autistici.org> Content-Language: en-US In-Reply-To: <020bb939-819c-4de3-bc04-ef0f33855c90@autistici.org> Content-Type: text/plain; charset=UTF-8; format=flowed Content-Transfer-Encoding: 8bit X-Spam-Score: -0.0 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) Hi, On 3/18/25 18:50, paul wrote: > Hi, > > On 3/9/25 01:27, paul wrote: >> Hi, >> >> On 3/4/25 13:39, paul wrote: >>> Hi, >>> >>> On 2/27/25 00:01, paul wrote: >>>> Hi guix, >>>> >>>> On 2/18/25 02:20, paul wrote: >>>>> Hi, >>>>> >>>>> On 2/12/25 02:09, paul wrote: >>>>>> Hi guix, >>>>>> >>>>>> On 2/9/25 21:38, paul wrote: >>>>>>> I'm sending a v3 fixing a bug in the merge algorithm for volumes >>>>>>> and networks. >>>>>>> >>>>>>> On 2/9/25 20:14, paul wrote: >>>>>>>> Hi, >>>>>>>> >>>>>>>> I'm about to send a v2. v2 compared to the first revision >>>>>>>> features: >>>>>>>> >>>>>>>> >>>>>>>> - it actually compiles all the times :) (rev 1 referenced >>>>>>>> oci-image too early for it to be working and generated a >>>>>>>> compile time error, if you recompiled it sometimes went away so >>>>>>>> I thought it was a problem of my setup. CI caught this) >>>>>>>> - it allows more values to be overridden by eventual users of >>>>>>>> the Scheme API >>>>>>>> - it allows passing extra arguments directly after each podman >>>>>>>> or docker invokation, allowing for example for overriding >>>>>>>> podman --root and similar options. >>>>>>>> >>>>>>>> All of these tests should pass: >>>>>>>> >>>>>>>> guix shell -D guix -CPW -- make check-system >>>>>>>> TESTS="oci-container oci-service-rootless-podman docker >>>>>>>> docker-system rootless-podman oci-service-docker" >>>>>>>> >>>>>> I'm sending a v4 changing slightly the image loader, the same >>>>>> tests as before are supposed to pass. Now the Home service [0] is >>>>>> working for me with rootless podman. I'll try it on different >>>>>> distros if I manage to. >>>>> >>>>> I'm sending a v5 implementing a Home service. The changes compared >>>>> to v4 are pretty trivial as the plumbing was already there, the >>>>> only downside is that I'm not able to use for-home? in >>>>> define-configuration, so I had to reimplement oci-configuration >>>>> with (guix records) and had to reimplement some validation (gnu >>>>> services configuration) would figure out magically. >>>> >>>> I'm sending  a v6. Compared to v5 it resolves the conflicts with >>>> master and it should fix the stop action for rootless podman backed >>>> services. >>> >>> I'm sending a v7 fixing the restart action for podman backed services. >> >> I'm sending a v8 fixing some further bugs wrt to the start and stop >> of podman backed services. > > In the hope of making the review easier, I'm sending a v9 that is > completely the same of v8 in terms of changes but with smaller > commits. Hopefully this makes it easier to review changes, please let > me know if I can do anything to ease the workload for reviewers of > this patch set. I'm sending a v10 rebased on current master. The only difference with v9 is that this revision exports the oci-{container,network,volume}-configuration->options procedures , that can be useful when writing services that extend the oci-service-type. cheers, giacomo From unknown Fri Jun 13 11:55:10 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#76081] [PATCH v10 4/7] services: Add oci-service-type. Resent-From: Giacomo Leidi Original-Sender: "Debbugs-submit" Resent-CC: gabriel@erlikon.ch, ludo@gnu.org, maxim.cournoyer@gmail.com, guix-patches@gnu.org Resent-Date: Mon, 05 May 2025 07:59:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 76081 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 76081@debbugs.gnu.org Cc: Giacomo Leidi , Gabriel Wicki , Ludovic =?UTF-8?Q?Court=C3=A8s?= , Maxim Cournoyer X-Debbugs-Original-Xcc: Gabriel Wicki , Ludovic =?UTF-8?Q?Court=C3=A8s?= , Maxim Cournoyer Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.174643189232506 (code B ref 76081); Mon, 05 May 2025 07:59:02 +0000 Received: (at 76081) by debbugs.gnu.org; 5 May 2025 07:58:12 +0000 Received: from localhost ([127.0.0.1]:38274 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1uBqiK-0008SD-41 for submit@debbugs.gnu.org; Mon, 05 May 2025 03:58:12 -0400 Received: from confino.investici.org ([2a11:7980:1::2:0]:31959) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1uBqiH-0008Rf-Ar for 76081@debbugs.gnu.org; Mon, 05 May 2025 03:58:09 -0400 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org; s=stigmate; t=1746431888; bh=ZbdJrvwQ0Hv4rn+cK8CEMo0tdneqg17+nFkPZm15q3w=; h=From:To:Cc:Subject:Date:In-Reply-To:References:From; b=nmM2Ow4oHIp72NAcWEMYHDTSlMLTg1nOqaEpfzUN8jw1HFhfIxNyUmF/goveonT0G vYdwkgcwfDYDuec/pPIYegRW7OajBnAORaGKTkKx4qFk4l8TRoI1CHU7sC3ByhkoHG ukqk8Jgk9lXLAAYWMHUFvmYYp68xAxZXQsOKJbQY= Received: from mx1.investici.org (unknown [127.0.0.1]) by confino.investici.org (Postfix) with ESMTP id 4ZrYmc3Bn4z1193; Mon, 5 May 2025 07:58:08 +0000 (UTC) Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19]) (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with ESMTPSA id 4ZrYmc1rG8z11L0; Mon, 5 May 2025 07:58:08 +0000 (UTC) From: Giacomo Leidi Date: Mon, 5 May 2025 09:57:51 +0200 Message-ID: X-Mailer: git-send-email 2.49.0 In-Reply-To: <2b78b4ce9b0a3a6c0bdbdec5bb16702a5b5083a3.1746431874.git.goodoldpaul@autistici.org> References: <2b78b4ce9b0a3a6c0bdbdec5bb16702a5b5083a3.1746431874.git.goodoldpaul@autistici.org> MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" 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/services/containers.scm (%oci-supported-runtimes): New variable; (oci-runtime-cli): new variable; (oci-runtime-name): new variable; (oci-network-configuration): new variable; (oci-volume-configuration): new variable; (oci-configuration): new variable; (oci-extension): new variable; (oci-networks-shepherd-name): new variable; (oci-service-type): new variable; (oci-state->shepherd-services): new variable. * doc/guix.texi: Document it. * gnu/tests/containers.scm: Test it. * gnu/services/docker.scm: Deprecate the oci-container-service-type. Change-Id: I656b3db85832e42d53072fcbfb91d1226f39ef38 --- doc/guix.texi | 306 ++++++-- gnu/services/containers.scm | 1304 ++++++++++++++++++++++++++++++----- gnu/services/docker.scm | 37 +- gnu/tests/containers.scm | 999 ++++++++++++++++++++++++++- 4 files changed, 2394 insertions(+), 252 deletions(-) diff --git a/doc/guix.texi b/doc/guix.texi index 7f796c5fc94..de0d7ccfd5a 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -43782,59 +43782,162 @@ Miscellaneous Services @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: given an -@acronym{Open Container Initiative, OCI} container image, it will run it in a +Should you wish to manage your @acronym{Open Container Initiative, OCI} containers +with the same consistent interface you use for your other Shepherd services, +@var{oci-service-type} is the tool to use: given an +OCI container image, it will run it in a Shepherd service. One example where this is useful: it lets you run services -that are available as Docker/OCI images but not yet packaged for Guix. +that are available as OCI images but not yet packaged for Guix. -@defvar oci-container-service-type +@defvar oci-service-type -This is a thin wrapper around Docker's CLI that executes OCI images backed +This is a thin wrapper around Docker's or Podman's CLI that executes OCI images backed processes as Shepherd Services. @lisp -(service oci-container-service-type - (list - (oci-container-configuration - (network "host") - (image - (oci-image - (repository "guile") - (tag "3") - (value (specifications->manifest '("guile"))) - (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile")) - #:max-layers 2)))) - (entrypoint "/bin/guile") - (command - '("-c" "(display \"hello!\n\")"))) - (oci-container-configuration - (image "prom/prometheus") - (ports - '(("9000" . "9000") - ("9090" . "9090")))) - (oci-container-configuration - (image "grafana/grafana:10.0.1") - (network "host") - (volumes - '("/var/lib/grafana:/var/lib/grafana"))))) +(simple-service 'oci-provisioning + oci-service-type + (oci-extension + (networks + (list + (oci-network-configuration (name "monitoring")))) + (containers + (list + (oci-container-configuration + (network "monitoring") + (image + (oci-image + (repository "guile") + (tag "3") + (value (specifications->manifest '("guile"))) + (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile")) + #:max-layers 2)))) + (entrypoint "/bin/guile") + (command + '("-c" "(display \"hello!\n\")"))) + (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 In this example three different Shepherd services are going to be added to the system. Each @code{oci-container-configuration} record translates to a -@code{docker run} invocation and its fields directly map to options. You can -refer to the -@url{https://docs.docker.com/engine/reference/commandline/run,upstream} -documentation for the semantics of each value. If the images are not found, -they will be -@url{https://docs.docker.com/engine/reference/commandline/pull/,pulled}. The +@command{docker run} or @command{podman run} invocation and its fields directly +map to options. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html,Podman} +upstream documentation for semantics of each value. If the images are not found, +they will be pulled. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/pull/,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-pull.1.html,Podman} +upstream documentation for semantics. The services with @code{(network "host")} are going to be attached to the host network and are supposed to behave like native processes with regard to networking. @end defvar +@c %start of fragment + +@deftp {Data Type} oci-configuration +Available @code{oci-configuration} fields are: + +@table @asis +@item @code{runtime} (default: @code{'docker}) (type: symbol) +The OCI runtime to use to run commands. It can be either @code{'docker} or +@code{'podman}. + +@item @code{runtime-cli} (type: maybe-package-or-string) +The OCI runtime command line to be installed in the system profile and used +to provision OCI resources, it can be either a package or a string representing +an absolute path to the runtime binary entrypoint. When unset it will default +to @code{docker-cli} package for the @code{'docker} runtime or to @code{podman} +package for the @code{'podman} runtime. + +@item @code{runtime-extra-arguments} (default: @code{'()}) (type: list) +A list of strings, gexps or file-like objects that will be placed +after each @command{docker} or @command{podman} invokation. + +@item @code{user} (type: maybe-string) +The user name under whose authority OCI commands will be run. This field will +override the @code{user} field of @code{oci-configuration}. + +@item @code{group} (type: maybe-string) +The group name under whose authority OCI commands will be run. When +using the @code{'podman} OCI runtime, this field will be ignored and the +default group of the user configured in the @code{user} field will be used. +This field will override the @code{group} field of @code{oci-configuration}. + +@item @code{subuids-range} (type: maybe-subid-range) +An optional @code{subid-range} record allocating subuids for the user from +the @code{user} field. When unset, with the rootless Podman OCI runtime, it +defaults to @code{(subid-range (name "oci-container"))}. + +@item @code{subgids-range} (type: maybe-subid-range) +An optional @code{subid-range} record allocating subgids for the user from +the @code{user} field. When unset, with the rootless Podman OCI runtime, it +defaults to @code{(subid-range (name "oci-container"))}. + +@item @code{containers} (default: @code{'()}) (type: list-of-oci-containers) +The list of @code{oci-container-configuration} records representing the +containers to provision. Most users are supposed not to use this field and use +the @code{oci-extension} record instead. + +@item @code{networks} (default: @code{'()}) (type: list-of-oci-networks) +The list of @code{oci-network-configuration} records representing the +containers to provision. Most users are supposed not to use this field and use +the @code{oci-extension} record instead. + +@item @code{volumes} (default: @code{'()}) (type: list-of-oci-volumes) +The list of @code{oci-volumes-configuration} records representing the +containers to provision. Most users are supposed not to use this field and use +the @code{oci-extension} record instead. + +@item @code{verbose?} (default: @code{#f}) (type: boolean) +When true, additional output will be printed, allowing to better follow the +flow of execution. + +@end table + +@end deftp + + +@c %end of fragment + +@c %start of fragment + +@deftp {Data Type} oci-extension +Available @code{oci-extension} fields are: + +@table @asis +@item @code{containers} (default: @code{'()}) (type: list-of-oci-containers) +The list of @code{oci-container-configuration} records representing the +containers to provision. + +@item @code{networks} (default: @code{'()}) (type: list-of-oci-networks) +The list of @code{oci-network-configuration} records representing the +containers to provision. + +@item @code{volumes} (default: @code{'()}) (type: list-of-oci-volumes) +The list of @code{oci-volumes-configuration} records representing the +containers to provision. + +@end table + +@end deftp + + +@c %end of fragment + + @c %start of fragment @deftp {Data Type} oci-container-configuration @@ -43854,16 +43957,16 @@ Miscellaneous Services Overwrite the default entrypoint (@code{ENTRYPOINT}) of the image. @item @code{host-environment} (default: @code{'()}) (type: 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 +Set environment variables in the host environment where @command{docker run} +or @command{podman run} are invoked. This is especially useful to pass secrets +from the host to the container without having them on the OCI runtime command line, +for example: by setting the @code{MYSQL_PASSWORD} on the host and by passing @code{--env MYSQL_PASSWORD} through the @code{extra-arguments} field, it is possible to securely set values in the container environment. This field's value can be a list of pairs or strings, even mixed: @lisp -(list '("LANGUAGE\" . "eo:ca:eu") +(list '("LANGUAGE" . "eo:ca:eu") "JAVA_HOME=/opt/java") @end lisp @@ -43871,22 +43974,24 @@ Miscellaneous Services directly to @code{make-forkexec-constructor}. @item @code{environment} (default: @code{'()}) (type: list) -Set environment variables. This can be a list of pairs or strings, even mixed: +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 -@uref{https://docs.docker.com/engine/reference/commandline/run/#env,upstream} -documentation for semantics. +Pair members can be strings, gexps or file-like objects. Strings are passed +directly to the OCI runtime CLI. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run/#env,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#env-e-env,Podman} +upstream documentation for semantics. @item @code{image} (type: 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{oci-image} record. Strings are resolved by the OCI runtime, +and follow the usual format @code{myregistry.local:5000/testing/test-image:tag}. @item @code{provision} (default: @code{""}) (type: string) @@ -43914,7 +44019,7 @@ Miscellaneous Services by the service. @item @code{network} (default: @code{""}) (type: string) -Set a Docker network for the spawned container. +Set an OCI 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 @@ -43925,10 +44030,11 @@ Miscellaneous Services "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 -@uref{https://docs.docker.com/engine/reference/commandline/run/#publish,upstream} -documentation for semantics. +Pair members can be strings, gexps or file-like objects. Strings are passed +directly to the OCI runtime CLI. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run/#publish,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#publish-p-ip-hostport-containerport-protocol,Podman} +upstream documentation for semantics. @item @code{volumes} (default: @code{'()}) (type: list) Set volume mappings for the spawned container. This can be a @@ -43939,25 +44045,97 @@ Miscellaneous Services "/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 -@uref{https://docs.docker.com/engine/reference/commandline/run/#volume,upstream} -documentation for semantics. +Pair members can be strings, gexps or file-like objects. Strings are passed +directly to the OCI runtime CLI. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run/#volume,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#volume-v-source-volume-host-dir-container-dir-options,Podman} +upstream documentation for semantics. @item @code{container-user} (default: @code{""}) (type: 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. +@url{https://docs.docker.com/engine/reference/run/#user,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#user-u-user-group,Podman} +upstream documentation for semantics. @item @code{workdir} (default: @code{""}) (type: string) Set the current working directory for the spawned Shepherd service. You can refer to the -@url{https://docs.docker.com/engine/reference/run/#workdir,upstream} -documentation for semantics. +@url{https://docs.docker.com/engine/reference/run/#workdir,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#workdir-w-dir,Podman} +upstream documentation for semantics. + +@item @code{extra-arguments} (default: @code{'()}) (type: list) +A list of strings, gexps or file-like objects that will be directly passed +to the @command{docker run} or @command{podman run} invokation. + +@end table + +@end deftp + + +@c %end of fragment + +@c %start of fragment + +@deftp {Data Type} oci-network-configuration +Available @code{oci-network-configuration} fields are: + +@table @asis +@item @code{name} (type: string) +The name of the OCI network to provision. + +@item @code{driver} (type: maybe-string) +The driver to manage the network. + +@item @code{gateway} (type: maybe-string) +IPv4 or IPv6 gateway for the subnet. + +@item @code{internal?} (default: @code{#f}) (type: boolean) +Restrict external access to the network + +@item @code{ip-range} (type: maybe-string) +Allocate container ip from a sub-range in CIDR format. + +@item @code{ipam-driver} (type: maybe-string) +IP Address Management Driver. + +@item @code{ipv6?} (default: @code{#f}) (type: boolean) +Enable IPv6 networking. + +@item @code{subnet} (type: maybe-string) +Subnet in CIDR format that represents a network segment. + +@item @code{labels} (default: @code{'()}) (type: list) +The list of labels that will be used to tag the current volume. + +@item @code{extra-arguments} (default: @code{'()}) (type: list) +A list of strings, gexps or file-like objects that will be directly passed +to the @command{docker network create} or @command{podman network create} +invokation. + +@end table + +@end deftp + + +@c %end of fragment + +@c %start of fragment + +@deftp {Data Type} oci-volume-configuration +Available @code{oci-volume-configuration} fields are: + +@table @asis +@item @code{name} (type: string) +The name of the OCI volume to provision. + +@item @code{labels} (default: @code{'()}) (type: list) +The list of labels that will be used to tag the current volume. @item @code{extra-arguments} (default: @code{'()}) (type: list) -A list of strings, gexps or file-like objects that will be directly -passed to the @command{docker run} invocation. +A list of strings, gexps or file-like objects that will be directly passed +to the @command{docker volume create} or @command{podman volume create} +invokation. @end table diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm index 24f31c756b8..66b46456800 100644 --- a/gnu/services/containers.scm +++ b/gnu/services/containers.scm @@ -41,6 +41,7 @@ (define-module (gnu services containers) #:use-module ((guix scripts pack) #:prefix pack:) #:use-module (guix store) #:use-module (srfi srfi-1) + #:use-module (ice-9 format) #:use-module (ice-9 match) #:export (rootless-podman-configuration rootless-podman-configuration? @@ -96,8 +97,82 @@ (define-module (gnu services containers) oci-container-configuration-workdir oci-container-configuration-extra-arguments + list-of-oci-containers? + list-of-oci-networks? + list-of-oci-volumes? + + %oci-supported-runtimes + oci-sanitize-runtime + oci-runtime-system-environment + oci-runtime-system-extra-arguments + oci-runtime-system-requirement + oci-runtime-cli + oci-runtime-system-cli + oci-runtime-home-cli + oci-runtime-name + oci-runtime-group + + oci-network-configuration + oci-network-configuration? + oci-network-configuration-fields + oci-network-configuration-name + oci-network-configuration-driver + oci-network-configuration-gateway + oci-network-configuration-internal? + oci-network-configuration-ip-range + oci-network-configuration-ipam-driver + oci-network-configuration-ipv6? + oci-network-configuration-subnet + oci-network-configuration-labels + oci-network-configuration-extra-arguments + + oci-volume-configuration + oci-volume-configuration? + oci-volume-configuration-fields + oci-volume-configuration-name + oci-volume-configuration-labels + oci-volume-configuration-extra-arguments + + oci-configuration + oci-configuration? + oci-configuration-runtime + oci-configuration-runtime-cli + oci-configuration-runtime-extra-arguments + oci-configuration-user + oci-configuration-group + oci-configuration-containers + oci-configuration-networks + oci-configuration-volumes + oci-configuration-verbose? + oci-configuration-valid? + + oci-extension + oci-extension? + oci-extension-fields + oci-extension-containers + oci-extension-networks + oci-extension-volumes + + oci-container-shepherd-name + oci-networks-shepherd-name + oci-networks-home-shepherd-name + oci-volumes-shepherd-name + oci-volumes-home-shepherd-name + + oci-container-configuration->options + oci-network-configuration->options + oci-volume-configuration->options + oci-container-shepherd-service - %oci-container-accounts)) + oci-objects-merge-lst + oci-extension-merge + oci-service-type + oci-service-accounts + oci-service-profile + oci-service-subids + oci-state->shepherd-services + oci-configuration->shepherd-services + oci-configuration-extend)) (define (gexp-or-string? value) (or (gexp? value) @@ -296,9 +371,42 @@ (define rootless-podman-service-type ;;; -;;; OCI container. +;;; OCI provisioning service. ;;; +(define %oci-supported-runtimes + '(docker podman)) + +(define (oci-runtime-system-requirement runtime) + "Return a list of Shepherd service names required by a given OCI runtime, +before it is able to run containers." + (if (eq? 'podman runtime) + '(cgroups2-fs-owner cgroups2-limits + rootless-podman-shared-root-fs user-processes) + '(dockerd user-processes))) + +(define (oci-runtime-name runtime) + "Return a human readable name for a given OCI runtime." + (if (eq? 'podman runtime) + "Podman" "Docker")) + +(define (oci-runtime-group runtime maybe-group) + "Implement the logic behind selection of the group that is to be used by +Shepherd to execute OCI commands." + (if (not (maybe-value-set? maybe-group)) + (if (eq? 'podman runtime) + "cgroup" + "docker") + maybe-group)) + +(define (oci-sanitize-runtime value) + (unless (member value %oci-supported-runtimes) + (raise + (formatted-message + (G_ "OCI runtime must be a symbol and one of ~a, +but ~a was found") %oci-supported-runtimes value))) + value) + (define (oci-sanitize-pair pair delimiter) (define (valid? member) (or (string? member) @@ -347,6 +455,11 @@ (define (oci-sanitize-volumes value) ;; '(("/mnt/dir" . "/dir") "/run/current-system/profile:/java") (oci-sanitize-mixed-list "volumes" value ":")) +(define (oci-sanitize-labels value) + ;; Expected spec format: + ;; '(("foo" . "bar") "foo=bar") + (oci-sanitize-mixed-list "labels" value "=")) + (define (oci-sanitize-shepherd-actions value) (map (lambda (el) @@ -374,10 +487,15 @@ (define (oci-sanitize-extra-arguments value) value)) (define (oci-image-reference image) - (if (string? image) - image - (string-append (oci-image-repository image) - ":" (oci-image-tag image)))) + "Return a string OCI image reference representing IMAGE." + (define reference + (if (string? image) + image + (string-append (oci-image-repository image) + ":" (oci-image-tag image)))) + (if (> (length (string-split reference #\/)) 1) + reference + (string-append "localhost/" reference))) (define (oci-lowerable-image? image) (or (manifest? image) @@ -392,7 +510,19 @@ (define (string-or-oci-image? image) (define list-of-symbols? (list-of symbol?)) +(define (list-of-oci-records? name predicate value) + (map + (lambda (el) + (if (predicate el) + el + (raise + (formatted-message + (G_ "~a contains an illegal value: ~a") name el)))) + value)) + (define-maybe/no-serialization string) +(define-maybe/no-serialization package) +(define-maybe/no-serialization subid-range) (define-configuration/no-serialization oci-image (repository @@ -437,11 +567,15 @@ (define-configuration/no-serialization oci-image (define-configuration/no-serialization oci-container-configuration (user - (string "oci-container") - "The user under whose authority docker commands will be run.") + (maybe-string) + "The user name under whose authority OCI commands will be run. This field will +override the @code{user} field of @code{oci-configuration}.") (group - (string "docker") - "The group under whose authority docker commands will be run.") + (maybe-string) + "The group name under whose authority OCI commands will be run. When +using the @code{'podman} OCI runtime, this field will be ignored and the +default group of the user configured in the @code{user} field will be used. +This field will override the @code{group} field of @code{oci-configuration}.") (command (list-of-strings '()) "Overwrite the default command (@code{CMD}) of the image.") @@ -451,9 +585,9 @@ (define-configuration/no-serialization oci-container-configuration (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 +or @command{podman run} are invoked. This is especially useful to pass secrets +from the host to the container without having them on the OCI runtime command line, +for example: by setting the @code{MYSQL_PASSWORD} on the host and by passing @code{--env MYSQL_PASSWORD} through the @code{extra-arguments} field, it is possible to securely set values in the container environment. This field's value can be a list of pairs or strings, even mixed: @@ -477,15 +611,16 @@ (define-configuration/no-serialization oci-container-configuration @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." +directly to the OCI runtime CLI. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run/#env,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#env-e-env,Podman} +upstream documentation for semantics." (sanitizer oci-sanitize-environment)) (image (string-or-oci-image) "The image used to build the container. It can be a string or an -@code{oci-image} record. Strings are resolved by the Docker -Engine, and follow the usual format +@code{oci-image} record. Strings are resolved by the OCI runtime, +and follow the usual format @code{myregistry.local:5000/testing/test-image:tag}.") (provision (maybe-string) @@ -514,7 +649,7 @@ (define-configuration/no-serialization oci-container-configuration (sanitizer oci-sanitize-shepherd-actions)) (network (maybe-string) - "Set a Docker network for the spawned container.") + "Set an OCI network for the spawned container.") (ports (list '()) "Set the port or port ranges to expose from the spawned container. This can @@ -526,9 +661,10 @@ (define-configuration/no-serialization oci-container-configuration @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." +directly to the OCI runtime CLI. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run/#publish,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#publish-p-ip-hostport-containerport-protocol,Podman} +upstream documentation for semantics." (sanitizer oci-sanitize-ports)) (volumes (list '()) @@ -541,71 +677,348 @@ (define-configuration/no-serialization oci-container-configuration @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." +directly to the OCI runtime CLI. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run/#volume,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#volume-v-source-volume-host-dir-container-dir-options,Podman} +upstream documentation for semantics." (sanitizer oci-sanitize-volumes)) (container-user (maybe-string) "Set the current user inside the spawned container. You can refer to the -@url{https://docs.docker.com/engine/reference/run/#user,upstream} -documentation for semantics.") +@url{https://docs.docker.com/engine/reference/run/#user,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#user-u-user-group,Podman} +upstream documentation for semantics.") (workdir (maybe-string) - "Set the current working for the spawned Shepherd service. + "Set the current working directory for the spawned Shepherd service. You can refer to the -@url{https://docs.docker.com/engine/reference/run/#workdir,upstream} -documentation for semantics.") +@url{https://docs.docker.com/engine/reference/run/#workdir,Docker} +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#workdir-w-dir,Podman} +upstream documentation for semantics.") (extra-arguments (list '()) "A list of strings, gexps or file-like objects that will be directly passed -to the @command{docker run} invokation." +to the @command{docker run} or @command{podman 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 (list-of-oci-containers? value) + (list-of-oci-records? "containers" oci-container-configuration? value)) + +(define-configuration/no-serialization oci-volume-configuration + (name + (string) + "The name of the OCI volume to provision.") + (labels + (list '()) + "The list of labels that will be used to tag the current volume." + (sanitizer oci-sanitize-labels)) + (extra-arguments + (list '()) + "A list of strings, gexps or file-like objects that will be directly passed +to the @command{docker volume create} or @command{podman volume create} +invocation." + (sanitizer oci-sanitize-extra-arguments))) + +(define (list-of-oci-volumes? value) + (list-of-oci-records? "volumes" oci-volume-configuration? value)) + +(define-configuration/no-serialization oci-network-configuration + (name + (string) + "The name of the OCI network to provision.") + (driver + (maybe-string) + "The driver to manage the network.") + (gateway + (maybe-string) + "IPv4 or IPv6 gateway for the subnet.") + (internal? + (boolean #f) + "Restrict external access to the network") + (ip-range + (maybe-string) + "Allocate container ip from a sub-range in CIDR format.") + (ipam-driver + (maybe-string) + "IP Address Management Driver.") + (ipv6? + (boolean #f) + "Enable IPv6 networking.") + (subnet + (maybe-string) + "Subnet in CIDR format that represents a network segment.") + (labels + (list '()) + "The list of labels that will be used to tag the current volume." + (sanitizer oci-sanitize-labels)) + (extra-arguments + (list '()) + "A list of strings, gexps or file-like objects that will be directly passed +to the @command{docker network create} or @command{podman network create} +invocation." + (sanitizer oci-sanitize-extra-arguments))) + +(define (list-of-oci-networks? value) + (list-of-oci-records? "networks" oci-network-configuration? value)) + +(define (package-or-string? value) + (or (package? value) (string? value))) + +(define-maybe/no-serialization package-or-string) + +(define-configuration/no-serialization oci-configuration + (runtime + (symbol 'docker) + "The OCI runtime to use to run commands. It can be either @code{'docker} or +@code{'podman}." + (sanitizer oci-sanitize-runtime)) + (runtime-cli + (maybe-package-or-string) + "The OCI runtime command line to be installed in the system profile and used +to provision OCI resources, it can be either a package or a string representing +an absolute path to the runtime binary entrypoint. When unset it will default +to @code{docker-cli} package for the @code{'docker} runtime or to @code{podman} +package for the @code{'podman} runtime.") + (runtime-extra-arguments + (list '()) + "A list of strings, gexps or file-like objects that will be placed +after each @command{docker} or @command{podman} invokation.") + (user + (string "oci-container") + "The user name under whose authority OCI runtime commands will be run.") + (group + (maybe-string) + "The group name under whose authority OCI commands will be run. When +using the @code{'podman} OCI runtime, this field will be ignored and the +default group of the user configured in the @code{user} field will be used.") + (subuids-range + (maybe-subid-range) + "An optional @code{subid-range} record allocating subuids for the user from +the @code{user} field. When unset, with the rootless Podman OCI runtime, it +defaults to @code{(subid-range (name \"oci-container\"))}.") + (subgids-range + (maybe-subid-range) + "An optional @code{subid-range} record allocating subgids for the user from +the @code{user} field. When unset, with the rootless Podman OCI runtime, it +defaults to @code{(subid-range (name \"oci-container\"))}.") + (containers + (list-of-oci-containers '()) + "The list of @code{oci-container-configuration} records representing the +containers to provision. Most users are supposed not to use this field and use +the @code{oci-extension} record instead.") + (networks + (list-of-oci-networks '()) + "The list of @code{oci-network-configuration} records representing the +networks to provision. Most users are supposed not to use this field and use +the @code{oci-extension} record instead.") + (volumes + (list-of-oci-volumes '()) + "The list of @code{oci-volume-configuration} records representing the +volumes to provision. Most users are supposed not to use this field and use +the @code{oci-extension} record instead.") + (verbose? + (boolean #f) + "When true, additional output will be printed, allowing to better follow the +flow of execution.")) + +(define (oci-runtime-system-environment runtime user) + (if (eq? runtime 'podman) + (list + #~(string-append + "HOME=" (passwd:dir (getpwnam #$user)))) + #~())) + +(define (oci-runtime-cli runtime runtime-cli path) + "Return a gexp that, when lowered, evaluates to the file system path of the OCI +runtime command requested by the user." + (if (string? runtime-cli) + ;; It is a user defined absolute path + runtime-cli + #~(string-append + #$(if (not (maybe-value-set? runtime-cli)) + path + runtime-cli) + #$(if (eq? 'podman runtime) + "/bin/podman" + "/bin/docker")))) + +(define* (oci-runtime-system-cli config #:key (path "/run/current-system/profile")) + (let ((runtime-cli + (oci-configuration-runtime-cli config)) + (runtime + (oci-configuration-runtime config))) + (oci-runtime-cli runtime runtime-cli path))) + +(define (oci-runtime-home-cli config) + (let ((runtime-cli + (oci-configuration-runtime-cli config)) + (runtime + (oci-configuration-runtime config))) + (oci-runtime-cli runtime runtime-cli + (string-append (getenv "HOME") + "/.guix-home/profile")))) + +(define-configuration/no-serialization oci-extension + (containers + (list-of-oci-containers '()) + "The list of @code{oci-container-configuration} records representing the +containers to add.") + (networks + (list-of-oci-networks '()) + "The list of @code{oci-network-configuration} records representing the +networks to add.") + (volumes + (list-of-oci-volumes '()) + "The list of @code{oci-volume-configuration} records representing the +volumes to add.")) + +(define (oci-image->container-name image) + "Infer the name of an OCI backed Shepherd service from its OCI image." + (basename + (if (string? image) + (first (string-split image #\:)) + (oci-image-repository image)))) + +(define (oci-object-command-shepherd-action object-name invocation) + "Return a Shepherd action printing a given INVOCATION of an OCI command for the +given OBJECT-NAME." + (shepherd-action + (name 'command-line) + (documentation + (format #f "Prints ~a's OCI runtime command line invocation." + object-name)) + (procedure + #~(lambda _ + (format #t "~a~%" #$invocation))))) + +(define (oci-container-shepherd-name runtime config) + "Return the name of an OCI backed Shepherd service based on CONFIG. +The name configured in the configuration record is returned when +CONFIG's name field has a value, otherwise a name is inferred from CONFIG's +image field." + (define name (oci-container-configuration-provision config)) + (define image (oci-container-configuration-image config)) + + (if (maybe-value-set? name) + name + (string-append (symbol->string runtime) "-" + (oci-image->container-name image)))) + +(define (oci-networks-shepherd-name runtime) + "Return the name of the OCI networks provisioning Shepherd service based on +RUNTIME." + (string-append (symbol->string runtime) "-networks")) + +(define (oci-volumes-shepherd-name runtime) + "Return the name of the OCI volumes provisioning Shepherd service based on +RUNTIME." + (string-append (symbol->string runtime) "-volumes")) + +(define (oci-networks-home-shepherd-name runtime) + "Return the name of the OCI volumes provisioning Home Shepherd service based on +RUNTIME." + (string-append "home-" (oci-networks-shepherd-name runtime))) + +(define (oci-volumes-home-shepherd-name runtime) + "Return the name of the OCI volumes provisioning Home Shepherd service based on +RUNTIME." + (string-append "home-" (oci-volumes-shepherd-name runtime))) + +(define (oci-container-configuration->options config) + "Map CONFIG, an oci-container-configuration record, to a gexp that, upon +lowering, will be evaluated to a list of strings containing command line options +for the OCI runtime run command." + (let ((entrypoint + (oci-container-configuration-entrypoint config)) + (network + (oci-container-configuration-network config)) + (user + (oci-container-configuration-container-user config)) + (workdir + (oci-container-configuration-workdir config))) + (apply append + (filter (compose not unspecified?) + `(,(if (maybe-value-set? entrypoint) + `("--entrypoint" ,entrypoint) + '()) + ,(append-map + (lambda (spec) + (list "--env" spec)) + (oci-container-configuration-environment config)) + ,(if (maybe-value-set? network) + `("--network" ,network) + '()) + ,(if (maybe-value-set? user) + `("--user" ,user) + '()) + ,(if (maybe-value-set? workdir) + `("--workdir" ,workdir) + '()) + ,(append-map + (lambda (spec) + (list "-p" spec)) + (oci-container-configuration-ports config)) + ,(append-map + (lambda (spec) + (list "-v" spec)) + (oci-container-configuration-volumes config))))))) + +(define (oci-network-configuration->options config) + "Map CONFIG, an oci-network-configuration record, to a gexp that, upon +lowering, will be evaluated to a list of strings containing command line options +for the OCI runtime network create command." + (let ((driver (oci-network-configuration-driver config)) + (gateway + (oci-network-configuration-gateway config)) + (internal? + (oci-network-configuration-internal? config)) + (ip-range + (oci-network-configuration-ip-range config)) + (ipam-driver + (oci-network-configuration-ipam-driver config)) + (ipv6? + (oci-network-configuration-ipv6? config)) + (subnet + (oci-network-configuration-subnet config))) + (apply append + (filter (compose not unspecified?) + `(,(if (maybe-value-set? driver) + `("--driver" ,driver) + '()) + ,(if (maybe-value-set? gateway) + `("--gateway" ,gateway) + '()) + ,(if internal? + `("--internal") + '()) + ,(if (maybe-value-set? ip-range) + `("--ip-range" ,ip-range) + '()) + ,(if (maybe-value-set? ipam-driver) + `("--ipam-driver" ,ipam-driver) + '()) + ,(if ipv6? + `("--ipv6") + '()) + ,(if (maybe-value-set? subnet) + `("--subnet" ,subnet) + '()) + ,(append-map + (lambda (spec) + (list "--label" spec)) + (oci-network-configuration-labels config))))))) + +(define (oci-volume-configuration->options config) + "Map CONFIG, an oci-volume-configuration record, to a gexp that, upon +lowering, will be evaluated to a list of strings containing command line options +for the OCI runtime volume create command." + (append-map + (lambda (spec) + (list "--label" spec)) + (oci-volume-configuration-labels config))) (define (lower-operating-system os target system) + "Lower OS, an operating-system record, into a tarball containing an OCI image." (mlet* %store-monad ((tarball (lower-object @@ -614,24 +1027,11 @@ (define (lower-operating-system os target 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))))) - +(define (lower-manifest name value options image-reference + target system grafts?) + "Lower VALUE, a manifest record, into a tarball containing an OCI image." (mlet* %store-monad - ((_ (set-grafting - (oci-image-grafts? image))) + ((_ (set-grafting grafts?)) (guile (set-guile-for-build (default-guile))) (profile (profile-derivation value @@ -642,14 +1042,11 @@ (define (lower-manifest name image target system) (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 (lower-oci-image-state name value options reference + image-target image-system grafts?) (define target (if (maybe-value-set? image-target) image-target @@ -662,7 +1059,8 @@ (define (lower-oci-image name image) (run-with-store store (match value ((? manifest? value) - (lower-manifest name image target system)) + (lower-manifest name value options reference + target system grafts?)) ((? operating-system? value) (lower-operating-system value target system)) ((or (? gexp? value) @@ -677,113 +1075,669 @@ (define (lower-oci-image name image) #: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))) +(define (lower-oci-image name image) + "Lower IMAGE, a oci-image record, into a tarball containing an OCI image." + (lower-oci-image-state + name + (oci-image-value image) + (oci-image-pack-options image) + (oci-image-reference image) + (oci-image-target image) + (oci-image-system image) + (oci-image-grafts? image))) + +(define (oci-object-exists? runtime runtime-cli object verbose?) + #~(lambda* (name #:key (format-string "{{.Name}}")) + (use-modules (ice-9 format) + (ice-9 match) + (ice-9 popen) + (ice-9 rdelim) + (srfi srfi-1)) + + (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))) + + #$(if (eq? runtime 'podman) + #~(let ((command + (list #$runtime-cli + #$object "exists" name))) + (when #$verbose? + (format #t "Running~{ ~a~}~%" command)) + (define exit-code (status:exit-val (apply system* command))) + (when #$verbose? + (format #t "Exit code: ~a~%" exit-code)) + (equal? EXIT_SUCCESS exit-code)) + #~(let ((command + (string-append #$runtime-cli + " " #$object " ls --format " + "\"" format-string "\""))) + (when #$verbose? + (format #t "Running ~a~%" command)) + (member name (read-lines (open-input-pipe command))))))) + +(define* (oci-image-loader runtime runtime-cli name image tag #:key (verbose? #f)) + "Return a file-like object that, once lowered, will evaluate to a program able +to load IMAGE through RUNTIME-CLI and to tag it with TAG afterwards." + (let ((tarball (lower-oci-image name image))) (with-imported-modules '((guix build utils)) - (program-file (format #f "~a-image-loader" name) + (program-file + (format #f "~a-image-loader" name) #~(begin (use-modules (guix build utils) + (ice-9 match) (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)) + (ice-9 rdelim) + (srfi srfi-1)) + (define object-exists? + #$(oci-object-exists? runtime runtime-cli "image" verbose?)) + (define load-command + (string-append #$runtime-cli + " load -i " #$tarball)) + + (if (object-exists? #$tag #:format-string "{{.Repository}}:{{.Tag}}") + (format #t "~a image already exists, skipping.~%" #$tag) + (begin + (format #t "Loading image for ~a from ~a...~%" #$name #$tarball) + (when #$verbose? + (format #t "Running ~a~%" load-command)) + (let ((line (read-line + (open-input-pipe load-command)))) + (unless (or (eof-object? line) + (string-null? line)) + (format #t "~a~%" line) + (let* ((repository&tag + (string-drop line + (string-length + "Loaded image: "))) + (tag-command + (list #$runtime-cli "tag" repository&tag #$tag)) + (drop-old-tag-command + (list #$runtime-cli "image" "rm" "-f" repository&tag))) + + (unless (string=? repository&tag #$tag) + (when #$verbose? + (format #t "Running~{ ~a~}~%" tag-command)) + + (let ((exit-code + (status:exit-val (apply system* tag-command)))) + (format #t "Tagged ~a with ~a...~%" #$tarball #$tag) + + (when #$verbose? + (format #t "Exit code: ~a~%" exit-code)) + + (when (equal? EXIT_SUCCESS exit-code) + (when #$verbose? + (format #t "Running~{ ~a~}~%" drop-old-tag-command)) + (let ((drop-exit-code + (status:exit-val (apply system* drop-old-tag-command)))) + (when #$verbose? + (format #t "Exit code: ~a~%" drop-exit-code)))))))))))))))) + +(define (oci-container-run-invocation runtime runtime-cli name command image-reference + options runtime-extra-arguments run-extra-arguments) + "Return a list representing the OCI runtime +invocation for running containers." + ;; run [OPTIONS] IMAGE [COMMAND] [ARG...] + `(,runtime-cli ,@runtime-extra-arguments "run" "--rm" + ,@(if (eq? runtime 'podman) + ;; This is because podman takes some time to + ;; release container names. --replace seems + ;; to be required to be able to restart services. + '("--replace") + '()) + "--name" ,name + ,@options ,@run-extra-arguments + ,image-reference ,@command)) + +(define* (oci-container-entrypoint runtime runtime-cli name image image-reference + invocation #:key (verbose? #f) (pre-script #~())) + "Return a file-like object that, once lowered, will evaluate to the entrypoint +for the Shepherd service that will run IMAGE through RUNTIME-CLI." + (program-file + (string-append "oci-entrypoint-" name) + #~(begin + (use-modules (ice-9 format) + (srfi srfi-1)) + (when #$verbose? + (format #t "Running in verbose mode...~%") + (format #t "Current user: ~a ~a~%" + (getuid) (passwd:name (getpwuid (getuid)))) + (format #t "Current group: ~a ~a~%" + (getgid) (group:name (getgrgid (getgid)))) + (format #t "Current directory ~a~%" (getcwd))) + (define invocation (list #$@invocation)) + #$@pre-script + (when #$verbose? + (format #t "Running~{ ~a~}~%" invocation)) + (apply execlp `(,(first invocation) ,@invocation))))) + +(define* (oci-container-shepherd-service runtime runtime-cli config + #:key + (runtime-environment #~()) + (runtime-extra-arguments '()) + (oci-requirement '()) + (user #f) + (group #f) + (verbose? #f)) + "Return a Shepherd service object that will run the OCI container represented +by CONFIG through RUNTIME-CLI." + (let* ((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)) + (maybe-user (oci-container-configuration-user config)) + (maybe-group (oci-container-configuration-group config)) + (user (if (maybe-value-set? maybe-user) + maybe-user + user)) + (group (if (maybe-value-set? maybe-group) + maybe-group + group)) (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)) + (name + (oci-container-shepherd-name runtime config)) (extra-arguments - (oci-container-configuration-extra-arguments config))) + (oci-container-configuration-extra-arguments config)) + (invocation + (oci-container-run-invocation + runtime runtime-cli name command image-reference + options runtime-extra-arguments extra-arguments)) + (container-action + (lambda* (command #:key (environment-variables #f)) + #~(lambda _ + (fork+exec-command + (list #$@command) + #$@(if user (list #:user user) '()) + #$@(if group (list #:group group) '()) + #$@(if (maybe-value-set? log-file) + (list #:log-file log-file) + '()) + #$@(if (and user (eq? runtime 'podman)) + (list #:directory + #~(passwd:dir (getpwnam #$user))) + '()) + #$@(if environment-variables + (list #:environment-variables + environment-variables) + '())))))) (shepherd-service (provision `(,(string->symbol name))) - (requirement `(dockerd user-processes ,@requirement)) + (requirement `(,@oci-requirement + ,@requirement)) (respawn? respawn?) (auto-start? auto-start?) (documentation (string-append - "Docker backed Shepherd service for " + (oci-runtime-name runtime) " 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)))) + (container-action + (list (oci-container-entrypoint + runtime runtime-cli name image image-reference + invocation #:verbose? verbose? + #:pre-script + (if (oci-image? image) + #~((system* + #$(oci-image-loader + runtime runtime-cli name image + image-reference #:verbose? verbose?))) + #~()))) + #:environment-variables + #~(append + (list #$@host-environment) + (list #$@runtime-environment)))) (stop - #~(lambda _ - (invoke #$docker "rm" "-f" #$name))) + (container-action + (list + (oci-container-entrypoint + runtime runtime-cli name image image-reference + (list runtime-cli "rm" "-f" name) + #:verbose? verbose?)) + #:environment-variables + #~(append + (list #$@host-environment) + (list #$@runtime-environment)))) (actions - (if (oci-image? image) - '() - (append + (append + (list + (oci-object-command-shepherd-action + name #~(string-join (list #$@invocation) " "))) + (if (oci-image? image) + '() (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 + (let ((service-name name)) + (shepherd-action + (name 'pull) + (documentation + (format #f "Pull ~a's image (~a)." + service-name image)) + (procedure + (container-action + (list + (oci-container-entrypoint + runtime runtime-cli service-name image + image-reference + (list runtime-cli "pull" image) + #:verbose? verbose?)) + #:environment-variables + #~(append + (list #$@host-environment) + (list #$@runtime-environment)))))))) + actions))))) + +(define (oci-object-create-invocation object runtime-cli name options + runtime-extra-arguments + create-extra-arguments) + "Return a gexp that, upon lowering, will evaluate to the OCI runtime +invocation for creating networks and volumes." + ;; network|volume create [options] [NAME] + #~(list #$runtime-cli #$@runtime-extra-arguments #$object "create" + #$@options #$@create-extra-arguments #$name)) + +(define (format-oci-invocations invocations) + "Return a gexp that, upon lowering, will evaluate to a formatted message +containing the INVOCATIONS that the OCI runtime will execute to provision +networks or volumes." + #~(string-join (map (lambda (i) (string-join i " ")) + (list #$@invocations)) + "\n")) + +(define* (oci-object-create-script object runtime runtime-cli invocations + #:key (verbose? #f)) + "Return a file-like object that, once lowered, will evaluate to a program able +to create OCI networks and volumes through RUNTIME-CLI." + (define runtime-string (symbol->string runtime)) + (program-file + (string-append runtime-string "-" object "s-create.scm") + #~(begin + (use-modules (ice-9 format) + (ice-9 match) + (ice-9 popen) + (ice-9 rdelim) + (srfi srfi-1)) + + (define object-exists? + #$(oci-object-exists? runtime runtime-cli object verbose?)) + + (for-each + (lambda (invocation) + (define name (last invocation)) + (if (object-exists? name) + (format #t "~a ~a ~a already exists, skipping creation.~%" + #$(oci-runtime-name runtime) name #$object) + (begin + (when #$verbose? + (format #t "Running~{ ~a~}~%" invocation)) + (let ((exit-code (status:exit-val (apply system* invocation)))) + (when #$verbose? + (format #t "Exit code: ~a~%" exit-code)))))) + (list #$@invocations))))) + +(define* (oci-object-shepherd-service object runtime runtime-cli name requirement invocations + #:key + (runtime-environment #~()) + (user #f) + (group #f) + (verbose? #f)) + "Return a Shepherd service object that will create the OBJECTs represented +by INVOCATIONS through RUNTIME-CLI." + (shepherd-service (provision `(,(string->symbol name))) + (requirement requirement) + (one-shot? #t) + (documentation + (string-append + (oci-runtime-name runtime) " " object + " provisioning service")) + (start + #~(lambda _ + (fork+exec-command + (list + #$(oci-object-create-script + object runtime runtime-cli + invocations + #:verbose? verbose?)) + #$@(if user (list #:user user) '()) + #$@(if group (list #:group group) '()) + #:environment-variables + (list #$@runtime-environment)))) + (actions + (list + (oci-object-command-shepherd-action + name (format-oci-invocations invocations)))))) + +(define* (oci-networks-shepherd-service runtime runtime-cli name networks + #:key (user #f) (group #f) (verbose? #f) + (runtime-extra-arguments '()) + (runtime-environment #~()) + (runtime-requirement '())) + "Return a Shepherd service object that will create the networks represented +in CONFIG." + (let ((invocations + (map + (lambda (network) + (oci-object-create-invocation + "network" runtime-cli + (oci-network-configuration-name network) + (oci-network-configuration->options network) + runtime-extra-arguments + (oci-network-configuration-extra-arguments network))) + networks))) + + (oci-object-shepherd-service + "network" runtime runtime-cli name + runtime-requirement invocations + #:user user #:group group #:runtime-environment runtime-environment + #:verbose? verbose?))) + +(define* (oci-volumes-shepherd-service runtime runtime-cli name volumes + #:key (user #f) (group #f) (verbose? #f) + (runtime-extra-arguments '()) + (runtime-environment #~()) + (runtime-requirement '())) + "Return a Shepherd service object that will create the volumes represented +in CONFIG." + (let ((invocations + (map + (lambda (volume) + (oci-object-create-invocation + "volume" runtime-cli + (oci-volume-configuration-name volume) + (oci-volume-configuration->options volume) + runtime-extra-arguments + (oci-volume-configuration-extra-arguments volume))) + volumes))) + + (oci-object-shepherd-service + "volume" runtime runtime-cli name runtime-requirement invocations + #:user user #:group group #:runtime-environment runtime-environment + #:verbose? verbose?))) + +(define (oci-service-accounts config) + (define user (oci-configuration-user config)) + (define maybe-group (oci-configuration-group config)) + (define runtime (oci-configuration-runtime config)) (list (user-account - (name "oci-container") + (name user) (comment "OCI services account") - (group "docker") - (system? #t) - (home-directory "/var/empty") + (group "users") + (supplementary-groups + (list (oci-runtime-group runtime maybe-group))) + (system? (eq? 'docker runtime)) + (home-directory (if (eq? 'podman runtime) + (string-append "/home/" user) + "/var/empty")) + (create-home-directory? (eq? 'podman runtime)) (shell (file-append shadow "/sbin/nologin"))))) + +(define* (oci-state->shepherd-services runtime runtime-cli containers networks volumes + #:key (user #f) (group #f) (verbose? #f) + (networks-name #f) (volumes-name #f) + (runtime-extra-arguments '()) + (runtime-environment #~()) + (runtime-requirement '()) + (containers-requirement '()) + (networks-requirement '()) + (volumes-requirement '())) + "Returns a list of Shepherd services based on the input OCI state." + (let* ((networks-name + (if (string? networks-name) + networks-name + (oci-networks-shepherd-name runtime))) + (networks? + (> (length networks) 0)) + (networks-service + (if networks? + (list + (string->symbol networks-name)) + '())) + (volumes-name + (if (string? volumes-name) + volumes-name + (oci-volumes-shepherd-name runtime))) + (volumes? + (> (length volumes) 0)) + (volumes-service + (if volumes? + (list (string->symbol volumes-name)) + '()))) + (append + (map + (lambda (c) + (oci-container-shepherd-service + runtime runtime-cli c + #:user user + #:group group + #:runtime-environment runtime-environment + #:runtime-extra-arguments runtime-extra-arguments + #:oci-requirement + (append containers-requirement + runtime-requirement + networks-service + volumes-service) + #:verbose? verbose?)) + containers) + (if networks? + (list + (oci-networks-shepherd-service + runtime runtime-cli + networks-name networks + #:user user #:group group + #:runtime-extra-arguments runtime-extra-arguments + #:runtime-environment runtime-environment + #:runtime-requirement (append networks-requirement + runtime-requirement) + #:verbose? verbose?)) + '()) + (if volumes? + (list + (oci-volumes-shepherd-service + runtime runtime-cli + volumes-name volumes + #:user user #:group group + #:runtime-extra-arguments runtime-extra-arguments + #:runtime-environment runtime-environment + #:runtime-requirement (append runtime-requirement + volumes-requirement) + #:verbose? verbose?)) + '())))) + +(define (oci-configuration->shepherd-services config) + (let* ((runtime (oci-configuration-runtime config)) + (system-runtime-cli + (oci-runtime-system-cli config)) + (home-runtime-cli + (oci-runtime-home-cli config)) + (runtime-extra-arguments + (oci-configuration-runtime-extra-arguments config)) + (containers (oci-configuration-containers config)) + (networks (oci-configuration-networks config)) + (volumes (oci-configuration-volumes config)) + (user (oci-configuration-user config)) + (group + (if (eq? runtime 'podman) + #~(group:name + (getgrgid + (passwd:gid + (getpwnam #$user)))) + (oci-runtime-group config (oci-configuration-group config)))) + (verbose? (oci-configuration-verbose? config))) + (oci-state->shepherd-services runtime system-runtime-cli containers networks volumes + #:user user + #:group group + #:verbose? verbose? + #:runtime-extra-arguments + runtime-extra-arguments + #:runtime-environment + (oci-runtime-system-environment runtime user) + #:runtime-requirement + (oci-runtime-system-requirement runtime) + #:networks-requirement '(networking)))) + +(define (oci-service-subids config) + "Return a subids-extension record representing subuids and subgids required by +the rootless Podman backend." + (define (delete-duplicate-ranges ranges) + (delete-duplicates ranges + (lambda args + (apply string=? (map subid-range-name ranges))))) + (define runtime + (oci-configuration-runtime config)) + (define user + (oci-configuration-user config)) + (define subgids (oci-configuration-subgids-range config)) + (define subuids (oci-configuration-subuids-range config)) + (define container-users + (filter (lambda (range) + (and (maybe-value-set? + (subid-range-name range)) + (not (string=? (subid-range-name range) user)))) + (map (lambda (container) + (subid-range + (name + (oci-container-configuration-user container)))) + (oci-configuration-containers config)))) + (define subgid-ranges + (delete-duplicate-ranges + (cons + (if (not (maybe-value-set? subgids)) + (subid-range (name user)) + subgids) + container-users))) + (define subuid-ranges + (delete-duplicate-ranges + (cons + (if (not (maybe-value-set? subuids)) + (subid-range (name user)) + subuids) + container-users))) + + (if (eq? 'podman runtime) + (subids-extension + (subgids + subgid-ranges) + (subuids + subuid-ranges)) + (subids-extension))) + +(define (oci-objects-merge-lst a b object get-name) + (define (contains? value lst) + (member value (map get-name lst))) + (let loop ((merged '()) + (lst (append a b))) + (if (null? lst) + merged + (loop + (let ((element (car lst))) + (when (contains? element merged) + (raise + (formatted-message + (G_ "Duplicated ~a: ~a. ~as names should be unique, please +remove the duplicate.") object (get-name element) object))) + (cons element merged)) + (cdr lst))))) + +(define (oci-extension-merge a b) + (oci-extension + (containers (oci-objects-merge-lst + (oci-extension-containers a) + (oci-extension-containers b) + "container" + (lambda (config) + (define maybe-name (oci-container-configuration-provision config)) + (if (maybe-value-set? maybe-name) + maybe-name + (oci-image->container-name + (oci-container-configuration-image config)))))) + (networks (oci-objects-merge-lst + (oci-extension-networks a) + (oci-extension-networks b) + "network" + oci-network-configuration-name)) + (volumes (oci-objects-merge-lst + (oci-extension-volumes a) + (oci-extension-volumes b) + "volume" + oci-volume-configuration-name)))) + +(define (oci-service-profile runtime runtime-cli) + `(,bash-minimal + ,@(if (string? runtime-cli) + '() + (list + (cond + ((maybe-value-set? runtime-cli) + runtime-cli) + ((eq? 'podman runtime) + podman) + (else + docker-cli)))))) + +(define (oci-configuration-extend config extension) + (oci-configuration + (inherit config) + (containers + (oci-objects-merge-lst + (oci-configuration-containers config) + (oci-extension-containers extension) + "container" + (lambda (oci-config) + (define runtime + (oci-configuration-runtime config)) + (oci-container-shepherd-name runtime oci-config)))) + (networks (oci-objects-merge-lst + (oci-configuration-networks config) + (oci-extension-networks extension) + "network" + oci-network-configuration-name)) + (volumes (oci-objects-merge-lst + (oci-configuration-volumes config) + (oci-extension-volumes extension) + "volume" + oci-volume-configuration-name)))) + +(define oci-service-type + (service-type (name 'oci) + (extensions + (list + (service-extension profile-service-type + (lambda (config) + (let ((runtime-cli + (oci-configuration-runtime-cli config)) + (runtime + (oci-configuration-runtime config))) + (oci-service-profile runtime runtime-cli)))) + (service-extension subids-service-type + oci-service-subids) + (service-extension account-service-type + oci-service-accounts) + (service-extension shepherd-root-service-type + oci-configuration->shepherd-services))) + ;; Concatenate OCI object lists. + (compose (lambda (args) + (fold oci-extension-merge + (oci-extension) + args))) + (extend oci-configuration-extend) + (default-value (oci-configuration)) + (description + "This service implements the provisioning of OCI object such +as containers, networks and volumes."))) diff --git a/gnu/services/docker.scm b/gnu/services/docker.scm index 828ceea313a..125e748bb0e 100644 --- a/gnu/services/docker.scm +++ b/gnu/services/docker.scm @@ -31,7 +31,10 @@ (define-module (gnu services docker) #:use-module (gnu system shadow) #:use-module (gnu packages docker) #:use-module (gnu packages linux) ;singularity + #:use-module (guix deprecation) + #:use-module (guix diagnostics) #:use-module (guix gexp) + #:use-module (guix i18n) #:use-module (guix records) #:use-module (srfi srfi-1) #:use-module (ice-9 format) @@ -67,16 +70,18 @@ (define-module (gnu services docker) 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) + oci-container-configuration-extra-arguments) #:export (containerd-configuration containerd-service-type docker-configuration docker-service-type singularity-service-type - oci-container-service-type)) + ;; for backwards compatibility, until the + ;; oci-container-service-type is fully deprecated + oci-container-shepherd-service + oci-container-service-type + %oci-container-accounts)) (define-maybe file-like) @@ -297,17 +302,25 @@ (define singularity-service-type ;;; OCI container. ;;; -(define (configs->shepherd-services configs) - (map oci-container-shepherd-service configs)) +;; for backwards compatibility, until the +;; oci-container-service-type is fully deprecated +(define-deprecated (oci-container-shepherd-service config) + oci-service-type + ((@ (gnu services containers) oci-container-shepherd-service) + 'docker config)) +(define %oci-container-accounts + (filter user-account? (oci-service-accounts (oci-configuration)))) (define oci-container-service-type (service-type (name 'oci-container) - (extensions (list (service-extension profile-service-type - (lambda _ (list docker-cli))) - (service-extension account-service-type - (const %oci-container-accounts)) - (service-extension shepherd-root-service-type - configs->shepherd-services))) + (extensions + (list (service-extension oci-service-type + (lambda (containers) + (warning + (G_ + "'oci-container-service-type' is deprecated, use 'oci-service-type' instead~%")) + (oci-extension + (containers containers)))))) (default-value '()) (extend append) (compose concatenate) diff --git a/gnu/tests/containers.scm b/gnu/tests/containers.scm index 0ecc8ddb126..5e6f39387e7 100644 --- a/gnu/tests/containers.scm +++ b/gnu/tests/containers.scm @@ -27,6 +27,9 @@ (define-module (gnu tests containers) #: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 @@ (define-module (gnu tests containers) #: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 @@ -345,3 +350,995 @@ (define %test-rootless-podman (name "rootless-podman") (description "Test rootless Podman service.") (value (build-tarball&run-rootless-podman-test)))) + + +(define %oci-rootless-podman-os + (simple-operating-system + (service dhcp-client-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-configuration (name "my-network")))) + (volumes + (list (oci-volume-configuration (name "my-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)(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 services herd) + (guix combinators)))) + + (define vm + (virtual-machine + (operating-system os) + (volatile? #f) + (memory-size 1024) + (disk-image-size (* 3000 (expt 2 20))) + (port-forwardings '()))) + + (define test + (with-imported-modules '((gnu build marionette)) + #~(begin + (use-modules (srfi srfi-11) (srfi srfi-64) + (gnu build marionette)) + + (define marionette + ;; Relax timeout to accommodate older systems and + ;; allow for pulling the image. + (make-marionette (list #$vm) #:timeout 60)) + (define out-dir "/tmp") + + (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 "rootless-podman services started successfully" + (begin + (define (run-test) + (marionette-eval + `(begin + (use-modules (ice-9 popen) + (ice-9 match) + (ice-9 rdelim)) + + (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 slurp + (lambda args + (let* ((port (apply open-pipe* OPEN_READ args)) + (output (read-lines port)) + (status (close-pipe port))) + output))) + (let* ((bash + ,(string-append #$bash "/bin/bash")) + (response1 + (slurp bash "-c" + (string-append "ls -la /sys/fs/cgroup | " + "grep -E ' \\./?$' | awk '{ print $4 }'"))) + (response2 (slurp bash "-c" + (string-append "ls -l /sys/fs/cgroup/cgroup" + ".{procs,subtree_control,threads} | " + "awk '{ print $4 }' | sort -u")))) + (list (string-join response1 "\n") (string-join response2 "\n")))) + marionette)) + ;; Allow services to come up on slower machines + (let loop ((attempts 0)) + (if (= attempts 60) + (error "Services didn't come up after more than 60 seconds") + (if (equal? '("cgroup" "cgroup") + (run-test)) + #t + (begin + (sleep 1) + (format #t "Services didn't come up yet, retrying with attempt ~a~%" + (+ 1 attempts)) + (loop (+ 1 attempts)))))))) + + (test-assert "podman-volumes running" + (begin + (define (run-test) + (marionette-eval + `(begin + (use-modules (srfi srfi-1) + (ice-9 popen) + (ice-9 match) + (ice-9 rdelim)) + + (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 (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 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))) + + (match (primitive-fork) + (0 + (dynamic-wind + (const #f) + (lambda () + (setgid (passwd:gid (getpwnam "oci-container"))) + (setuid (passwd:uid (getpw "oci-container"))) + + (let ((response (slurp + "/run/current-system/profile/bin/podman" + "volume" "ls" "-n" "--format" "\"{{.Name}}\"" + "|" "tr" "' '" "'\n'"))) + + (call-with-output-file (string-append ,out-dir "/response") + (lambda (port) + (display (string-join response "\n") port))))) + (lambda () + (primitive-exit 127)))) + (pid + (cdr (waitpid pid)))) + + (wait-for-file (string-append ,out-dir "/response")) + + (stable-sort + (slurp "cat" (string-append ,out-dir "/response")) + string<=?)) + marionette)) + ;; Allow services to come up on slower machines + (let loop ((attempts 0)) + (if (= attempts 80) + (error "Service didn't come up after more than 80 seconds") + (if (equal? '("my-volume") + (run-test)) + #t + (begin + (sleep 1) + (loop (+ 1 attempts)))))))) + + (test-assert "podman-networks running" + (begin + (define (run-test) + (marionette-eval + `(begin + (use-modules (srfi srfi-1) + (ice-9 popen) + (ice-9 match) + (ice-9 rdelim)) + + (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 (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 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))) + + (match (primitive-fork) + (0 + (dynamic-wind + (const #f) + (lambda () + (setgid (passwd:gid (getpwnam "oci-container"))) + (setuid (passwd:uid (getpw "oci-container"))) + + (let ((response (slurp + "/run/current-system/profile/bin/podman" + "network" "ls" "-n" "--format" "\"{{.Name}}\"" + "|" "tr" "' '" "'\n'"))) + + (call-with-output-file (string-append ,out-dir "/response") + (lambda (port) + (display (string-join response "\n") port))))) + (lambda () + (primitive-exit 127)))) + (pid + (cdr (waitpid pid)))) + + (wait-for-file (string-append ,out-dir "/response")) + + (stable-sort + (slurp "cat" (string-append ,out-dir "/response")) + string<=?)) + marionette)) + ;; Allow services to come up on slower machines + (let loop ((attempts 0)) + (if (= attempts 80) + (error "Service didn't come up after more than 80 seconds") + (if (equal? '("my-network" "podman") + (run-test)) + #t + (begin + (sleep 1) + (loop (+ 1 attempts)))))))) + + (test-assert "first container running" + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (wait-for-service 'first #:timeout 120) + #t) + marionette)) + + (test-assert "second container running" + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (wait-for-service 'second #:timeout 120) + #t) + marionette)) + + (test-assert "passing host environment variables" + (begin + (define (run-test) + (marionette-eval + `(begin + (use-modules (srfi srfi-1) + (ice-9 popen) + (ice-9 match) + (ice-9 rdelim)) + + (define (wait-for-file file) + ;; Wait until FILE shows up. + (let loop ((i 60)) + (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 (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 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))) + + (match (primitive-fork) + (0 + (dynamic-wind + (const #f) + (lambda () + (setgid (passwd:gid (getpwnam "oci-container"))) + (setuid (passwd:uid (getpw "oci-container"))) + + (let ((response (slurp + "/run/current-system/profile/bin/podman" + "exec" "first" + "/bin/guile" "-c" "'(display (getenv \"VARIABLE\"))'"))) + (call-with-output-file (string-append ,out-dir "/response") + (lambda (port) + (display (string-join response "\n") port))))) + (lambda () + (primitive-exit 127)))) + (pid + (cdr (waitpid pid)))) + + (wait-for-file (string-append ,out-dir "/response")) + (slurp "cat" (string-append ,out-dir "/response"))) + marionette)) + ;; Allow image to be loaded on slower machines + (let loop ((attempts 0)) + (if (= attempts 180) + (error "Service didn't come up after more than 180 seconds") + (if (equal? (list "value") + (run-test)) + #t + (begin + (sleep 1) + (loop (+ 1 attempts)))))))) + + (test-equal "mounting host files" + '("hello") + (marionette-eval + `(begin + (use-modules (srfi srfi-1) + (ice-9 popen) + (ice-9 match) + (ice-9 rdelim)) + + (define (wait-for-file file) + ;; Wait until FILE shows up. + (let loop ((i 60)) + (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 (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 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))) + + (match (primitive-fork) + (0 + (dynamic-wind + (const #f) + (lambda () + (setgid (passwd:gid (getpwnam "oci-container"))) + (setuid (passwd:uid (getpw "oci-container"))) + + (let ((response (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)))'"))) + (call-with-output-file (string-append ,out-dir "/response") + (lambda (port) + (display (string-join response " ") port))))) + (lambda () + (primitive-exit 127)))) + (pid + (cdr (waitpid pid)))) + + (wait-for-file (string-append ,out-dir "/response")) + (slurp "cat" (string-append ,out-dir "/response"))) + marionette)) + + (test-equal "write to volumes" + '("world") + (marionette-eval + `(begin + (use-modules (srfi srfi-1) + (ice-9 popen) + (ice-9 match) + (ice-9 rdelim)) + + (define (wait-for-file file) + ;; Wait until FILE shows up. + (let loop ((i 60)) + (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 (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 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))) + + (match (primitive-fork) + (0 + (dynamic-wind + (const #f) + (lambda () + (setgid (passwd:gid (getpwnam "oci-container"))) + (setuid (passwd:uid (getpw "oci-container"))) + + (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))))'") + + (let ((response (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)))'"))) + (call-with-output-file (string-append ,out-dir "/response") + (lambda (port) + (display (string-join response " ") port))))) + (lambda () + (primitive-exit 127)))) + (pid + (cdr (waitpid pid)))) + + (wait-for-file (string-append ,out-dir "/response")) + (slurp "cat" (string-append ,out-dir "/response"))) + marionette)) + + (test-equal "can read ports over network" + '("out of office") + (marionette-eval + `(begin + (use-modules (srfi srfi-1) + (ice-9 popen) + (ice-9 match) + (ice-9 rdelim)) + + (define (wait-for-file file) + ;; Wait until FILE shows up. + (let loop ((i 60)) + (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 (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 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))) + + (match (primitive-fork) + (0 + (dynamic-wind + (const #f) + (lambda () + (setgid (passwd:gid (getpwnam "oci-container"))) + (setuid (passwd:uid (getpw "oci-container"))) + + (let ((response (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))'"))) + (call-with-output-file (string-append ,out-dir "/response") + (lambda (port) + (display (string-join response " ") port))))) + (lambda () + (primitive-exit 127)))) + (pid + (cdr (waitpid pid)))) + + (wait-for-file (string-append ,out-dir "/response")) + (slurp "cat" (string-append ,out-dir "/response"))) + 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-os + (simple-operating-system + (service dhcp-client-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-configuration (name "my-network")))) + (volumes + (list (oci-volume-configuration (name "my-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)(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 services herd) + (guix combinators)))) + + (define vm + (virtual-machine + (operating-system os) + (volatile? #f) + (memory-size 1024) + (disk-image-size (* 3000 (expt 2 20))) + (port-forwardings '()))) + + (define test + (with-imported-modules '((gnu build marionette)) + #~(begin + (use-modules (srfi srfi-11) (srfi srfi-64) + (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) + (marionette-eval + `(begin + (use-modules (ice-9 popen) + (ice-9 rdelim)) + + (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 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))) + + (stable-sort + (slurp + "/run/current-system/profile/bin/docker" + "volume" "ls" "--format" "\"{{.Name}}\"") + string<=?)) + + marionette)) + ;; Allow services to come up on slower machines + (let loop ((attempts 0)) + (if (= attempts 80) + (error "Service didn't come up after more than 80 seconds") + (if (equal? '("my-volume") + (run-test)) + #t + (begin + (sleep 1) + (loop (+ 1 attempts)))))))) + + (test-assert "docker-networks running" + (begin + (define (run-test) + (marionette-eval + `(begin + (use-modules (ice-9 popen) + (ice-9 rdelim)) + + (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 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))) + + (stable-sort + (slurp + "/run/current-system/profile/bin/docker" + "network" "ls" "--format" "\"{{.Name}}\"") + string<=?)) + + marionette)) + ;; Allow services to come up on slower machines + (let loop ((attempts 0)) + (if (= attempts 80) + (error "Service didn't come up after more than 80 seconds") + (if (equal? '("bridge" "host" "my-network" "none") + (run-test)) + #t + (begin + (sleep 1) + (loop (+ 1 attempts)))))))) + + (test-assert "first container running" + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (wait-for-service 'first #:timeout 120) + #t) + marionette)) + + (test-assert "second container running" + (marionette-eval + '(begin + (use-modules (gnu services herd)) + (wait-for-service 'second #:timeout 120) + #t) + marionette)) + + (test-assert "passing host environment variables" + (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))) + + (slurp + "/run/current-system/profile/bin/docker" + "exec" "first" + "/bin/guile" "-c" "(display (getenv \"VARIABLE\"))")) + marionette)) + ;; Allow image to be loaded on slower machines + (let loop ((attempts 0)) + (if (= attempts 180) + (error "Service didn't come up after more than 180 seconds") + (if (equal? "value" + (run-test)) + #t + (begin + (sleep 1) + (loop (+ 1 attempts)))))))) + + (test-equal "mounting host files" + "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))) + + (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 \"/shared.txt\" read-line)))")) + marionette)) + + (test-equal "write to volumes" + "world" + (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))) + + (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 ports over network" + "out of office" + (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))) + + (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)))) -- 2.49.0 From unknown Fri Jun 13 11:55:10 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#76081] [PATCH v10 1/7] services: rootless-podman: Use login shell. References: <2f43e635-508c-407a-8309-06e75d492d89@autistici.org> In-Reply-To: <2f43e635-508c-407a-8309-06e75d492d89@autistici.org> Resent-From: Giacomo Leidi Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Mon, 05 May 2025 07:59:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 76081 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 76081@debbugs.gnu.org Cc: Giacomo Leidi Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.174643189332519 (code B ref 76081); Mon, 05 May 2025 07:59:02 +0000 Received: (at 76081) by debbugs.gnu.org; 5 May 2025 07:58:13 +0000 Received: from localhost ([127.0.0.1]:38275 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1uBqiK-0008SF-7g for submit@debbugs.gnu.org; Mon, 05 May 2025 03:58:13 -0400 Received: from confino.investici.org ([93.190.126.19]:42627) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1uBqiG-0008Rb-AF for 76081@debbugs.gnu.org; Mon, 05 May 2025 03:58:09 -0400 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org; s=stigmate; t=1746431887; bh=msLIwlh/X6UfUT74UbhGpu/nj1vszwErxmhdqMBU7UA=; h=From:To:Cc:Subject:Date:From; b=SNiYJ1Gk38jx3tC/SrWaAY2WqacI6X8yj4L3BvD5sUCQasl4q6bW01a2pKHrbi62h gBDMQlLXkUOOiLafZ5GGdSbyEhryuOh6EPHK7ky8FEt1MjUMbV7hgwPAX2Z05vJ3E9 MEWJuLORTHRk24KKFLIvgxJguULtmqmy5/+yrgSA= Received: from mx1.investici.org (unknown [127.0.0.1]) by confino.investici.org (Postfix) with ESMTP id 4ZrYmb11TGz11Kf; Mon, 5 May 2025 07:58:07 +0000 (UTC) Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19]) (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with ESMTPSA id 4ZrYmZ6v1nz1193; Mon, 5 May 2025 07:58:06 +0000 (UTC) From: Giacomo Leidi Date: Mon, 5 May 2025 09:57:48 +0200 Message-ID: <2b78b4ce9b0a3a6c0bdbdec5bb16702a5b5083a3.1746431874.git.goodoldpaul@autistici.org> X-Mailer: git-send-email 2.49.0 MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Spam-Score: -0.7 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.7 (-) This commit allows for having PATH set when changing the owner of /sys/fs/group. * gnu/services/containers.scm (crgroups-fs-owner): Use login shell. Change-Id: I9510c637a5332325e05ca5ebc9dfd4de32685c50 --- gnu/services/containers.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm index b3cd109ce6c..d5a211765a6 100644 --- a/gnu/services/containers.scm +++ b/gnu/services/containers.scm @@ -140,7 +140,7 @@ (define (cgroups-fs-owner-entrypoint config) (rootless-podman-configuration-group-name config)) (program-file "cgroups2-fs-owner-entrypoint" #~(system* - (string-append #+bash-minimal "/bin/bash") "-c" + (string-append #+bash-minimal "/bin/bash") "-l" "-c" (string-append "echo Setting /sys/fs/cgroup " "group ownership to " #$group " && chown -v " "root:" #$group " /sys/fs/cgroup && " base-commit: 63088c295d81cc3d0e808c478d4fe479a2c90102 -- 2.49.0 From unknown Fri Jun 13 11:55:10 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#76081] [PATCH v10 3/7] tests: oci-container: Set explicit timeouts. Resent-From: Giacomo Leidi Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Mon, 05 May 2025 07:59:03 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 76081 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 76081@debbugs.gnu.org Cc: Giacomo Leidi Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.174643190032546 (code B ref 76081); Mon, 05 May 2025 07:59:03 +0000 Received: (at 76081) by debbugs.gnu.org; 5 May 2025 07:58:20 +0000 Received: from localhost ([127.0.0.1]:38278 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1uBqiR-0008Ss-Fn for submit@debbugs.gnu.org; Mon, 05 May 2025 03:58:20 -0400 Received: from confino.investici.org ([93.190.126.19]:60307) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1uBqiG-0008Re-SE for 76081@debbugs.gnu.org; Mon, 05 May 2025 03:58:11 -0400 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org; s=stigmate; t=1746431887; bh=Ub8YhXpnOQtdTL87qKNJEOV082EWZgVgJr5FfqgBc9c=; h=From:To:Cc:Subject:Date:In-Reply-To:References:From; b=N2Q73GVTjfl9geBSZ4jxfvlYpJINrwHCjsj7zWaC5//vmkLOjCcmslecrsSJfVLDv eBEdEb3n9NEe1jMfSFH1J2MaXMN07CGKGXadWfdpwr8rfO6h5YLnXLM680MC5ZfmSs 9IernMBKxWNxfZpe8dLyt+Gfw681k35mpaVfhonU= Received: from mx1.investici.org (unknown [127.0.0.1]) by confino.investici.org (Postfix) with ESMTP id 4ZrYmb6rCCz11Kq; Mon, 5 May 2025 07:58:07 +0000 (UTC) Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19]) (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with ESMTPSA id 4ZrYmb5k31z1193; Mon, 5 May 2025 07:58:07 +0000 (UTC) From: Giacomo Leidi Date: Mon, 5 May 2025 09:57:50 +0200 Message-ID: X-Mailer: git-send-email 2.49.0 In-Reply-To: <2b78b4ce9b0a3a6c0bdbdec5bb16702a5b5083a3.1746431874.git.goodoldpaul@autistici.org> References: <2b78b4ce9b0a3a6c0bdbdec5bb16702a5b5083a3.1746431874.git.goodoldpaul@autistici.org> MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit X-Spam-Score: -0.7 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.7 (-) * gnu/tests/docker.scm: Simplify %test-oci-container test case and add explicit timeouts to tests outcomes. --- gnu/tests/docker.scm | 99 ++++++++++++++++++-------------------------- 1 file changed, 41 insertions(+), 58 deletions(-) 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 ;;; Copyright © 2019-2023 Ludovic Courtès -;;; Copyright © 2024 Giacomo Leidi +;;; Copyright © 2024, 2025 Giacomo Leidi ;;; ;;; 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.49.0 From unknown Fri Jun 13 11:55:10 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#76081] [PATCH v10 5/7] tests: Use lower-oci-image-state in container tests. Resent-From: Giacomo Leidi Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Mon, 05 May 2025 07:59:04 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 76081 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 76081@debbugs.gnu.org Cc: Giacomo Leidi Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.174643190132554 (code B ref 76081); Mon, 05 May 2025 07:59:04 +0000 Received: (at 76081) by debbugs.gnu.org; 5 May 2025 07:58:21 +0000 Received: from localhost ([127.0.0.1]:38280 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1uBqiS-0008Sy-6b for submit@debbugs.gnu.org; Mon, 05 May 2025 03:58:20 -0400 Received: from confino.investici.org ([2a11:7980:1::2:0]:24233) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1uBqiH-0008Rg-KO for 76081@debbugs.gnu.org; Mon, 05 May 2025 03:58:11 -0400 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org; s=stigmate; t=1746431888; bh=ARfDk5ZxRNAIn3v/DozOaqIGhEwX6nP3gYi8qoILsBk=; h=From:To:Cc:Subject:Date:In-Reply-To:References:From; b=LLWJ68lFKr+GtBGCs3jCdkkq9Y6brOo4MPZ2S115fgCJ4mY/TPYkRkpv1ROL+JQN7 nIFlrPlgYQr7M/R1685VCMxb0CbLeU21JyDgdIMVUo9qZP7+TFEAubTUJKUCWsVRDz ITTJJsUJbg8hf7LgX6fAsI/x33jLQ63w3xEAPlNo= Received: from mx1.investici.org (unknown [127.0.0.1]) by confino.investici.org (Postfix) with ESMTP id 4ZrYmc5y5Hz11L3; Mon, 5 May 2025 07:58:08 +0000 (UTC) Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19]) (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with ESMTPSA id 4ZrYmc4sBdz11L0; Mon, 5 May 2025 07:58:08 +0000 (UTC) From: Giacomo Leidi Date: Mon, 5 May 2025 09:57:52 +0200 Message-ID: X-Mailer: git-send-email 2.49.0 In-Reply-To: <2b78b4ce9b0a3a6c0bdbdec5bb16702a5b5083a3.1746431874.git.goodoldpaul@autistici.org> References: <2b78b4ce9b0a3a6c0bdbdec5bb16702a5b5083a3.1746431874.git.goodoldpaul@autistici.org> MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Spam-Score: -0.0 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) This patch replaces boilerplate in container related tests with oci-image plumbing from (gnu services containers). * gnu/services/containers.scm: Export lower-oci-image-state. * gnu/tests/containers.scm (%oci-tarball): New variable; (run-rootless-podman-test): use %oci-tarball; (build-tarball&run-rootless-podman-test): drop procedure. * gnu/tests/docker.scm (%docker-tarball): New variable; (build-tarball&run-docker-test): use %docker-tarball; (%docker-system-tarball): New variable; (build-tarball&run-docker-system-test): new procedure. Change-Id: Iad6f0704aee188d89464c83722dea0bb7adb084a --- gnu/services/containers.scm | 2 + gnu/tests/containers.scm | 80 ++++++++++++++--------------- gnu/tests/docker.scm | 100 ++++++++++++++++++++---------------- 3 files changed, 95 insertions(+), 87 deletions(-) diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm index 66b46456800..a8d10d842da 100644 --- a/gnu/services/containers.scm +++ b/gnu/services/containers.scm @@ -74,6 +74,8 @@ (define-module (gnu services containers) oci-image-system oci-image-grafts? + lower-oci-image-state + oci-container-configuration oci-container-configuration? oci-container-configuration-fields diff --git a/gnu/tests/containers.scm b/gnu/tests/containers.scm index 5e6f39387e7..8cdd86e7ae3 100644 --- a/gnu/tests/containers.scm +++ b/gnu/tests/containers.scm @@ -69,13 +69,47 @@ (define %rootless-podman-os (supplementary-groups '("wheel" "netdev" "cgroup" "audio" "video"))))))) -(define (run-rootless-podman-test oci-tarball) +(define %oci-tarball + (lower-oci-image-state + "guile-guest" + (packages->manifest + (list + guile-3.0 guile-json-3 + (package + (name "guest-script") + (version "0") + (source #f) + (build-system trivial-build-system) + (arguments `(#:guile ,guile-3.0 + #:builder + (let ((out (assoc-ref %outputs "out"))) + (mkdir out) + (call-with-output-file (string-append out "/a.scm") + (lambda (port) + (display "(display \"hello world\n\")" port))) + #t))) + (synopsis "Display hello world using Guile") + (description "This package displays the text \"hello world\" on the +standard output device and then enters a new line.") + (home-page #f) + (license license:public-domain)))) + '(#:entry-point "bin/guile" + #:localstatedir? #t + #:extra-options (#:image-tag "guile-guest") + #:symlinks (("/bin/Guile" -> "bin/guile") + ("aa.scm" -> "a.scm"))) + "guile-guest" + (%current-target-system) + (%current-system) + #f)) + +(define (run-rootless-podman-test) (define os (marionette-operating-system (operating-system-with-gc-roots %rootless-podman-os - (list oci-tarball)) + (list %oci-tarball)) #:imported-modules '((gnu services herd) (guix combinators)))) @@ -254,7 +288,7 @@ (define (run-rootless-podman-test oci-tarball) (let* ((loaded (slurp ,(string-append #$podman "/bin/podman") "load" "-i" - ,#$oci-tarball)) + ,#$%oci-tarball)) (repository&tag "localhost/guile-guest:latest") (response1 (slurp ,(string-append #$podman "/bin/podman") @@ -307,49 +341,11 @@ (define (run-rootless-podman-test oci-tarball) (gexp->derivation "rootless-podman-test" test)) -(define (build-tarball&run-rootless-podman-test) - (mlet* %store-monad - ((_ (set-grafting #f)) - (guile (set-guile-for-build (default-guile))) - (guest-script-package -> - (package - (name "guest-script") - (version "0") - (source #f) - (build-system trivial-build-system) - (arguments `(#:guile ,guile-3.0 - #:builder - (let ((out (assoc-ref %outputs "out"))) - (mkdir out) - (call-with-output-file (string-append out "/a.scm") - (lambda (port) - (display "(display \"hello world\n\")" port))) - #t))) - (synopsis "Display hello world using Guile") - (description "This package displays the text \"hello world\" on the -standard output device and then enters a new line.") - (home-page #f) - (license license:public-domain))) - (profile (profile-derivation (packages->manifest - (list guile-3.0 guile-json-3 - guest-script-package)) - #:hooks '() - #:locales? #f)) - (tarball (pack:docker-image - "docker-pack" profile - #:symlinks '(("/bin/Guile" -> "bin/guile") - ("aa.scm" -> "a.scm")) - #:extra-options - '(#:image-tag "guile-guest") - #:entry-point "bin/guile" - #:localstatedir? #t))) - (run-rootless-podman-test tarball))) - (define %test-rootless-podman (system-test (name "rootless-podman") (description "Test rootless Podman service.") - (value (build-tarball&run-rootless-podman-test)))) + (value (run-rootless-podman-test)))) (define %oci-rootless-podman-os diff --git a/gnu/tests/docker.scm b/gnu/tests/docker.scm index 5dcf05a17e3..07edd9d5341 100644 --- a/gnu/tests/docker.scm +++ b/gnu/tests/docker.scm @@ -26,6 +26,7 @@ (define-module (gnu tests docker) #:use-module (gnu system image) #:use-module (gnu system vm) #:use-module (gnu services) + #:use-module (gnu services containers) #:use-module (gnu services dbus) #:use-module (gnu services networking) #:use-module (gnu services docker) @@ -57,6 +58,40 @@ (define %docker-os (service containerd-service-type) (service docker-service-type))) +(define %docker-tarball + (lower-oci-image-state + "guile-guest" + (packages->manifest + (list + guile-3.0 guile-json-3 + (package + (name "guest-script") + (version "0") + (source #f) + (build-system trivial-build-system) + (arguments `(#:guile ,guile-3.0 + #:builder + (let ((out (assoc-ref %outputs "out"))) + (mkdir out) + (call-with-output-file (string-append out "/a.scm") + (lambda (port) + (display "(display \"hello world\n\")" port))) + #t))) + (synopsis "Display hello world using Guile") + (description "This package displays the text \"hello world\" on the +standard output device and then enters a new line.") + (home-page #f) + (license license:public-domain)))) + '(#:entry-point "bin/guile" + #:localstatedir? #t + #:extra-options (#:image-tag "guile-guest") + #:symlinks (("/bin/Guile" -> "bin/guile") + ("aa.scm" -> "a.scm"))) + "guile-guest" + (%current-target-system) + (%current-system) + #f)) + (define (run-docker-test docker-tarball) "Load DOCKER-TARBALL as Docker image and run it in a Docker container, inside %DOCKER-OS." @@ -173,40 +208,7 @@ (define (run-docker-test docker-tarball) (gexp->derivation "docker-test" test)) (define (build-tarball&run-docker-test) - (mlet* %store-monad - ((_ (set-grafting #f)) - (guile (set-guile-for-build (default-guile))) - (guest-script-package -> - (package - (name "guest-script") - (version "0") - (source #f) - (build-system trivial-build-system) - (arguments `(#:guile ,guile-3.0 - #:builder - (let ((out (assoc-ref %outputs "out"))) - (mkdir out) - (call-with-output-file (string-append out "/a.scm") - (lambda (port) - (display "(display \"hello world\n\")" port))) - #t))) - (synopsis "Display hello world using Guile") - (description "This package displays the text \"hello world\" on the -standard output device and then enters a new line.") - (home-page #f) - (license license:public-domain))) - (profile (profile-derivation (packages->manifest - (list guile-3.0 guile-json-3 - guest-script-package)) - #:hooks '() - #:locales? #f)) - (tarball (pack:docker-image - "docker-pack" profile - #:symlinks '(("/bin/Guile" -> "bin/guile") - ("aa.scm" -> "a.scm")) - #:entry-point "bin/guile" - #:localstatedir? #t))) - (run-docker-test tarball))) + (run-docker-test %docker-tarball)) (define %test-docker (system-test @@ -215,8 +217,22 @@ (define %test-docker (value (build-tarball&run-docker-test)))) +(define %docker-system-tarball + (lower-oci-image-state + "guix-system-guest" + (operating-system + (inherit (simple-operating-system)) + ;; Use locales for a single libc to + ;; reduce space requirements. + (locale-libcs (list glibc))) + '() + "guix-system-guest" + (%current-target-system) + (%current-system) + #f)) + (define (run-docker-system-test tarball) - "Load DOCKER-TARBALL as Docker image and run it in a Docker container, + "Load TARBALL as Docker image and run it in a Docker container, inside %DOCKER-OS." (define os (marionette-operating-system @@ -333,21 +349,15 @@ (define (run-docker-system-test tarball) (gexp->derivation "docker-system-test" test)) +(define (build-tarball&run-docker-system-test) + (run-docker-system-test %docker-system-tarball)) + (define %test-docker-system (system-test (name "docker-system") (description "Run a system image as produced by @command{guix system docker-image} inside Docker.") - (value (with-monad %store-monad - (>>= (lower-object - (system-image (os->image - (operating-system - (inherit (simple-operating-system)) - ;; Use locales for a single libc to - ;; reduce space requirements. - (locale-libcs (list glibc))) - #:type docker-image-type))) - run-docker-system-test))))) + (value (build-tarball&run-docker-system-test)))) (define %oci-os -- 2.49.0 From unknown Fri Jun 13 11:55:10 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#76081] [PATCH v10 7/7] home: Add home-oci-service-type. Resent-From: Giacomo Leidi Original-Sender: "Debbugs-submit" Resent-CC: andrew@trop.in, gabriel@erlikon.ch, hako@ultrarare.space, janneke@gnu.org, ludo@gnu.org, maxim.cournoyer@gmail.com, tanguy@bioneland.org, guix-patches@gnu.org Resent-Date: Mon, 05 May 2025 07:59:04 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 76081 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 76081@debbugs.gnu.org Cc: Giacomo Leidi , Andrew Tropin , Gabriel Wicki , Hilton Chain , Janneke Nieuwenhuizen , Ludovic =?UTF-8?Q?Court=C3=A8s?= , Maxim Cournoyer , Tanguy Le Carrour X-Debbugs-Original-Xcc: Andrew Tropin , Gabriel Wicki , Hilton Chain , Janneke Nieuwenhuizen , Ludovic =?UTF-8?Q?Court=C3=A8s?= , Maxim Cournoyer , Tanguy Le Carrour Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.174643190232565 (code B ref 76081); Mon, 05 May 2025 07:59:04 +0000 Received: (at 76081) by debbugs.gnu.org; 5 May 2025 07:58:22 +0000 Received: from localhost ([127.0.0.1]:38282 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1uBqiT-0008T6-3R for submit@debbugs.gnu.org; Mon, 05 May 2025 03:58:21 -0400 Received: from confino.investici.org ([2a11:7980:1::2:0]:38291) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1uBqiI-0008Rs-Nh for 76081@debbugs.gnu.org; Mon, 05 May 2025 03:58:12 -0400 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org; s=stigmate; t=1746431889; bh=GjSoThHGAjYqXV22ZsTYGAbSuVZWgm8ExtgG8eE1E4U=; h=From:To:Cc:Subject:Date:In-Reply-To:References:From; b=YA3FMFX4WjnYZHpF+LOwkkqq8T3+dYKEyxJekNntLpIUbYI7uY7H+bsHdWWhRCMcU IbGM0UFae2tqDaVdGrwos2rDAi0b2hmzLh6qopnV3YD++qRvzRN+0v7cydUNzqr6lT 5vYB/oP2Z6m6pPgI8DyyxJN8i/dsN7vyOhm/T/9o= Received: from mx1.investici.org (unknown [127.0.0.1]) by confino.investici.org (Postfix) with ESMTP id 4ZrYmd5vXNz1193; Mon, 5 May 2025 07:58:09 +0000 (UTC) Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19]) (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with ESMTPSA id 4ZrYmd4gSdz11Bx; Mon, 5 May 2025 07:58:09 +0000 (UTC) From: Giacomo Leidi Date: Mon, 5 May 2025 09:57:54 +0200 Message-ID: <91c9920430684861541c86a01c28bd46423102c8.1746431874.git.goodoldpaul@autistici.org> X-Mailer: git-send-email 2.49.0 In-Reply-To: <2b78b4ce9b0a3a6c0bdbdec5bb16702a5b5083a3.1746431874.git.goodoldpaul@autistici.org> References: <2b78b4ce9b0a3a6c0bdbdec5bb16702a5b5083a3.1746431874.git.goodoldpaul@autistici.org> MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit X-Spam-Score: -0.0 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) * gnu/home/service/containers.scm: New file; * gnu/local.mk (GNU_SYSTEM_MODULES): Add it. * doc/guix.texi (OCI backed services): Document it. Change-Id: I8ce5b301e8032d0a7b2a9ca46752738cdee1f030 --- doc/guix.texi | 114 +++++++++++++++++++++++++++++++ gnu/home/services/containers.scm | 50 ++++++++++++++ gnu/local.mk | 1 + 3 files changed, 165 insertions(+) create mode 100644 gnu/home/services/containers.scm diff --git a/doc/guix.texi b/doc/guix.texi index de0d7ccfd5a..3f4da28af72 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -51429,6 +51429,120 @@ Miscellaneous Home Services (dicod-configuration @dots{}))) @end lisp +@subsubheading OCI backed services + +@cindex OCI-backed, for Home +The @code{(gnu home services containers)} module provides the following service: + +@defvar home-oci-service-type +This is the type of the service that allows to manage your OCI containers with +the same consistent interface you use for your other Home Shepherd services. +@end defvar + +This service is a direct mapping of the @code{oci-service-type} system +service (@pxref{Miscellaneous Services, OCI backed services}). You can +use it like this: + +@lisp +(use-modules (gnu services containers) + (gnu home services containers)) + +(simple-service 'home-oci-provisioning + home-oci-service-type + (oci-extension + (volumes + (list + (oci-volume-configuration (name "prometheus")) + (oci-volume-configuration (name "grafana")))) + (networks + (list + (oci-network-configuration (name "monitoring")))) + (containers + (list + (oci-container-configuration + (network "monitoring") + (image + (oci-image + (repository "guile") + (tag "3") + (value (specifications->manifest '("guile"))) + (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile")) + #:max-layers 2)))) + (entrypoint "/bin/guile") + (command + '("-c" "(display \"hello!\n\")"))) + (oci-container-configuration + (image "prom/prometheus") + (network "monitoring") + (ports + '(("9000" . "9000") + ("9090" . "9090"))) + (volumes + (list + '(("prometheus" . "/var/lib/prometheus"))))) + (oci-container-configuration + (image "grafana/grafana:10.0.1") + (network "monitoring") + (volumes + '(("grafana:/var/lib/grafana")))))))) + +@end lisp + +You may specify a custom configuration by providing a +@code{oci-configuration} record, exactly like for +@code{oci-service-type}, but wrapping it in @code{for-home}: + +@lisp +(use-modules (gnu services) + (gnu services containers) + (gnu home services containers)) + +(service home-oci-service-type + (for-home + (oci-configuration + (runtime 'podman) + (verbose? #t)))) + +(simple-service 'home-oci-provisioning + home-oci-service-type + (oci-extension + (volumes + (list + (oci-volume-configuration (name "prometheus")) + (oci-volume-configuration (name "grafana")))) + (networks + (list + (oci-network-configuration (name "monitoring")))) + (containers + (list + (oci-container-configuration + (network "monitoring") + (image + (oci-image + (repository "guile") + (tag "3") + (value (specifications->manifest '("guile"))) + (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile")) + #:max-layers 2)))) + (entrypoint "/bin/guile") + (command + '("-c" "(display \"hello!\n\")"))) + (oci-container-configuration + (image "prom/prometheus") + (network "monitoring") + (ports + '(("9000" . "9000") + ("9090" . "9090"))) + (volumes + (list + '(("prometheus" . "/var/lib/prometheus"))))) + (oci-container-configuration + (image "grafana/grafana:10.0.1") + (network "monitoring") + (volumes + '(("grafana:/var/lib/grafana")))))))) +@end lisp + @node Invoking guix home @section Invoking @command{guix home} diff --git a/gnu/home/services/containers.scm b/gnu/home/services/containers.scm new file mode 100644 index 00000000000..938dde2f37a --- /dev/null +++ b/gnu/home/services/containers.scm @@ -0,0 +1,50 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2025 Giacomo Leidi +;;; +;;; 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 . + +(define-module (gnu home services containers) + #:use-module (gnu home services) + #:use-module (gnu home services shepherd) + #:use-module (gnu services) + #:use-module (gnu services configuration) + #:use-module (gnu services containers) + #:use-module (guix gexp) + #:use-module (guix packages) + #:use-module (srfi srfi-1) + #:export (home-oci-service-type)) + +(define home-oci-service-type + (service-type (inherit (system->home-service-type oci-service-type)) + (extensions + (list + (service-extension home-profile-service-type + (oci-service-extension-wrap-validate + (lambda (config) + (let ((runtime-cli + (oci-configuration-runtime-cli config)) + (runtime + (oci-configuration-runtime config))) + (oci-service-profile runtime runtime-cli))))) + (service-extension home-shepherd-service-type + (oci-service-extension-wrap-validate + oci-configuration->shepherd-services)))) + (extend + (lambda (config extension) + (for-home + (oci-configuration + (inherit (oci-configuration-extend config extension)))))) + (default-value (for-home (oci-configuration))))) diff --git a/gnu/local.mk b/gnu/local.mk index e25fcc115be..1be38d6e217 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -103,6 +103,7 @@ GNU_SYSTEM_MODULES = \ %D%/home.scm \ %D%/home/services.scm \ %D%/home/services/admin.scm \ + %D%/home/services/containers.scm \ %D%/home/services/desktop.scm \ %D%/home/services/dict.scm \ %D%/home/services/dotfiles.scm \ -- 2.49.0 From unknown Fri Jun 13 11:55:10 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#76081] [PATCH v10 2/7] services: oci-container-configuration: Move to (gnu services containers). Resent-From: Giacomo Leidi Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Mon, 05 May 2025 07:59:05 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 76081 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 76081@debbugs.gnu.org Cc: Giacomo Leidi Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.174643190432574 (code B ref 76081); Mon, 05 May 2025 07:59:05 +0000 Received: (at 76081) by debbugs.gnu.org; 5 May 2025 07:58:24 +0000 Received: from localhost ([127.0.0.1]:38284 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1uBqiT-0008TC-SE for submit@debbugs.gnu.org; Mon, 05 May 2025 03:58:24 -0400 Received: from confino.investici.org ([2a11:7980:1::2:0]:40745) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1uBqiG-0008Rc-FB for 76081@debbugs.gnu.org; Mon, 05 May 2025 03:58:13 -0400 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org; s=stigmate; t=1746431887; bh=gLbNxX/Rr463F7DB8fOCHxdTIo0Xof4vZccQyml0Dh4=; h=From:To:Cc:Subject:Date:In-Reply-To:References:From; b=A2F5HrH9hm4zG5V9ff/bj0xxfn/SfAf3vHTb2LfdQ6ZpNNX+FDdlDra3vcW3Il5br r18/l9ADuMnGCFHWVW1BfcSR17BgZD3NTCIyeRhsE5HdiZ9KYz4TlD5PcAvDION2aI UYBcQO/nuXfvaJgGTGb/udIS1CE7LcJ1zfi/5S1w= Received: from mx1.investici.org (unknown [127.0.0.1]) by confino.investici.org (Postfix) with ESMTP id 4ZrYmb47lDz11Kk; Mon, 5 May 2025 07:58:07 +0000 (UTC) Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19]) (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with ESMTPSA id 4ZrYmb2bBcz1193; Mon, 5 May 2025 07:58:07 +0000 (UTC) From: Giacomo Leidi Date: Mon, 5 May 2025 09:57:49 +0200 Message-ID: X-Mailer: git-send-email 2.49.0 In-Reply-To: <2b78b4ce9b0a3a6c0bdbdec5bb16702a5b5083a3.1746431874.git.goodoldpaul@autistici.org> References: <2b78b4ce9b0a3a6c0bdbdec5bb16702a5b5083a3.1746431874.git.goodoldpaul@autistici.org> MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit X-Spam-Score: -0.0 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) 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. Change-Id: Iae599dd5cc7442eb632f0c1b3b12f6b928397ae7 --- gnu/services/containers.scm | 549 +++++++++++++++++++++++++++++++++- gnu/services/docker.scm | 577 +++--------------------------------- 2 files changed, 584 insertions(+), 542 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 +;;; Copyright © 2024, 2025 Giacomo Leidi ;;; ;;; This file is part of GNU Guix. ;;; @@ -17,19 +17,31 @@ ;;; along with GNU Guix. If not, see . (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 ;;; Copyright © 2020 Jesse Dowell ;;; Copyright © 2021 Brice Waegeneire -;;; Copyright © 2023, 2024 Giacomo Leidi +;;; Copyright © 2023, 2024, 2025 Giacomo Leidi ;;; ;;; This file is part of GNU Guix. ;;; @@ -23,72 +23,60 @@ ;;; along with GNU Guix. If not, see . (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)) -- 2.49.0 From unknown Fri Jun 13 11:55:10 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#76081] [PATCH v10 6/7] services: oci: Migrate oci-configuration to (guix records). Resent-From: Giacomo Leidi Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Mon, 05 May 2025 07:59:05 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 76081 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 76081@debbugs.gnu.org Cc: Giacomo Leidi Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.174643190532581 (code B ref 76081); Mon, 05 May 2025 07:59:05 +0000 Received: (at 76081) by debbugs.gnu.org; 5 May 2025 07:58:25 +0000 Received: from localhost ([127.0.0.1]:38286 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1uBqiW-0008TM-ES for submit@debbugs.gnu.org; Mon, 05 May 2025 03:58:25 -0400 Received: from confino.investici.org ([93.190.126.19]:51341) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1uBqiI-0008Rp-Ni for 76081@debbugs.gnu.org; Mon, 05 May 2025 03:58:13 -0400 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org; s=stigmate; t=1746431889; bh=2rKDRRmVHhOae7rEY88xph6nJ6AWx2gQOUzmsOUtq0A=; h=From:To:Cc:Subject:Date:In-Reply-To:References:From; b=tbi/gSQQ3QnTkImDAoyMLVxMAshSmXvgljlDD9/AL802DbG/vavfHgj/+4zqfta3b Xryr+Qm2QAg2rS0MuETz3WFt9AlOcuhmkFAdzrmOWK+YG+KmN1JUnPwb8fq1hJ6Fiw YY/lIWHPRpBruAIGLgOf3NNkinaIrlnord4yZTOg= Received: from mx1.investici.org (unknown [127.0.0.1]) by confino.investici.org (Postfix) with ESMTP id 4ZrYmd2sS5z11L0; Mon, 5 May 2025 07:58:09 +0000 (UTC) Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19]) (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with ESMTPSA id 4ZrYmd1dhHz11Bx; Mon, 5 May 2025 07:58:09 +0000 (UTC) From: Giacomo Leidi Date: Mon, 5 May 2025 09:57:53 +0200 Message-ID: <1f148e2994e78ed4614efe885380c06740515d0b.1746431874.git.goodoldpaul@autistici.org> X-Mailer: git-send-email 2.49.0 In-Reply-To: <2b78b4ce9b0a3a6c0bdbdec5bb16702a5b5083a3.1746431874.git.goodoldpaul@autistici.org> References: <2b78b4ce9b0a3a6c0bdbdec5bb16702a5b5083a3.1746431874.git.goodoldpaul@autistici.org> MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Spam-Score: -0.7 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.7 (-) This commit migrates oci-configuration to (guix records) singe it appears (for-home (oci-configuration ...)) does not work as expected with (gnu services configuration). This is supposed to be completely transparent for users and can be reverted in the future once this has been implemented. * gnu/service/containers.scm: Migrate oci-configuration to (guix records). --- gnu/services/containers.scm | 199 +++++++++++++++++++++--------------- 1 file changed, 117 insertions(+), 82 deletions(-) diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm index a8d10d842da..a974227e164 100644 --- a/gnu/services/containers.scm +++ b/gnu/services/containers.scm @@ -39,6 +39,7 @@ (define-module (gnu services containers) #:use-module (guix packages) #:use-module (guix profiles) #:use-module ((guix scripts pack) #:prefix pack:) + #:use-module (guix records) #:use-module (guix store) #:use-module (srfi srfi-1) #:use-module (ice-9 format) @@ -168,6 +169,7 @@ (define-module (gnu services containers) oci-container-shepherd-service oci-objects-merge-lst oci-extension-merge + oci-service-extension-wrap-validate oci-service-type oci-service-accounts oci-service-profile @@ -395,7 +397,7 @@ (define (oci-runtime-name runtime) (define (oci-runtime-group runtime maybe-group) "Implement the logic behind selection of the group that is to be used by Shepherd to execute OCI commands." - (if (not (maybe-value-set? maybe-group)) + (if (eq? maybe-group #f) (if (eq? 'podman runtime) "cgroup" "docker") @@ -766,62 +768,74 @@ (define (list-of-oci-networks? value) (define (package-or-string? value) (or (package? value) (string? value))) -(define-maybe/no-serialization package-or-string) - -(define-configuration/no-serialization oci-configuration - (runtime - (symbol 'docker) - "The OCI runtime to use to run commands. It can be either @code{'docker} or -@code{'podman}." - (sanitizer oci-sanitize-runtime)) - (runtime-cli - (maybe-package-or-string) - "The OCI runtime command line to be installed in the system profile and used -to provision OCI resources, it can be either a package or a string representing -an absolute path to the runtime binary entrypoint. When unset it will default -to @code{docker-cli} package for the @code{'docker} runtime or to @code{podman} -package for the @code{'podman} runtime.") - (runtime-extra-arguments - (list '()) - "A list of strings, gexps or file-like objects that will be placed -after each @command{docker} or @command{podman} invokation.") - (user - (string "oci-container") - "The user name under whose authority OCI runtime commands will be run.") - (group - (maybe-string) - "The group name under whose authority OCI commands will be run. When -using the @code{'podman} OCI runtime, this field will be ignored and the -default group of the user configured in the @code{user} field will be used.") - (subuids-range - (maybe-subid-range) - "An optional @code{subid-range} record allocating subuids for the user from -the @code{user} field. When unset, with the rootless Podman OCI runtime, it -defaults to @code{(subid-range (name \"oci-container\"))}.") - (subgids-range - (maybe-subid-range) - "An optional @code{subid-range} record allocating subgids for the user from -the @code{user} field. When unset, with the rootless Podman OCI runtime, it -defaults to @code{(subid-range (name \"oci-container\"))}.") - (containers - (list-of-oci-containers '()) - "The list of @code{oci-container-configuration} records representing the -containers to provision. Most users are supposed not to use this field and use -the @code{oci-extension} record instead.") - (networks - (list-of-oci-networks '()) - "The list of @code{oci-network-configuration} records representing the -networks to provision. Most users are supposed not to use this field and use -the @code{oci-extension} record instead.") - (volumes - (list-of-oci-volumes '()) - "The list of @code{oci-volume-configuration} records representing the -volumes to provision. Most users are supposed not to use this field and use -the @code{oci-extension} record instead.") - (verbose? - (boolean #f) - "When true, additional output will be printed, allowing to better follow the -flow of execution.")) +;; (for-home (oci-configuration ...)) is not able to replace for-home? with #t, +;; pk prints #f. Once for-home will be able to work with (gnu services configuration) the +;; record can be migrated back to define-configuration. +(define-record-type* + oci-configuration + make-oci-configuration + oci-configuration? + this-oci-configuration + + (runtime oci-configuration-runtime + (default 'docker)) + (runtime-cli oci-configuration-runtime-cli + (default #f)) ; package or string + (runtime-extra-arguments oci-configuration-runtime-extra-arguments ; strings or gexps + (default '())) ; or file-like objects + (user oci-configuration-user + (default "oci-container")) + (group oci-configuration-group ; string + (default #f)) + (subuids-range oci-configuration-subuids-range ; subid-range + (default #f)) + (subgids-range oci-configuration-subgids-range ; subid-range + (default #f)) + (containers oci-configuration-containers ; oci-container-configurations + (default '())) + (networks oci-configuration-networks ; oci-network-configurations + (default '())) + (volumes oci-configuration-volumes ; oci-volume-configurations + (default '())) + (verbose? oci-configuration-verbose? + (default #f)) + (home-service? oci-configuration-home-service? + (default for-home?) (innate))) + +;; TODO: This procedure can be dropped once we switch to define-configuration for +;; oci-configuration. +(define (oci-configuration-valid? config) + (define runtime-cli + (oci-configuration-runtime-cli config)) + (define group + (oci-configuration-group config)) + (define subuids-range + (oci-configuration-subuids-range config)) + (define subgids-range + (oci-configuration-subgids-range config)) + (and + (symbol? + (oci-sanitize-runtime (oci-configuration-runtime config))) + (or (eq? runtime-cli #f) + (package-or-string? runtime-cli)) + (list? (oci-configuration-runtime-extra-arguments config)) + (string? (oci-configuration-user config)) + (or (eq? group #f) + (string? group)) + (or (eq? subuids-range #f) + (subid-range? subuids-range)) + (or (eq? subgids-range #f) + (subid-range? subgids-range)) + (list-of-oci-containers? + (oci-configuration-containers config)) + (list-of-oci-networks? + (oci-configuration-networks config)) + (list-of-oci-volumes? + (oci-configuration-volumes config)) + (boolean? + (oci-configuration-verbose? config)) + (boolean? + (oci-configuration-home-service? config)))) (define (oci-runtime-system-environment runtime user) (if (eq? runtime 'podman) @@ -837,7 +851,7 @@ (define (oci-runtime-cli runtime runtime-cli path) ;; It is a user defined absolute path runtime-cli #~(string-append - #$(if (not (maybe-value-set? runtime-cli)) + #$(if (eq? runtime-cli #f) path runtime-cli) #$(if (eq? 'podman runtime) @@ -1581,18 +1595,27 @@ (define (oci-configuration->shepherd-services config) (passwd:gid (getpwnam #$user)))) (oci-runtime-group config (oci-configuration-group config)))) - (verbose? (oci-configuration-verbose? config))) - (oci-state->shepherd-services runtime system-runtime-cli containers networks volumes - #:user user - #:group group - #:verbose? verbose? - #:runtime-extra-arguments - runtime-extra-arguments - #:runtime-environment - (oci-runtime-system-environment runtime user) - #:runtime-requirement - (oci-runtime-system-requirement runtime) - #:networks-requirement '(networking)))) + (verbose? (oci-configuration-verbose? config)) + (home-service? + (oci-configuration-home-service? config))) + (if home-service? + (oci-state->shepherd-services runtime home-runtime-cli containers networks volumes + #:verbose? verbose? + #:networks-name + (oci-networks-home-shepherd-name runtime) + #:volumes-name + (oci-volumes-home-shepherd-name runtime)) + (oci-state->shepherd-services runtime system-runtime-cli containers networks volumes + #:user user + #:group group + #:verbose? verbose? + #:runtime-extra-arguments + runtime-extra-arguments + #:runtime-environment + (oci-runtime-system-environment runtime user) + #:runtime-requirement + (oci-runtime-system-requirement runtime) + #:networks-requirement '(networking))))) (define (oci-service-subids config) "Return a subids-extension record representing subuids and subgids required by @@ -1620,14 +1643,14 @@ (define (oci-service-subids config) (define subgid-ranges (delete-duplicate-ranges (cons - (if (not (maybe-value-set? subgids)) + (if (eq? subgids #f) (subid-range (name user)) subgids) container-users))) (define subuid-ranges (delete-duplicate-ranges (cons - (if (not (maybe-value-set? subuids)) + (if (eq? subuids #f) (subid-range (name user)) subuids) container-users))) @@ -1686,13 +1709,21 @@ (define (oci-service-profile runtime runtime-cli) '() (list (cond - ((maybe-value-set? runtime-cli) + ((not (eq? runtime-cli #f)) runtime-cli) ((eq? 'podman runtime) podman) (else docker-cli)))))) +(define (oci-service-extension-wrap-validate extension) + (lambda (config) + (if (oci-configuration-valid? config) + (extension config) + (raise + (formatted-message + (G_ "Invalide oci-configuration ~a.") config))))) + (define (oci-configuration-extend config extension) (oci-configuration (inherit config) @@ -1721,18 +1752,22 @@ (define oci-service-type (extensions (list (service-extension profile-service-type - (lambda (config) - (let ((runtime-cli - (oci-configuration-runtime-cli config)) - (runtime - (oci-configuration-runtime config))) - (oci-service-profile runtime runtime-cli)))) + (oci-service-extension-wrap-validate + (lambda (config) + (let ((runtime-cli + (oci-configuration-runtime-cli config)) + (runtime + (oci-configuration-runtime config))) + (oci-service-profile runtime runtime-cli))))) (service-extension subids-service-type - oci-service-subids) + (oci-service-extension-wrap-validate + oci-service-subids)) (service-extension account-service-type - oci-service-accounts) + (oci-service-extension-wrap-validate + oci-service-accounts)) (service-extension shepherd-root-service-type - oci-configuration->shepherd-services))) + (oci-service-extension-wrap-validate + oci-configuration->shepherd-services)))) ;; Concatenate OCI object lists. (compose (lambda (args) (fold oci-extension-merge -- 2.49.0 From unknown Fri Jun 13 11:55:10 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#76081] [PATCH v10 1/7] services: rootless-podman: Use login shell. Resent-From: Maxim Cournoyer Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Thu, 15 May 2025 04:55:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 76081 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: Giacomo Leidi Cc: 76081@debbugs.gnu.org Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.17472848494765 (code B ref 76081); Thu, 15 May 2025 04:55:01 +0000 Received: (at 76081) by debbugs.gnu.org; 15 May 2025 04:54:09 +0000 Received: from localhost ([127.0.0.1]:49320 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1uFQbg-0001El-Kq for submit@debbugs.gnu.org; Thu, 15 May 2025 00:54:09 -0400 Received: from mail-pf1-x42c.google.com ([2607:f8b0:4864:20::42c]:50496) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.84_2) (envelope-from ) id 1uFQbf-0001Du-Bz for 76081@debbugs.gnu.org; Thu, 15 May 2025 00:54:07 -0400 Received: by mail-pf1-x42c.google.com with SMTP id d2e1a72fcca58-73712952e1cso527342b3a.1 for <76081@debbugs.gnu.org>; Wed, 14 May 2025 21:54:07 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20230601; t=1747284841; x=1747889641; darn=debbugs.gnu.org; h=mime-version:user-agent:message-id:date:references:in-reply-to :subject:cc:to:from:from:to:cc:subject:date:message-id:reply-to; bh=aZ63FHPiiPdPBAc50s5EY0M/gLJK6ngiyYYYr6Wtux4=; b=ESUMCPp7eQL9LKRZfFBV3urSzkRzb6C6E1jTGLbrczTB/QJ5mQuMVfWR/F1y0K95rB 16ob9Aat4sSdAklzL8MgNk80wD40xavx6fQKCuiMmnUgpYxTQ5A0L8KueynYvLgu3MQT sL1SpvV2jsf2PX/+0va1rELVeDn8Bcn/RPkDaDabo7SJVdvT0PXc3fcHs8I7/3+EAyuU nsLFg90YF2rN7QQ4oK2kaInSl8aLeer99GUS07yXaKTsf4ElTcZhjQvRf85/mggJMWSw dSPQotNPvNOK27/JfeIYz4hzpjWw4Vs9wI8Vl80W/VRHgmOY/PNEZbMsPVclklEW9hvR GCZQ== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1747284841; x=1747889641; h=mime-version:user-agent:message-id:date:references:in-reply-to :subject:cc:to:from:x-gm-message-state:from:to:cc:subject:date :message-id:reply-to; bh=aZ63FHPiiPdPBAc50s5EY0M/gLJK6ngiyYYYr6Wtux4=; b=WTWp5seuPxaSIR+NYX7a1pt6QUC/jNM91NvoH18ffyBKxT8Bwts0j1o9MBhqyw8zCL HhCPx9V8OJ+2H3HXZIRFeRcFjW9oulXTQpLoLKpHJqnTEKRhFLdo3UfuZ4m5PoidNiY+ ppvSy3qBXaJS4+0eN3swAAKaNq5lzNcIt7NrLLhRVJtKLdLx/YgWEw+bu4LxMUF8ZxFJ DdMlEEkWLwnS/48YwYxnwRcu5bW60lEkp8z5WoUjsgUmk4AOmNkGBBYXzAF3kiXxJ+vY oTRqH27nXO6JXTtKQxFHzrzcVJONim6njxz+sieyiwkmdtjbTmGnNQhSNoOeO4GIfeD6 2aaA== X-Gm-Message-State: AOJu0Yx+wbV8BnyGc20twQaHPvrHbnHfBhcMCSSSO0wpVlymyWhwCiGl tl+Hckm8uWSQcaQHlSZ7hn64MEbDukKy8w7SysNY9JJtEdXFq8UNT0bawY0v X-Gm-Gg: ASbGncvDc7Q1lNt9Sw9//qQe6RSSxRUqfEX1LwSLXBi9dlRx7yJa4W85bzWyWm5dIzi tWX0TF249LZfmcMi0PvEZx/ZCSuZtrmHgzNOJjRvNiPEpZ4HOOlCGvXSewlgLewWBEKSURbGXKZ RKZViIwle+B6qu5iu1q4Qd7KecLIU3Lt4Rwz5y1mpTmeQ+YFRF/UZCgqYNmRh33DIpLCE7r/vKQ o2kjZCRab1LfcjCm7Pg+j9SO2AVxhBlKPs4iqrSTyYtDw5k8Glakz1GhKaD7FGWNWTj137NTGKz QWHA6wIz7NaUwBEnQCOmJJVnRcs/Rkavawx6PwnWUXvVWb3Vcg== X-Google-Smtp-Source: AGHT+IHvLC/JfWLd3NvxR3cpY4N1z+RMh+a4ljntJQiQiPdfBAjLphoKpPGlZbWPsKLJwpt2WLxqzQ== X-Received: by 2002:a05:6a21:6da3:b0:201:2834:6c62 with SMTP id adf61e73a8af0-216115589f9mr1392863637.25.1747284840717; Wed, 14 May 2025 21:54:00 -0700 (PDT) Received: from terra ([2405:6586:be0:0:83c8:d31d:2cec:f542]) by smtp.gmail.com with ESMTPSA id d2e1a72fcca58-74237a0f14csm10681744b3a.107.2025.05.14.21.53.59 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Wed, 14 May 2025 21:54:00 -0700 (PDT) From: Maxim Cournoyer In-Reply-To: <2b78b4ce9b0a3a6c0bdbdec5bb16702a5b5083a3.1746431874.git.goodoldpaul@autistici.org> (Giacomo Leidi's message of "Mon, 5 May 2025 09:57:48 +0200") References: <2f43e635-508c-407a-8309-06e75d492d89@autistici.org> <2b78b4ce9b0a3a6c0bdbdec5bb16702a5b5083a3.1746431874.git.goodoldpaul@autistici.org> Date: Thu, 15 May 2025 13:53:57 +0900 Message-ID: <878qmyjwyi.fsf@gmail.com> User-Agent: Gnus/5.13 (Gnus v5.13) MIME-Version: 1.0 Content-Type: text/plain X-Spam-Score: 0.0 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) Hi, Giacomo Leidi writes: > This commit allows for having PATH set when changing the owner of > /sys/fs/group. > > * gnu/services/containers.scm (crgroups-fs-owner): Use login shell. > > Change-Id: I9510c637a5332325e05ca5ebc9dfd4de32685c50 > --- > gnu/services/containers.scm | 2 +- > 1 file changed, 1 insertion(+), 1 deletion(-) > > diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm > index b3cd109ce6c..d5a211765a6 100644 > --- a/gnu/services/containers.scm > +++ b/gnu/services/containers.scm > @@ -140,7 +140,7 @@ (define (cgroups-fs-owner-entrypoint config) > (rootless-podman-configuration-group-name config)) > (program-file "cgroups2-fs-owner-entrypoint" > #~(system* > - (string-append #+bash-minimal "/bin/bash") "-c" > + (string-append #+bash-minimal "/bin/bash") "-l" "-c" > (string-append "echo Setting /sys/fs/cgroup " > "group ownership to " #$group " && chown -v " > "root:" #$group " /sys/fs/cgroup && " > > base-commit: 63088c295d81cc3d0e808c478d4fe479a2c90102 I pushed this one. -- Thanks, Maxim From unknown Fri Jun 13 11:55:10 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#76081] [PATCH v10 2/7] services: oci-container-configuration: Move to (gnu services containers). Resent-From: Maxim Cournoyer Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Thu, 15 May 2025 04:55:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 76081 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: Giacomo Leidi Cc: 76081@debbugs.gnu.org Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.17472848664842 (code B ref 76081); Thu, 15 May 2025 04:55:02 +0000 Received: (at 76081) by debbugs.gnu.org; 15 May 2025 04:54:26 +0000 Received: from localhost ([127.0.0.1]:49326 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1uFQby-0001G0-7C for submit@debbugs.gnu.org; Thu, 15 May 2025 00:54:26 -0400 Received: from mail-pl1-x62a.google.com ([2607:f8b0:4864:20::62a]:51215) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.84_2) (envelope-from ) id 1uFQbv-0001FI-Aa for 76081@debbugs.gnu.org; Thu, 15 May 2025 00:54:23 -0400 Received: by mail-pl1-x62a.google.com with SMTP id d9443c01a7336-22c33677183so4571165ad.2 for <76081@debbugs.gnu.org>; Wed, 14 May 2025 21:54:23 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20230601; t=1747284857; x=1747889657; darn=debbugs.gnu.org; h=mime-version:user-agent:message-id:date:references:in-reply-to :subject:cc:to:from:from:to:cc:subject:date:message-id:reply-to; bh=zsANYmZBsOl6O7Iao6isXFdhI85ZgG7r7nVXTMeKyK4=; b=EdsheELp8CXPcD9xbz4qlUnxDb+i05FtFkwlmftAUtZYr67IVEwXZiyIYxBl+JY3vo xKTl9Zn+HLHIj9L6ff9TJHYBneW64tr+TIHy0/odong6yihtH1cd5xa/YOPdZuwlsWGm OVAmJrwIGbYk4CQi+XgEE3xyo14T/PRk3VyxP2Fg7r/+fiHjkbMiIH03UaF/rvdCJRZg hcYE40FXgGj9EdtF+ZYvx4V7YdPHQIKXVooOaOXVr3/ny9Xj37NgLee84XKRjtoMEeLJ YybhyToJY3lVIrZbMr8IKvNI4Vr/1loIG7rwXqV5qpw4oJV0KdpnybSusWvolEsn3atS 6brw== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1747284857; x=1747889657; h=mime-version:user-agent:message-id:date:references:in-reply-to :subject:cc:to:from:x-gm-message-state:from:to:cc:subject:date :message-id:reply-to; bh=zsANYmZBsOl6O7Iao6isXFdhI85ZgG7r7nVXTMeKyK4=; b=CKCX61KoiRsHjOne0sfJOTOOLI/oDAq0dhRdJVMJsqbisy3FcGvMXPjCWgTeTMwIoc 6DIfDCu3OhYemZMV9DedDDnaVpKUMeVrw5MVAKm3CSSKdR6CEtbmKQImxipvTqKJe0l8 aHhgPybVn84YZZ8Oi0/CIgF2pgX13fqkDu1AXzTd3pSchX2HZG0MDzfIkPvfhd8hbWvm t8YcfnLv52tJiAisSFcQtX4tu4YO+wRffDBa9ZAaDn1xfr8cWhvibsfkfU7ic1UzLMDD PAmCWBQ5kzKkIBNTVHumu91JEkNi++dNQrbQMTAqWL7LPadL21QKMw2PHCvfEWviEc81 SxCg== X-Gm-Message-State: AOJu0YxiQGkeYTwdHtu68U3TWBfXvNOd/V1KACWU/Z+nuueVELldn9F+ 7H+r7jG7VWV14n+cVx9vlmvIbCPLdBoHmDxpz8oNd8SHHxxmXbheHyfiEPNh X-Gm-Gg: ASbGncsUOIyRlW/ki2cxTA+n/r6b+2EkIzH8gp1ph//B2mL6xfLgspL49Q2hXjHSRmy LGyZKKYO7bR5n+QTYLyPOZhUep82d4+Pb8JccmdX+qWECLEKMGnn/C0JlOocDyS6z9N7Bjgpppd woFUKdWQiktUpGd4qOyHG8p4of5fRWyhXPsAstQcDDze4IbZ5bCDMfwhk4mmjljI/49EWFXiCLh Q0KzydHK5Z4JzwvdtbHSfsqQVrdvNlx4sOPsKh8QCGu2mMSyp/OKZKg6q6nUPHDMI7ztMxXvXFA eQjFxBnG0Rej0m5il4QeVdSgxhtqbIN999TTN3LflCD1S4CSkg== X-Google-Smtp-Source: AGHT+IHk9SJwx+aJT6BX+EchF7AiFrXL6Fiw1z1D8chTut2DDNzm0EsNqseQhH0pU8G8bgFbvhILAQ== X-Received: by 2002:a17:903:1744:b0:21b:d2b6:ca7f with SMTP id d9443c01a7336-231b5ea080dmr14732855ad.32.1747284856831; Wed, 14 May 2025 21:54:16 -0700 (PDT) Received: from terra ([2405:6586:be0:0:83c8:d31d:2cec:f542]) by smtp.gmail.com with ESMTPSA id d9443c01a7336-22fc75490f8sm107484145ad.42.2025.05.14.21.54.15 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Wed, 14 May 2025 21:54:16 -0700 (PDT) From: Maxim Cournoyer In-Reply-To: (Giacomo Leidi's message of "Mon, 5 May 2025 09:57:49 +0200") References: <2b78b4ce9b0a3a6c0bdbdec5bb16702a5b5083a3.1746431874.git.goodoldpaul@autistici.org> Date: Thu, 15 May 2025 13:54:14 +0900 Message-ID: <874ixmjwy1.fsf@gmail.com> User-Agent: Gnus/5.13 (Gnus v5.13) MIME-Version: 1.0 Content-Type: text/plain X-Spam-Score: 0.0 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) Hi, Giacomo Leidi writes: > 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. This one also. -- Thanks, Maxim From unknown Fri Jun 13 11:55:10 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#76081] [PATCH v10 3/7] tests: oci-container: Set explicit timeouts. Resent-From: Maxim Cournoyer Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Thu, 15 May 2025 07:23:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 76081 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: Giacomo Leidi Cc: 76081@debbugs.gnu.org Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.17472937338006 (code B ref 76081); Thu, 15 May 2025 07:23:01 +0000 Received: (at 76081) by debbugs.gnu.org; 15 May 2025 07:22:13 +0000 Received: from localhost ([127.0.0.1]:50501 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1uFSuz-000252-9c for submit@debbugs.gnu.org; Thu, 15 May 2025 03:22:13 -0400 Received: from mail-pl1-x632.google.com ([2607:f8b0:4864:20::632]:59603) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.84_2) (envelope-from ) id 1uFSuu-00024l-LO for 76081@debbugs.gnu.org; Thu, 15 May 2025 03:22:09 -0400 Received: by mail-pl1-x632.google.com with SMTP id d9443c01a7336-22e4d235811so7804265ad.2 for <76081@debbugs.gnu.org>; Thu, 15 May 2025 00:22:08 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20230601; t=1747293722; x=1747898522; darn=debbugs.gnu.org; h=mime-version:user-agent:message-id:date:references:in-reply-to :subject:cc:to:from:from:to:cc:subject:date:message-id:reply-to; bh=1t3rbwdEY/hFpl9ghLOPKLi/SuEGxwLfbSrjYxfwkh0=; b=EtYYvz1ywbMLLvypgaG3YwYA/qeFXq1H+1t0TvvW/f1VYH5H41Zb5QGXBparvgjPs5 HJC5ixO84iXB08cntSZrui2M8jUppmCJGSxjaRBJ3x6+SPP33I3PcuGKn5d0xjchVZz3 aTeYYBbAwut1AQpCXKTWuKdH5TWkIbDJ/z/3SCxAEzHDVWoWf+4zNOgu2o22TZxMqY7B sNoX61O7veyvyk0wRU2sazW/1h4b/dmUwdIM7rQ+Sro7OQaRmoqqQXpmGaqJu5X+zPnr AHfHkwNKxLcC0mUCtCy400SEhcduYx5jlamqBUBp2/2LZLlFvDsF4hW/qcUM2gI2E239 mTaQ== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1747293722; x=1747898522; h=mime-version:user-agent:message-id:date:references:in-reply-to :subject:cc:to:from:x-gm-message-state:from:to:cc:subject:date :message-id:reply-to; bh=1t3rbwdEY/hFpl9ghLOPKLi/SuEGxwLfbSrjYxfwkh0=; b=g7FfbeTk2oF1H52IxK0urDh1q4HIjEQw8eyuS0XtQFulzeVjNr2LQdJbPRvR+og8og G7M3piacpOQ4RiddD5dulXx9yxdzCARt1tW08P50oFz++2LC5sdAGyx/T0JlZ/f8MKwn hNG3LpCFdT9e8+SYFR30YNx1hnr0DDUwvtenULxYsvicNEchtEdCx7mHA3AYE3/i9c32 9x/NVDCL/8Cd8ZVk0HKINezRxYbFKHUgOwJRmdoZ2X1LOnOI/0/Nuki5s73EzQqO/Jzs tuaemj2JNn60vHpVBjT7jdEO+YIVzc9fjT7lBMEyd8OH1Q7ynFf+owdzW6wvQoz3ZSjJ Xuzg== X-Gm-Message-State: AOJu0YwqR+ngmzQkXrglcrh4+Epi4bgpbFN8WdTws6vaectHYvIkMwop TV8tq1nqUYg5lYpT8D/8nZ8QJDK+ojVG+pL5hhPbpNXnSgcpB4Gt1eYVCXkz X-Gm-Gg: ASbGncv/O65a4rjXvFwbNnjie+AwfxKicJOg6i+yGcsvzWG/qg5lDublRpHmW6PbfH4 33vJsxp6YFSoGHKPW3ib6e9GPcyyKTuGRp+qBp4YapcnI0WDhmBKWnoXX3IsXa8Lx9bq6ynIDE/ KsN4MZbvMVhRSI1B56nGaCyCWkepZSNUx/8xY+EpC80AoNwvfOE8LPq8w8gNOPl+fNmGCVFobOo Z2Z1++Tvx7/Ca8JSH26RON7hbFi2CfH7xlE4FrrWHrkqPy4Z5v5WixLOz5nZHQX8MXuD6vYpsZL gXEvd0MlLTMHqTyzmXGranwWuu3kJamUXRpNCbMCjIzX5+Rf1Q== X-Google-Smtp-Source: AGHT+IG9eRA1s1Ch4W5sORX2zP+JinOhbAV9rv2Fe87zSoKCE1YoAvY/woEoO8JCIxTiJFEo6yjqpA== X-Received: by 2002:a17:902:e747:b0:224:a96:e39 with SMTP id d9443c01a7336-2319810e266mr85342925ad.9.1747293721725; Thu, 15 May 2025 00:22:01 -0700 (PDT) Received: from terra ([2405:6586:be0:0:83c8:d31d:2cec:f542]) by smtp.gmail.com with ESMTPSA id d9443c01a7336-22fc82706ccsm111059975ad.109.2025.05.15.00.22.00 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Thu, 15 May 2025 00:22:01 -0700 (PDT) From: Maxim Cournoyer In-Reply-To: (Giacomo Leidi's message of "Mon, 5 May 2025 09:57:50 +0200") References: <2b78b4ce9b0a3a6c0bdbdec5bb16702a5b5083a3.1746431874.git.goodoldpaul@autistici.org> Date: Thu, 15 May 2025 16:21:58 +0900 Message-ID: <87r00qibjd.fsf@gmail.com> User-Agent: Gnus/5.13 (Gnus v5.13) MIME-Version: 1.0 Content-Type: text/plain X-Spam-Score: 0.0 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) Hi, Giacomo Leidi writes: > * gnu/tests/docker.scm: Simplify %test-oci-container test case and add > explicit timeouts to tests outcomes. [...] > (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) You can drop the trailing '#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)) Please mind the 80 columns maximum width :-). > (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 Please use complete punctuation for standalone comments. > + (let loop ((attempts 0)) > + (if (= attempts 60) > + (error "Service didn't come up after more than 60 seconds") I'm curious as to why this is necessary, given in the previous test we wait for the docker-guile service to be ready? -- Thanks, Maxim From unknown Fri Jun 13 11:55:10 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#76081] [PATCH v10 4/7] services: Add oci-service-type. Resent-From: Maxim Cournoyer Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Fri, 16 May 2025 01:40:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 76081 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: Giacomo Leidi Cc: Ludovic =?UTF-8?Q?Court=C3=A8s?= , Gabriel Wicki , 76081@debbugs.gnu.org Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.174735956419071 (code B ref 76081); Fri, 16 May 2025 01:40:02 +0000 Received: (at 76081) by debbugs.gnu.org; 16 May 2025 01:39:24 +0000 Received: from localhost ([127.0.0.1]:58731 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1uFk2g-0004xA-4R for submit@debbugs.gnu.org; Thu, 15 May 2025 21:39:24 -0400 Received: from mail-pf1-x436.google.com ([2607:f8b0:4864:20::436]:54689) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.84_2) (envelope-from ) id 1uFk2T-0004w2-NH for 76081@debbugs.gnu.org; Thu, 15 May 2025 21:39:15 -0400 Received: by mail-pf1-x436.google.com with SMTP id d2e1a72fcca58-7424c24f88bso2117688b3a.1 for <76081@debbugs.gnu.org>; Thu, 15 May 2025 18:39:05 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20230601; t=1747359539; x=1747964339; darn=debbugs.gnu.org; h=mime-version:user-agent:message-id:date:references:in-reply-to :subject:cc:to:from:from:to:cc:subject:date:message-id:reply-to; bh=1mVWXMXRI9r3LesDU4rd++8dG7/LuM4U9lCS5Qfj6gg=; b=Tbg3UA6ZUs7RCPPgM+4jvvPFJX/dEIqRnoVAMTc4uJHOZmVkTGXhGo4UPk87RHV+Pk 8+FtlMashTDap4YpZzib3VyaATiXU8Bv/9cIrj1D8tB0YLA0iZmkYj5HiI4sZsFvO+II mtXnBvWDIQPNAo45Hpzg76AAydstscMfZabNfsHxysfu8A1N5Dq3XGgb0G6Enid9Z5Go +4ELWqR7ugwI9FEPua3oN6aI2ADn1/LXh/mwzodiRMyBtbgTPUqxP+qHwo4R0LeIEScO /9U3BVTNsxL8vablBeVzgoIEnZI4LmP3ni9s6d3MbWF44ja95jINm+aAQdGNrRlKTjbA Aeiw== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1747359539; x=1747964339; h=mime-version:user-agent:message-id:date:references:in-reply-to :subject:cc:to:from:x-gm-message-state:from:to:cc:subject:date :message-id:reply-to; bh=1mVWXMXRI9r3LesDU4rd++8dG7/LuM4U9lCS5Qfj6gg=; b=p3Q3uSGE+DgUnx/ljdsuD8TUWSEpNwUFHf2k3QLdKL67M1jv9n1FdjEmrXc6KU9BQD KCi9HybhIUGedZkPwuNTqFYRh1d2Axabz578y43Mr2axlrvAEWf8+Ud0CBXaxAA67uKI 39eKMsmtrwblpU+rIo7E//K8QBOqbB3nvpOhJ9TZvfBKERmeh5GHg8p45IChMGgh35sv hlAqE0yxeTvryJqxNRZgccYJKOVS2rRSD0UP3uTloKS59PaR0vx6PN6yIp7G8Bi7qyL6 S52DaRzL2mq8uNV4fzO1GVhFxppFHiQFjFJs40jdaUUq8N4n3P7u/PoNxSLKYrq1uN7T qpKQ== X-Gm-Message-State: AOJu0YwpatwZYsqVmolBLBdUJPqMpPuoIYCunWAxEboe06T0Dd0LH3MD WPl7u/IDIND4GBxuBInhTiHABa0Ch1USQYJxtHfFlEIxawL9Ut2iKc+6 X-Gm-Gg: ASbGnctjWlQih8DEXoIjWzFSvMsf7lStFkcLkLixyylPQT7LCwSqmRsmYdFWDSTPrg0 4gwxzNEZpA4PbpJnHYD381Fxb5gvgkbGH2P5F0j9hsIsuUpls6Q78Pv40v0+oiL4c5/BzJCA7u9 C9356FvJqnb84V0wUZOEyFZ9ovnf0Y8yzU0DijiDVYieQeqvFdo4Y6THCNqJjJqvFZmcmJz+VLp fFcFEEgerToDZKBsFvpQBfkPZZOXS3ROLcE6tIur7LIuAbETznhTo7PXKCTZ9DyzfjNVpsuzdJD /rnJpBXX38ShykzeOrV3xA1Wga2Ntsy6WhCN8w2HJSTSiS3NAQ== X-Google-Smtp-Source: AGHT+IHATmwJo3F0Y31yGl1wyxiu6s07NSis4eX8HCWWaHRjeM3pKKC1fOywLC6+DInOJe64qqC4UA== X-Received: by 2002:a05:6300:668a:b0:1f5:63f9:9eb4 with SMTP id adf61e73a8af0-2170ce33aa9mr1050209637.35.1747359538285; Thu, 15 May 2025 18:38:58 -0700 (PDT) Received: from terra ([2405:6586:be0:0:83c8:d31d:2cec:f542]) by smtp.gmail.com with ESMTPSA id 41be03b00d2f7-b26eaf8e13csm555489a12.45.2025.05.15.18.38.55 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Thu, 15 May 2025 18:38:57 -0700 (PDT) From: Maxim Cournoyer In-Reply-To: (Giacomo Leidi's message of "Mon, 5 May 2025 09:57:51 +0200") References: <2b78b4ce9b0a3a6c0bdbdec5bb16702a5b5083a3.1746431874.git.goodoldpaul@autistici.org> Date: Fri, 16 May 2025 10:38:54 +0900 Message-ID: <87jz6hibbl.fsf@gmail.com> User-Agent: Gnus/5.13 (Gnus v5.13) MIME-Version: 1.0 Content-Type: text/plain X-Spam-Score: 0.0 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) Hi, Giacomo Leidi writes: > 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. Sounds useful! > At last the Scheme API is thought to facilitate the implementation of a > Guix Home service in the future. > > * gnu/services/containers.scm (%oci-supported-runtimes): New variable; > (oci-runtime-cli): new variable; > (oci-runtime-name): new variable; > (oci-network-configuration): new variable; > (oci-volume-configuration): new variable; > (oci-configuration): new variable; > (oci-extension): new variable; > (oci-networks-shepherd-name): new variable; > (oci-service-type): new variable; > (oci-state->shepherd-services): new variable. Nitpick: you can combine multiple variables/procedures, like: (oci-runtime-cli, oci-runtime-name) (oci-network-configuration, oci-volume-configuration) [...] (oci-service-type): New variables. The above change log appears incomplete, for example oci-image-reference was changed but isn't listed. [...] > @lisp > -(service oci-container-service-type > - (list > - (oci-container-configuration > - (network "host") > - (image > - (oci-image > - (repository "guile") > - (tag "3") > - (value (specifications->manifest '("guile"))) > - (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile")) > - #:max-layers 2)))) > - (entrypoint "/bin/guile") > - (command > - '("-c" "(display \"hello!\n\")"))) > - (oci-container-configuration > - (image "prom/prometheus") > - (ports > - '(("9000" . "9000") > - ("9090" . "9090")))) > - (oci-container-configuration > - (image "grafana/grafana:10.0.1") > - (network "host") > - (volumes > - '("/var/lib/grafana:/var/lib/grafana"))))) > +(simple-service 'oci-provisioning > + oci-service-type > + (oci-extension > + (networks > + (list > + (oci-network-configuration (name "monitoring")))) > + (containers > + (list > + (oci-container-configuration > + (network "monitoring") > + (image > + (oci-image > + (repository "guile") > + (tag "3") > + (value (specifications->manifest '("guile"))) > + (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile")) > + #:max-layers 2)))) > + (entrypoint "/bin/guile") > + (command > + '("-c" "(display \"hello!\n\")"))) > + (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"))))))) I was curious: was is the gain to have by using the extension mechanism instead of directly accepting a list of 'oci-configuration' or similarly named record to the oci-service-type? > @end lisp > > In this example three different Shepherd services are going to be added to the > system. Each @code{oci-container-configuration} record translates to a > -@code{docker run} invocation and its fields directly map to options. You can > -refer to the > -@url{https://docs.docker.com/engine/reference/commandline/run,upstream} > -documentation for the semantics of each value. If the images are not found, > -they will be > -@url{https://docs.docker.com/engine/reference/commandline/pull/,pulled}. The > +@command{docker run} or @command{podman run} invocation and its fields directly I know not all of these instances are newly added, but @command should only be used with a single command name. For a command line, use @samp. > +map to options. You can refer to the > +@url{https://docs.docker.com/engine/reference/commandline/run,Docker} > +or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html,Podman} > +upstream documentation for semantics of each value. If the images are not found, > +they will be pulled. You can refer to the > +@url{https://docs.docker.com/engine/reference/commandline/pull/,Docker} > +or @url{https://docs.podman.io/en/stable/markdown/podman-pull.1.html,Podman} > +upstream documentation for semantics. The > services with @code{(network "host")} are going to be attached to the > host network and are supposed to behave like native processes with regard to > networking. > > @end defvar > > +@c %start of fragment > + > +@deftp {Data Type} oci-configuration > +Available @code{oci-configuration} fields are: > + > +@table @asis > +@item @code{runtime} (default: @code{'docker}) (type: symbol) > +The OCI runtime to use to run commands. It can be either @code{'docker} or > +@code{'podman}. > + > +@item @code{runtime-cli} (type: maybe-package-or-string) > +The OCI runtime command line to be installed in the system profile and used > +to provision OCI resources, it can be either a package or a string representing > +an absolute path to the runtime binary entrypoint. When unset it will default s/absolute path/absolute file name/ [...] > +@item @code{containers} (default: @code{'()}) (type: list-of-oci-containers) > +The list of @code{oci-container-configuration} records representing the > +containers to provision. Most users are supposed not to use this field and use > +the @code{oci-extension} record instead. Maybe streamline to 'The use of the @code{oci-extension} record should be preferred for most cases.' As I wondered above, what is the benefit? > + > +@item @code{networks} (default: @code{'()}) (type: list-of-oci-networks) > +The list of @code{oci-network-configuration} records representing the > +containers to provision. Most users are supposed not to use this field and use > +the @code{oci-extension} record instead. Ditto. > +@item @code{volumes} (default: @code{'()}) (type: list-of-oci-volumes) > +The list of @code{oci-volumes-configuration} records representing the > +containers to provision. Most users are supposed not to use this field and use > +the @code{oci-extension} record instead. Ditto. [...] > diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm > index 24f31c756b8..66b46456800 100644 > --- a/gnu/services/containers.scm > +++ b/gnu/services/containers.scm [...] > +(define-configuration/no-serialization oci-volume-configuration > + (name > + (string) > + "The name of the OCI volume to provision.") > + (labels > + (list '()) > + "The list of labels that will be used to tag the current volume." > + (sanitizer oci-sanitize-labels)) > + (extra-arguments > + (list '()) > + "A list of strings, gexps or file-like objects that will be directly passed > +to the @command{docker volume create} or @command{podman volume create} > +invocation." > + (sanitizer oci-sanitize-extra-arguments))) > + > +(define (list-of-oci-volumes? value) > + (list-of-oci-records? "volumes" oci-volume-configuration? value)) > + > +(define-configuration/no-serialization oci-network-configuration > + (name > + (string) > + "The name of the OCI network to provision.") > + (driver > + (maybe-string) > + "The driver to manage the network.") > + (gateway > + (maybe-string) > + "IPv4 or IPv6 gateway for the subnet.") > + (internal? > + (boolean #f) > + "Restrict external access to the network") > + (ip-range > + (maybe-string) > + "Allocate container ip from a sub-range in CIDR format.") > + (ipam-driver > + (maybe-string) > + "IP Address Management Driver.") > + (ipv6? > + (boolean #f) > + "Enable IPv6 networking.") > + (subnet > + (maybe-string) > + "Subnet in CIDR format that represents a network segment.") > + (labels > + (list '()) > + "The list of labels that will be used to tag the current volume." > + (sanitizer oci-sanitize-labels)) > + (extra-arguments > + (list '()) > + "A list of strings, gexps or file-like objects that will be directly passed > +to the @command{docker network create} or @command{podman network create} > +invocation." > + (sanitizer oci-sanitize-extra-arguments))) > + > +(define (list-of-oci-networks? value) > + (list-of-oci-records? "networks" oci-network-configuration? value)) > + > +(define (package-or-string? value) > + (or (package? value) (string? value))) > + > +(define-maybe/no-serialization package-or-string) > + > +(define-configuration/no-serialization oci-configuration > + (runtime > + (symbol 'docker) > + "The OCI runtime to use to run commands. It can be either @code{'docker} or > +@code{'podman}." > + (sanitizer oci-sanitize-runtime)) Instead of using explicit sanitizers, it'd be better to define a oci-runtime? predicate and use it as a type in the configuration. This way errors are reported with source location information. [...] > + > +(define (oci-runtime-system-environment runtime user) > + (if (eq? runtime 'podman) > + (list > + #~(string-append > + "HOME=" (passwd:dir (getpwnam #$user)))) > + #~())) > + > +(define (oci-runtime-cli runtime runtime-cli path) > + "Return a gexp that, when lowered, evaluates to the file system path of the OCI > +runtime command requested by the user." > + (if (string? runtime-cli) > + ;; It is a user defined absolute path > + runtime-cli > + #~(string-append > + #$(if (not (maybe-value-set? runtime-cli)) > + path > + runtime-cli) > + #$(if (eq? 'podman runtime) > + "/bin/podman" > + "/bin/docker")))) > + > +(define* (oci-runtime-system-cli config #:key (path "/run/current-system/profile")) > + (let ((runtime-cli > + (oci-configuration-runtime-cli config)) > + (runtime > + (oci-configuration-runtime config))) > + (oci-runtime-cli runtime runtime-cli path))) > + > +(define (oci-runtime-home-cli config) > + (let ((runtime-cli > + (oci-configuration-runtime-cli config)) > + (runtime > + (oci-configuration-runtime config))) > + (oci-runtime-cli runtime runtime-cli > + (string-append (getenv "HOME") > + "/.guix-home/profile")))) I'd replace the 'path' instances in the source with 'file' or 'file-name', to better match our GNU conventions. [...] > +(define (oci-object-exists? runtime runtime-cli object verbose?) > + #~(lambda* (name #:key (format-string "{{.Name}}")) > + (use-modules (ice-9 format) > + (ice-9 match) > + (ice-9 popen) > + (ice-9 rdelim) > + (srfi srfi-1)) > + > + (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))) > + > + #$(if (eq? runtime 'podman) > + #~(let ((command > + (list #$runtime-cli > + #$object "exists" name))) > + (when #$verbose? > + (format #t "Running~{ ~a~}~%" command)) > + (define exit-code (status:exit-val (apply system* command))) > + (when #$verbose? > + (format #t "Exit code: ~a~%" exit-code)) > + (equal? EXIT_SUCCESS exit-code)) > + #~(let ((command > + (string-append #$runtime-cli > + " " #$object " ls --format " > + "\"" format-string "\""))) > + (when #$verbose? > + (format #t "Running ~a~%" command)) > + (member name (read-lines (open-input-pipe command))))))) That's a complex piece of staged code; have you considered placing it in a supporting build-side module, e.g. gnu/build/oci-containers.scm ? Then it could be more simply imported in the gexp environment and used. See the gnu/build/jami-service.scm for an example. > +(define* (oci-image-loader runtime runtime-cli name image tag #:key (verbose? #f)) > + "Return a file-like object that, once lowered, will evaluate to a program able > +to load IMAGE through RUNTIME-CLI and to tag it with TAG afterwards." > + (let ((tarball (lower-oci-image name image))) > (with-imported-modules '((guix build utils)) > - (program-file (format #f "~a-image-loader" name) > + (program-file > + (format #f "~a-image-loader" name) > #~(begin > (use-modules (guix build utils) > + (ice-9 match) > (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)) > + (ice-9 rdelim) > + (srfi srfi-1)) > + (define object-exists? > + #$(oci-object-exists? runtime runtime-cli "image" verbose?)) > + (define load-command > + (string-append #$runtime-cli > + " load -i " #$tarball)) > + > + (if (object-exists? #$tag #:format-string "{{.Repository}}:{{.Tag}}") > + (format #t "~a image already exists, skipping.~%" #$tag) > + (begin > + (format #t "Loading image for ~a from ~a...~%" #$name #$tarball) > + (when #$verbose? > + (format #t "Running ~a~%" load-command)) > + (let ((line (read-line > + (open-input-pipe load-command)))) > + (unless (or (eof-object? line) > + (string-null? line)) > + (format #t "~a~%" line) > + (let* ((repository&tag > + (string-drop line > + (string-length > + "Loaded image: "))) > + (tag-command > + (list #$runtime-cli "tag" repository&tag #$tag)) > + (drop-old-tag-command > + (list #$runtime-cli "image" "rm" "-f" repository&tag))) > + > + (unless (string=? repository&tag #$tag) > + (when #$verbose? > + (format #t "Running~{ ~a~}~%" tag-command)) > + > + (let ((exit-code > + (status:exit-val (apply system* tag-command)))) > + (format #t "Tagged ~a with ~a...~%" #$tarball #$tag) > + > + (when #$verbose? > + (format #t "Exit code: ~a~%" exit-code)) > + > + (when (equal? EXIT_SUCCESS exit-code) > + (when #$verbose? > + (format #t "Running~{ ~a~}~%" drop-old-tag-command)) > + (let ((drop-exit-code > + (status:exit-val (apply system* drop-old-tag-command)))) > + (when #$verbose? > + (format #t "Exit code: ~a~%" drop-exit-code)))))))))))))))) > + > +(define (oci-container-run-invocation runtime runtime-cli name command image-reference > + options runtime-extra-arguments run-extra-arguments) That's a lot of arguments! Perhaps it could accept a record instead? Please also mind the 80 chars max width. > + "Return a list representing the OCI runtime > +invocation for running containers." > + ;; run [OPTIONS] IMAGE [COMMAND] [ARG...] > + `(,runtime-cli ,@runtime-extra-arguments "run" "--rm" > + ,@(if (eq? runtime 'podman) > + ;; This is because podman takes some time to > + ;; release container names. --replace seems > + ;; to be required to be able to restart services. > + '("--replace") > + '()) > + "--name" ,name > + ,@options ,@run-extra-arguments > + ,image-reference ,@command)) > + > +(define* (oci-container-entrypoint runtime runtime-cli name image image-reference > + invocation #:key (verbose? #f) (pre-script #~())) The default value for a keyword argument is #f, so I'd omit the explicit default for verbose?. > + "Return a file-like object that, once lowered, will evaluate to the entrypoint > +for the Shepherd service that will run IMAGE through RUNTIME-CLI." > + (program-file > + (string-append "oci-entrypoint-" name) > + #~(begin > + (use-modules (ice-9 format) > + (srfi srfi-1)) > + (when #$verbose? > + (format #t "Running in verbose mode...~%") > + (format #t "Current user: ~a ~a~%" > + (getuid) (passwd:name (getpwuid (getuid)))) > + (format #t "Current group: ~a ~a~%" > + (getgid) (group:name (getgrgid (getgid)))) > + (format #t "Current directory ~a~%" (getcwd))) I'd use a single format call; you can format the string naturally like (format #t "\ Running in verbose mode... Current user: ~a ~a ... " arg1 arg2, ...) > + (define invocation (list #$@invocation)) > + #$@pre-script > + (when #$verbose? > + (format #t "Running~{ ~a~}~%" invocation)) > + (apply execlp `(,(first invocation) ,@invocation))))) You can more simply: (apply execlp (first invocation) invocation) > + > +(define* (oci-container-shepherd-service runtime runtime-cli config > + #:key > + (runtime-environment #~()) > + (runtime-extra-arguments '()) > + (oci-requirement '()) > + (user #f) > + (group #f) > + (verbose? #f)) > + "Return a Shepherd service object that will run the OCI container represented > +by CONFIG through RUNTIME-CLI." > + (let* ((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)) > + (maybe-user (oci-container-configuration-user config)) > + (maybe-group (oci-container-configuration-group config)) > + (user (if (maybe-value-set? maybe-user) > + maybe-user > + user)) > + (group (if (maybe-value-set? maybe-group) > + maybe-group > + group)) > (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)) > + (name > + (oci-container-shepherd-name runtime config)) > (extra-arguments > - (oci-container-configuration-extra-arguments config))) > + (oci-container-configuration-extra-arguments config)) > + (invocation > + (oci-container-run-invocation > + runtime runtime-cli name command image-reference > + options runtime-extra-arguments extra-arguments)) > + (container-action > + (lambda* (command #:key (environment-variables #f)) > + #~(lambda _ > + (fork+exec-command > + (list #$@command) > + #$@(if user (list #:user user) '()) > + #$@(if group (list #:group group) '()) > + #$@(if (maybe-value-set? log-file) > + (list #:log-file log-file) > + '()) > + #$@(if (and user (eq? runtime 'podman)) > + (list #:directory > + #~(passwd:dir (getpwnam #$user))) > + '()) > + #$@(if environment-variables > + (list #:environment-variables > + environment-variables) > + '())))))) That's a very long let. Since many values appear to simply be accessed from theh oci-container-configuration, match-record could be used to great effect. For readability, I'd also define the action procedures using nested 'define' inside the let/match-record. [...] [...] > + (begin > + (when #$verbose? > + (format #t "Running~{ ~a~}~%" invocation)) > + (let ((exit-code (status:exit-val (apply system* invocation)))) > + (when #$verbose? > + (format #t "Exit code: ~a~%" exit-code)))))) > + (list #$@invocations))))) > + > +(define* (oci-object-shepherd-service object runtime runtime-cli name requirement invocations Max width :-). > + #:key > + (runtime-environment #~()) > + (user #f) > + (group #f) > + (verbose? #f)) I'd drop the default #f values, here and elsewhere. [...] > +(define (oci-service-subids config) > + "Return a subids-extension record representing subuids and subgids required by > +the rootless Podman backend." > + (define (delete-duplicate-ranges ranges) > + (delete-duplicates ranges > + (lambda args > + (apply string=? (map subid-range-name ranges))))) I don't understand how the above 'delete-duplicate-ranges' procedure works; the 2nd argument of delete-duplicates is normally a predicate that accepts two values, but here it's a lambda that disregards the arguments: it seems it'd be wasteful to compute the same result over and over? > + (define runtime > + (oci-configuration-runtime config)) > + (define user > + (oci-configuration-user config)) > + (define subgids (oci-configuration-subgids-range config)) > + (define subuids (oci-configuration-subuids-range config)) > + (define container-users > + (filter (lambda (range) > + (and (maybe-value-set? > + (subid-range-name range)) > + (not (string=? (subid-range-name range) user)))) > + (map (lambda (container) > + (subid-range > + (name > + (oci-container-configuration-user container)))) > + (oci-configuration-containers config)))) > + (define subgid-ranges > + (delete-duplicate-ranges > + (cons > + (if (not (maybe-value-set? subgids)) > + (subid-range (name user)) > + subgids) > + container-users))) > + (define subuid-ranges > + (delete-duplicate-ranges > + (cons > + (if (not (maybe-value-set? subuids)) Here and above, I'd reverse your if branches, so you do not need to use 'not'. > + (subid-range (name user)) > + subuids) > + container-users))) > + > + (if (eq? 'podman runtime) > + (subids-extension > + (subgids > + subgid-ranges) > + (subuids > + subuid-ranges)) > + (subids-extension))) > + > +(define (oci-objects-merge-lst a b object get-name) > + (define (contains? value lst) > + (member value (map get-name lst))) > + (let loop ((merged '()) > + (lst (append a b))) > + (if (null? lst) > + merged > + (loop > + (let ((element (car lst))) > + (when (contains? element merged) > + (raise > + (formatted-message > + (G_ "Duplicated ~a: ~a. ~as names should be unique, please s/~as names/names of ~a/, perhaps? > +remove the duplicate.") object (get-name element) object))) > + (cons element merged)) > + (cdr lst))))) > + > +(define (oci-extension-merge a b) > + (oci-extension > + (containers (oci-objects-merge-lst > + (oci-extension-containers a) > + (oci-extension-containers b) > + "container" > + (lambda (config) > + (define maybe-name (oci-container-configuration-provision config)) Max width. [...] > +(define oci-service-type > + (service-type (name 'oci) > + (extensions > + (list > + (service-extension profile-service-type > + (lambda (config) > + (let ((runtime-cli > + (oci-configuration-runtime-cli config)) > + (runtime > + (oci-configuration-runtime config))) > + (oci-service-profile runtime runtime-cli)))) You can nest the fields under (service-type to meet the max columns width. > + (service-extension subids-service-type > + oci-service-subids) > + (service-extension account-service-type > + oci-service-accounts) > + (service-extension shepherd-root-service-type > + oci-configuration->shepherd-services))) > + ;; Concatenate OCI object lists. > + (compose (lambda (args) > + (fold oci-extension-merge > + (oci-extension) > + args))) > + (extend oci-configuration-extend) > + (default-value (oci-configuration)) > + (description > + "This service implements the provisioning of OCI object such s/OCI object/OCI objects/ > +as containers, networks and volumes."))) > diff --git a/gnu/services/docker.scm b/gnu/services/docker.scm > index 828ceea313a..125e748bb0e 100644 > --- a/gnu/services/docker.scm > +++ b/gnu/services/docker.scm > @@ -31,7 +31,10 @@ (define-module (gnu services docker) > #:use-module (gnu system shadow) > #:use-module (gnu packages docker) > #:use-module (gnu packages linux) ;singularity > + #:use-module (guix deprecation) > + #:use-module (guix diagnostics) > #:use-module (guix gexp) > + #:use-module (guix i18n) > #:use-module (guix records) > #:use-module (srfi srfi-1) > #:use-module (ice-9 format) > @@ -67,16 +70,18 @@ (define-module (gnu services docker) > 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) > + oci-container-configuration-extra-arguments) > > #:export (containerd-configuration > containerd-service-type > docker-configuration > docker-service-type > singularity-service-type > - oci-container-service-type)) > + ;; for backwards compatibility, until the > + ;; oci-container-service-type is fully deprecated Please punctuate fully standalone comments (here, capitalizing the first letter and adding a trailing period). > + oci-container-shepherd-service > + oci-container-service-type > + %oci-container-accounts)) > > (define-maybe file-like) > > @@ -297,17 +302,25 @@ (define singularity-service-type > ;;; OCI container. > ;;; > > -(define (configs->shepherd-services configs) > - (map oci-container-shepherd-service configs)) > +;; for backwards compatibility, until the > +;; oci-container-service-type is fully deprecated Ditto. > +(define-deprecated (oci-container-shepherd-service config) > + oci-service-type > + ((@ (gnu services containers) oci-container-shepherd-service) > + 'docker config)) > +(define %oci-container-accounts > + (filter user-account? (oci-service-accounts (oci-configuration)))) > > (define oci-container-service-type > (service-type (name 'oci-container) > - (extensions (list (service-extension profile-service-type > - (lambda _ (list docker-cli))) > - (service-extension account-service-type > - (const %oci-container-accounts)) > - (service-extension shepherd-root-service-type > - configs->shepherd-services))) > + (extensions > + (list (service-extension oci-service-type > + (lambda (containers) > + (warning > + (G_ > + "'oci-container-service-type' is deprecated, use 'oci-service-type' instead~%")) Max width; you can break long strings with \ (backslash) escape. > + (oci-extension > + (containers containers)))))) > (default-value '()) > (extend append) > (compose concatenate) > diff --git a/gnu/tests/containers.scm b/gnu/tests/containers.scm > index 0ecc8ddb126..5e6f39387e7 100644 > --- a/gnu/tests/containers.scm > +++ b/gnu/tests/containers.scm [...] > +(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 services herd) > + (guix combinators)))) > + > + (define vm > + (virtual-machine > + (operating-system os) > + (volatile? #f) > + (memory-size 1024) > + (disk-image-size (* 3000 (expt 2 20))) > + (port-forwardings '()))) > + > + (define test > + (with-imported-modules '((gnu build marionette)) > + #~(begin > + (use-modules (srfi srfi-11) (srfi srfi-64) > + (gnu build marionette)) > + > + (define marionette > + ;; Relax timeout to accommodate older systems and > + ;; allow for pulling the image. > + (make-marionette (list #$vm) #:timeout 60)) > + (define out-dir "/tmp") > + > + (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 "rootless-podman services started successfully" > + (begin > + (define (run-test) > + (marionette-eval > + `(begin > + (use-modules (ice-9 popen) > + (ice-9 match) > + (ice-9 rdelim)) > + > + (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 slurp > + (lambda args > + (let* ((port (apply open-pipe* OPEN_READ args)) > + (output (read-lines port)) > + (status (close-pipe port))) > + output))) > + (let* ((bash > + ,(string-append #$bash "/bin/bash")) Unquote-splice is not necessary here, you can more directly #$(string-append bash "/bin/bash"). > + (response1 > + (slurp bash "-c" > + (string-append "ls -la /sys/fs/cgroup | " > + "grep -E ' \\./?$' | awk '{ print $4 }'"))) > + (response2 (slurp bash "-c" > + (string-append "ls -l /sys/fs/cgroup/cgroup" > + ".{procs,subtree_control,threads} | " > + "awk '{ print $4 }' | sort -u")))) Is there perhaps an easier way to check that the podman services were started successfully? Perhaps using the podman command directly to query the state of the running containers? 'ls' is usually frowned for scripting; it's meant for interactive use. Perhaps you could use the shell wildcard feature or the find command instead? I comment explaining what the above does/check exactly would be useful; it's not obvious. > + (list (string-join response1 "\n") (string-join response2 "\n")))) > + marionette)) > + ;; Allow services to come up on slower machines ^ missing period > + (let loop ((attempts 0)) > + (if (= attempts 60) > + (error "Services didn't come up after more than 60 seconds") > + (if (equal? '("cgroup" "cgroup") > + (run-test)) > + #t > + (begin > + (sleep 1) > + (format #t "Services didn't come up yet, retrying with attempt ~a~%" > + (+ 1 attempts)) > + (loop (+ 1 attempts)))))))) Note that we have a 'with-retries' definition in (gnu build jami-service) which could be used here; perhaps it should be relocated elsewhere. > + > + (test-assert "podman-volumes running" > + (begin > + (define (run-test) > + (marionette-eval > + `(begin > + (use-modules (srfi srfi-1) > + (ice-9 popen) > + (ice-9 match) > + (ice-9 rdelim)) > + > + (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 (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 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))) > + > + (match (primitive-fork) > + (0 > + (dynamic-wind > + (const #f) > + (lambda () > + (setgid (passwd:gid (getpwnam "oci-container"))) > + (setuid (passwd:uid (getpw "oci-container"))) > + > + (let ((response (slurp > + "/run/current-system/profile/bin/podman" > + "volume" "ls" "-n" "--format" "\"{{.Name}}\"" > + "|" "tr" "' '" "'\n'"))) > + > + (call-with-output-file (string-append ,out-dir "/response") I'd remove 'out-dir' and hard-code "/tmp/response" directly. > + (lambda (port) > + (display (string-join response "\n") port))))) > + (lambda () > + (primitive-exit 127)))) The fork is used to be able to run the podman command with the right passwd and uid, right? Maybe you could use the shepherd's provided 'command' or 'fork+exec-command', which have a nice API to do this. Also, is the dynamic-wind unnecessary? I would have thought that if a forked children aborts, its exit status should be reflected accordingly? > + (pid > + (cdr (waitpid pid)))) > + > + (wait-for-file (string-append ,out-dir "/response")) > + > + (stable-sort > + (slurp "cat" (string-append ,out-dir "/response")) > + string<=?)) > + marionette)) > + ;; Allow services to come up on slower machines missing trailing '.'. > + (let loop ((attempts 0)) > + (if (= attempts 80) > + (error "Service didn't come up after more than 80 seconds") nitpick: error messages do not need to be complete sentences/be punctuated, as they are intended for debugging. > + (if (equal? '("my-volume") > + (run-test)) > + #t > + (begin > + (sleep 1) > + (loop (+ 1 attempts)))))))) > + > + (test-assert "podman-networks running" > + (begin > + (define (run-test) > + (marionette-eval > + `(begin > + (use-modules (srfi srfi-1) > + (ice-9 popen) > + (ice-9 match) > + (ice-9 rdelim)) > + > + (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 (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 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)) The definitions boilerplate could be defined as data above the tests and spliced in for reuse. > + (match (primitive-fork) > + (0 > + (dynamic-wind > + (const #f) > + (lambda () > + (setgid (passwd:gid (getpwnam "oci-container"))) > + (setuid (passwd:uid (getpw "oci-container"))) > + > + (let ((response (slurp > + "/run/current-system/profile/bin/podman" > + "network" "ls" "-n" "--format" "\"{{.Name}}\"" > + "|" "tr" "' '" "'\n'"))) Max width :-). > + (call-with-output-file (string-append ,out-dir "/response") > + (lambda (port) > + (display (string-join response "\n") port))))) > + (lambda () > + (primitive-exit 127)))) > + (pid > + (cdr (waitpid pid)))) > + > + (wait-for-file (string-append ,out-dir "/response")) > + > + (stable-sort > + (slurp "cat" (string-append ,out-dir "/response")) > + string<=?)) I don't think using the stable variant here is necessary/useful. > + marionette)) > + ;; Allow services to come up on slower machines > + (let loop ((attempts 0)) > + (if (= attempts 80) > + (error "Service didn't come up after more than 80 seconds") > + (if (equal? '("my-network" "podman") > + (run-test)) > + #t > + (begin > + (sleep 1) > + (loop (+ 1 attempts)))))))) > + > + (test-assert "first container running" > + (marionette-eval > + '(begin > + (use-modules (gnu services herd)) > + (wait-for-service 'first #:timeout 120) > + #t) No need for #t. > + marionette)) > + > + (test-assert "second container running" > + (marionette-eval > + '(begin > + (use-modules (gnu services herd)) > + (wait-for-service 'second #:timeout 120) > + #t) Ditto. > + marionette)) > + > + (test-assert "passing host environment variables" > + (begin > + (define (run-test) > + (marionette-eval > + `(begin > + (use-modules (srfi srfi-1) > + (ice-9 popen) > + (ice-9 match) > + (ice-9 rdelim)) > + > + (define (wait-for-file file) > + ;; Wait until FILE shows up. > + (let loop ((i 60)) > + (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 (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 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))) > + > + (match (primitive-fork) > + (0 > + (dynamic-wind > + (const #f) > + (lambda () > + (setgid (passwd:gid (getpwnam "oci-container"))) > + (setuid (passwd:uid (getpw "oci-container"))) > + > + (let ((response (slurp > + "/run/current-system/profile/bin/podman" > + "exec" "first" > + "/bin/guile" "-c" "'(display (getenv \"VARIABLE\"))'"))) > + (call-with-output-file (string-append ,out-dir "/response") > + (lambda (port) > + (display (string-join response "\n") port))))) > + (lambda () > + (primitive-exit 127)))) > + (pid > + (cdr (waitpid pid)))) > + > + (wait-for-file (string-append ,out-dir "/response")) > + (slurp "cat" (string-append ,out-dir "/response"))) > + marionette)) > + ;; Allow image to be loaded on slower machines > + (let loop ((attempts 0)) > + (if (= attempts 180) > + (error "Service didn't come up after more than 180 seconds") > + (if (equal? (list "value") > + (run-test)) > + #t > + (begin > + (sleep 1) > + (loop (+ 1 attempts)))))))) I'm curious, did you test this on a slow machine to see how much time it needed there? > + (test-equal "mounting host files" [...] > + (match (primitive-fork) > + (0 > + (dynamic-wind > + (const #f) > + (lambda () > + (setgid (passwd:gid (getpwnam "oci-container"))) > + (setuid (passwd:uid (getpw "oci-container"))) > + > + (let ((response (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)))'"))) > + (call-with-output-file (string-append ,out-dir "/response") > + (lambda (port) > + (display (string-join response " ") port))))) > + (lambda () > + (primitive-exit 127)))) > + (pid > + (cdr (waitpid pid)))) > + > + (wait-for-file (string-append ,out-dir "/response")) > + (slurp "cat" (string-append ,out-dir "/response"))) > + marionette)) > + > + (test-equal "write to volumes" > + '("world") > + (marionette-eval [...] > + (match (primitive-fork) > + (0 > + (dynamic-wind > + (const #f) > + (lambda () > + (setgid (passwd:gid (getpwnam "oci-container"))) > + (setuid (passwd:uid (getpw "oci-container"))) > + > + (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))))'") > + > + (let ((response (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)))'"))) > + (call-with-output-file (string-append ,out-dir "/response") > + (lambda (port) > + (display (string-join response " ") port))))) > + (lambda () > + (primitive-exit 127)))) > + (pid > + (cdr (waitpid pid)))) The idiom of forking ot invoke podman is used so commonly it should be extracted to a procedure or syntax and reused. > + > + (wait-for-file (string-append ,out-dir "/response")) > + (slurp "cat" (string-append ,out-dir "/response"))) > + marionette)) > + > + (test-equal "can read ports over network" > + '("out of office") > + (marionette-eval > + `(begin [...] > + (match (primitive-fork) > + (0 > + (dynamic-wind > + (const #f) > + (lambda () > + (setgid (passwd:gid (getpwnam "oci-container"))) > + (setuid (passwd:uid (getpw "oci-container"))) > + > + (let ((response (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))'"))) > + (call-with-output-file (string-append ,out-dir "/response") > + (lambda (port) > + (display (string-join response " ") port))))) > + (lambda () > + (primitive-exit 127)))) > + (pid > + (cdr (waitpid pid)))) > + > + (wait-for-file (string-append ,out-dir "/response")) > + (slurp "cat" (string-append ,out-dir "/response"))) > + 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-os > + (simple-operating-system > + (service dhcp-client-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-configuration (name "my-network")))) > + (volumes > + (list (oci-volume-configuration (name "my-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)(sleep 1)(when(positive? c)(l (- c 1))))")) You can indent the snippet normally on multiple lines, for readability, or extract it as some expression to splice in. > + (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 services herd) > + (guix combinators)))) > + > + (define vm > + (virtual-machine > + (operating-system os) > + (volatile? #f) > + (memory-size 1024) > + (disk-image-size (* 3000 (expt 2 20))) > + (port-forwardings '()))) > + > + (define test > + (with-imported-modules '((gnu build marionette)) > + #~(begin > + (use-modules (srfi srfi-11) (srfi srfi-64) > + (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) > + (marionette-eval > + `(begin > + (use-modules (ice-9 popen) > + (ice-9 rdelim)) > + > + (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 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))) > + > + (stable-sort > + (slurp > + "/run/current-system/profile/bin/docker" > + "volume" "ls" "--format" "\"{{.Name}}\"") > + string<=?)) > + > + marionette)) > + ;; Allow services to come up on slower machines > + (let loop ((attempts 0)) > + (if (= attempts 80) > + (error "Service didn't come up after more than 80 seconds") > + (if (equal? '("my-volume") > + (run-test)) > + #t > + (begin > + (sleep 1) > + (loop (+ 1 attempts)))))))) > + > + (test-assert "docker-networks running" > + (begin > + (define (run-test) > + (marionette-eval > + `(begin > + (use-modules (ice-9 popen) > + (ice-9 rdelim)) > + > + (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 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))) > + > + (stable-sort > + (slurp > + "/run/current-system/profile/bin/docker" > + "network" "ls" "--format" "\"{{.Name}}\"") > + string<=?)) > + > + marionette)) > + ;; Allow services to come up on slower machines > + (let loop ((attempts 0)) > + (if (= attempts 80) > + (error "Service didn't come up after more than 80 seconds") > + (if (equal? '("bridge" "host" "my-network" "none") > + (run-test)) > + #t > + (begin > + (sleep 1) > + (loop (+ 1 attempts)))))))) > + > + (test-assert "first container running" > + (marionette-eval > + '(begin > + (use-modules (gnu services herd)) > + (wait-for-service 'first #:timeout 120) > + #t) > + marionette)) > + > + (test-assert "second container running" > + (marionette-eval > + '(begin > + (use-modules (gnu services herd)) > + (wait-for-service 'second #:timeout 120) > + #t) > + marionette)) > + > + (test-assert "passing host environment variables" > + (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))) > + > + (slurp > + "/run/current-system/profile/bin/docker" > + "exec" "first" > + "/bin/guile" "-c" "(display (getenv \"VARIABLE\"))")) > + marionette)) > + ;; Allow image to be loaded on slower machines > + (let loop ((attempts 0)) > + (if (= attempts 180) > + (error "Service didn't come up after more than 180 seconds") > + (if (equal? "value" > + (run-test)) > + #t > + (begin > + (sleep 1) > + (loop (+ 1 attempts)))))))) > + > + (test-equal "mounting host files" > + "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))) > + > + (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 \"/shared.txt\" read-line)))")) > + marionette)) > + > + (test-equal "write to volumes" > + "world" > + (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))) > + > + (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 ports over network" > + "out of office" > + (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))) > + > + (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)))) Make sure to mirror my earlier comments to the docker test as well. Phew, that was a large chunk! I'll continue my review with the remaining commits, but when I'm done, could you please submit a v11, taking into account my comments? -- Thanks, Maxim From unknown Fri Jun 13 11:55:10 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#76081] [PATCH v10 5/7] tests: Use lower-oci-image-state in container tests. Resent-From: Maxim Cournoyer Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Fri, 16 May 2025 01:46:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 76081 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: Giacomo Leidi Cc: 76081@debbugs.gnu.org Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.174735994921587 (code B ref 76081); Fri, 16 May 2025 01:46:02 +0000 Received: (at 76081) by debbugs.gnu.org; 16 May 2025 01:45:49 +0000 Received: from localhost ([127.0.0.1]:58789 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1uFk8x-0005c6-Mh for submit@debbugs.gnu.org; Thu, 15 May 2025 21:45:49 -0400 Received: from mail-pj1-x1030.google.com ([2607:f8b0:4864:20::1030]:53319) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.84_2) (envelope-from ) id 1uFk8r-0005bP-NM for 76081@debbugs.gnu.org; Thu, 15 May 2025 21:45:42 -0400 Received: by mail-pj1-x1030.google.com with SMTP id 98e67ed59e1d1-30e57a37294so1268185a91.2 for <76081@debbugs.gnu.org>; Thu, 15 May 2025 18:45:41 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20230601; t=1747359935; x=1747964735; darn=debbugs.gnu.org; h=mime-version:user-agent:message-id:date:references:in-reply-to :subject:cc:to:from:from:to:cc:subject:date:message-id:reply-to; bh=BKL9lu8Wzo0gStJWF+UtRA9qA5IKmVn6Cy0zLcoFTnY=; b=NxtmDajc89nlovR9S3qn/pS6roPeSNGsJ6R5HTe27Bedj7inw2PV529Hf1Xr5CE5Hh ZI6OUjSm+C9oLd1Ke9mF4nwEfRBBeh1tASUTcXLuHXJTQyEixOAbz8SwIgFOS1ITLaGh Y5lLt4+bfpDy7r8iT870a50+cLP/GMRDIvAD4BBSNVaE3m+djJjZKMMCUkW9lGpSgyLA oV+uJJNgOf5nNHzcJdLk8EsPnfdisztTyVskQD8X49PE56Hh3XZl8E5rsPhfCJv2V+kW /oWncY+aREy7gy0NzjwXGrR0k/HDup0cR80FtDu93VFkx2jlMmAxhdiz3lP6n18DFsRn JZcw== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1747359935; x=1747964735; h=mime-version:user-agent:message-id:date:references:in-reply-to :subject:cc:to:from:x-gm-message-state:from:to:cc:subject:date :message-id:reply-to; bh=BKL9lu8Wzo0gStJWF+UtRA9qA5IKmVn6Cy0zLcoFTnY=; b=hSK+mH3/mlU9VOfKVq/JPhUUcnzB7zR5GrV2ldfZ+/HFgWLGBy46uRzeg5IBEBaOL8 vVnfwnct/q85fRBk9jVgDAjF9gSguWCDdaXNrPeTydFWEGx4qOwv+HYNBoM/4ZBkpeS/ /+IhfLy06pCBgfIfyvDJl0Kxk52aW2CYcph+kZJUmjb3SNKqF7eyW/Z9FMdZtGoVeKtd uYqbZtWGEJ8VEBQWaceim5GG5Ta59tOrljaJw1JVS+QG+11sfQbyQO0ExvmDTQ3HnOcc wyOCkQQ2Ci8exODxmx7Jo4DngOsQsExU7iVZ+enynVGyRbN/ivICp91IxeYlucZ5aSz0 bMwQ== X-Gm-Message-State: AOJu0YxXn3+P8iqOhfwtUOJFBPd/B0CmYzs7d1M7ji2sXYRYx0AhNIBj nPf7D/3KMV88dIlLSxmbw79KhWSFHFNwWLeQXrwsqA9NXScIt0UZLtomCeRB1Q== X-Gm-Gg: ASbGnctnQeA/i0sfYxN3KE0wK7Y+zdUrpCx2kp/5gOvSD6ZelQGbxwbLadTV6RcMGj/ SzoXOb9XixJsfRBd8vQiZy2zEREPB3kf2oJHCNGJD7UIOKPyNuf0jC7WE0BV2caB+4qtbo5wRkX nNi2+kN7mK6EbCW151UTZ4hmxw0wb1U1iK6dzReMkewfjw4iiQZQgxaQ0BBZ5D8VjwQzNW2iN2+ VFWv9oRKiErPTVsl6XbkR1U6X181uTObGzoIdoigQzKsHG+4UButMNtAhpJrkc9R7LoE/hcWgub hv0DMn2bMHAP9q0VWHEbG4w/thtfaWze3yFtRry9PaD2Utpz9w== X-Google-Smtp-Source: AGHT+IG7PQ8vnlYLQxJ3dLTJBfoVA6866NtEVyXNGxTYrikGe4Sy+JUja8w0zTgG+btTaxO4kV8P1Q== X-Received: by 2002:a17:90b:35ca:b0:2ee:f440:53ed with SMTP id 98e67ed59e1d1-30e83228de0mr903715a91.31.1747359934901; Thu, 15 May 2025 18:45:34 -0700 (PDT) Received: from terra ([2405:6586:be0:0:83c8:d31d:2cec:f542]) by smtp.gmail.com with ESMTPSA id 98e67ed59e1d1-30e7d46ef5bsm491939a91.1.2025.05.15.18.45.33 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Thu, 15 May 2025 18:45:34 -0700 (PDT) From: Maxim Cournoyer In-Reply-To: (Giacomo Leidi's message of "Mon, 5 May 2025 09:57:52 +0200") References: <2b78b4ce9b0a3a6c0bdbdec5bb16702a5b5083a3.1746431874.git.goodoldpaul@autistici.org> Date: Fri, 16 May 2025 10:45:32 +0900 Message-ID: <87frh5ib0j.fsf@gmail.com> User-Agent: Gnus/5.13 (Gnus v5.13) MIME-Version: 1.0 Content-Type: text/plain X-Spam-Score: 0.0 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) Hi, Giacomo Leidi writes: > This patch replaces boilerplate in container related tests with > oci-image plumbing from (gnu services containers). > > * gnu/services/containers.scm: Export lower-oci-image-state. I don't think that's a nice API to export; you can instead use the (define lower-oci-image-state (@@ (gnu services containers) lower-oci-image-state) trick to expose internals (white box testing). > * gnu/tests/containers.scm (%oci-tarball): New variable; > (run-rootless-podman-test): use %oci-tarball; > (build-tarball&run-rootless-podman-test): drop procedure. > * gnu/tests/docker.scm (%docker-tarball): New variable; > (build-tarball&run-docker-test): use %docker-tarball; > (%docker-system-tarball): New variable; > (build-tarball&run-docker-system-test): new procedure. > > Change-Id: Iad6f0704aee188d89464c83722dea0bb7adb084a > --- > gnu/services/containers.scm | 2 + > gnu/tests/containers.scm | 80 ++++++++++++++--------------- > gnu/tests/docker.scm | 100 ++++++++++++++++++++---------------- > 3 files changed, 95 insertions(+), 87 deletions(-) The diffstats suggest the result is not that impactful in terms of reducing boilerplate, ah! > diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm > index 66b46456800..a8d10d842da 100644 > --- a/gnu/services/containers.scm > +++ b/gnu/services/containers.scm > @@ -74,6 +74,8 @@ (define-module (gnu services containers) > oci-image-system > oci-image-grafts? > > + lower-oci-image-state > + > oci-container-configuration > oci-container-configuration? > oci-container-configuration-fields > diff --git a/gnu/tests/containers.scm b/gnu/tests/containers.scm > index 5e6f39387e7..8cdd86e7ae3 100644 > --- a/gnu/tests/containers.scm > +++ b/gnu/tests/containers.scm > @@ -69,13 +69,47 @@ (define %rootless-podman-os > (supplementary-groups '("wheel" "netdev" "cgroup" > "audio" "video"))))))) > > -(define (run-rootless-podman-test oci-tarball) > +(define %oci-tarball > + (lower-oci-image-state > + "guile-guest" > + (packages->manifest > + (list > + guile-3.0 guile-json-3 > + (package > + (name "guest-script") > + (version "0") > + (source #f) > + (build-system trivial-build-system) > + (arguments `(#:guile ,guile-3.0 > + #:builder > + (let ((out (assoc-ref %outputs "out"))) I'd use a gexp for the builder expression here, with gexp variables, e.g. #$output. > + (mkdir out) > + (call-with-output-file (string-append out "/a.scm") > + (lambda (port) > + (display "(display \"hello world\n\")" port))) > + #t))) Trailing #t are no longer part of phases/builders in Guix :-). > + (synopsis "Display hello world using Guile") > + (description "This package displays the text \"hello world\" on the > +standard output device and then enters a new line.") > + (home-page #f) > + (license license:public-domain)))) > + '(#:entry-point "bin/guile" > + #:localstatedir? #t > + #:extra-options (#:image-tag "guile-guest") > + #:symlinks (("/bin/Guile" -> "bin/guile") > + ("aa.scm" -> "a.scm"))) > + "guile-guest" > + (%current-target-system) > + (%current-system) > + #f)) > + > +(define (run-rootless-podman-test) > > (define os > (marionette-operating-system > (operating-system-with-gc-roots > %rootless-podman-os > - (list oci-tarball)) > + (list %oci-tarball)) > #:imported-modules '((gnu services herd) > (guix combinators)))) > > @@ -254,7 +288,7 @@ (define (run-rootless-podman-test oci-tarball) > (let* ((loaded (slurp ,(string-append #$podman > "/bin/podman") > "load" "-i" > - ,#$oci-tarball)) > + ,#$%oci-tarball)) > (repository&tag "localhost/guile-guest:latest") > (response1 (slurp > ,(string-append #$podman "/bin/podman") > @@ -307,49 +341,11 @@ (define (run-rootless-podman-test oci-tarball) > > (gexp->derivation "rootless-podman-test" test)) > > -(define (build-tarball&run-rootless-podman-test) > - (mlet* %store-monad > - ((_ (set-grafting #f)) > - (guile (set-guile-for-build (default-guile))) > - (guest-script-package -> > - (package > - (name "guest-script") > - (version "0") > - (source #f) > - (build-system trivial-build-system) > - (arguments `(#:guile ,guile-3.0 > - #:builder > - (let ((out (assoc-ref %outputs "out"))) > - (mkdir out) > - (call-with-output-file (string-append out "/a.scm") > - (lambda (port) > - (display "(display \"hello world\n\")" port))) > - #t))) > - (synopsis "Display hello world using Guile") > - (description "This package displays the text \"hello world\" on the > -standard output device and then enters a new line.") > - (home-page #f) > - (license license:public-domain))) > - (profile (profile-derivation (packages->manifest > - (list guile-3.0 guile-json-3 > - guest-script-package)) > - #:hooks '() > - #:locales? #f)) > - (tarball (pack:docker-image > - "docker-pack" profile > - #:symlinks '(("/bin/Guile" -> "bin/guile") > - ("aa.scm" -> "a.scm")) > - #:extra-options > - '(#:image-tag "guile-guest") > - #:entry-point "bin/guile" > - #:localstatedir? #t))) > - (run-rootless-podman-test tarball))) > - > (define %test-rootless-podman > (system-test > (name "rootless-podman") > (description "Test rootless Podman service.") > - (value (build-tarball&run-rootless-podman-test)))) > + (value (run-rootless-podman-test)))) > > > (define %oci-rootless-podman-os > diff --git a/gnu/tests/docker.scm b/gnu/tests/docker.scm > index 5dcf05a17e3..07edd9d5341 100644 > --- a/gnu/tests/docker.scm > +++ b/gnu/tests/docker.scm > @@ -26,6 +26,7 @@ (define-module (gnu tests docker) > #:use-module (gnu system image) > #:use-module (gnu system vm) > #:use-module (gnu services) > + #:use-module (gnu services containers) > #:use-module (gnu services dbus) > #:use-module (gnu services networking) > #:use-module (gnu services docker) > @@ -57,6 +58,40 @@ (define %docker-os > (service containerd-service-type) > (service docker-service-type))) > > +(define %docker-tarball > + (lower-oci-image-state > + "guile-guest" > + (packages->manifest > + (list > + guile-3.0 guile-json-3 > + (package > + (name "guest-script") > + (version "0") > + (source #f) > + (build-system trivial-build-system) > + (arguments `(#:guile ,guile-3.0 > + #:builder > + (let ((out (assoc-ref %outputs "out"))) > + (mkdir out) > + (call-with-output-file (string-append out "/a.scm") > + (lambda (port) > + (display "(display \"hello world\n\")" port))) > + #t))) Ditto. Otherwise LGTM. -- Thanks, Maxim From unknown Fri Jun 13 11:55:10 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#76081] [PATCH v10 6/7] services: oci: Migrate oci-configuration to (guix records). Resent-From: Maxim Cournoyer Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Fri, 16 May 2025 02:03:04 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 76081 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: Giacomo Leidi Cc: 76081@debbugs.gnu.org Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.174736096726913 (code B ref 76081); Fri, 16 May 2025 02:03:04 +0000 Received: (at 76081) by debbugs.gnu.org; 16 May 2025 02:02:47 +0000 Received: from localhost ([127.0.0.1]:58907 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1uFkPO-000701-IN for submit@debbugs.gnu.org; Thu, 15 May 2025 22:02:46 -0400 Received: from mail-pf1-x42f.google.com ([2607:f8b0:4864:20::42f]:42209) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.84_2) (envelope-from ) id 1uFkPL-0006zl-UR for 76081@debbugs.gnu.org; Thu, 15 May 2025 22:02:44 -0400 Received: by mail-pf1-x42f.google.com with SMTP id d2e1a72fcca58-7399838db7fso1627087b3a.0 for <76081@debbugs.gnu.org>; Thu, 15 May 2025 19:02:43 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20230601; t=1747360957; x=1747965757; darn=debbugs.gnu.org; h=mime-version:user-agent:message-id:date:references:in-reply-to :subject:cc:to:from:from:to:cc:subject:date:message-id:reply-to; bh=xQjHNTMcFaYt/NCEw1pjhGl+1VV5HnClwhqGiffEihk=; b=SivOC7JgsAI8uP/y3Nxn8WMiHs4bS8ZWn1R7UinYJbx+302+R8bTNDCeA5PqPrKR06 0qz6fj98hh721jj2VcAJqrCZlb1kqUePy3+qZPpcig/8t4QiOW+wwpTRiYWXVoW7ihHj K2orsNAY7Qm7rbV++yReWmxaOP4mj1pfihkQyij6O8n+3+gbdrzd3R6IRbv55P6D5nfW fq10HL/wwhW2j9P6u/4J3MrkObPtt9WVaelbOj2HxfH/VY+7o8EMEnvG1t9KWeIGZw7/ iJtghGFzgVi/ZlaDb6iY/PwanyayQDHCPX43rHn9onhJM9LctnluhxMK4EjXiGQ1Yfuo eWQg== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1747360957; x=1747965757; h=mime-version:user-agent:message-id:date:references:in-reply-to :subject:cc:to:from:x-gm-message-state:from:to:cc:subject:date :message-id:reply-to; bh=xQjHNTMcFaYt/NCEw1pjhGl+1VV5HnClwhqGiffEihk=; b=CPQFB9i4L2kxgCFBKFCD+nTXNHqCA98rLQWxtm+j352d2hw7u8mKFbT/KeLgHOJZUZ D1jvtxM6Af9fdHd3PjKFb2W7sRi58rsLMpbGCX1TtjmGM7/Q9zqaoy/Ps1uiqXc2X+fH ypF8kbrvqE4hK5tWWVsUVDom5x8X0Pqg5KbDjfTsCz7WGyNo3m19gZ93VvH+GmfTg8+H fMFYipSx+bSpH/5Sq5ChfLfI+O5ITbxdRcPqZitjwx8HZxdFidAleD+zA4Co648KsEpV 5T7iCnBx2f8+s1lB4pXA6A8mDukPFtyzWFaUYat6HfiIKvJrmHBOlBc1heFKCPrX2dI4 Ey8w== X-Gm-Message-State: AOJu0YxqRT9Bvzjjymf844sBCapFQqgnmIqPXF/wPEpHPd5uMzUdy4me bBRaKPyhma/41aVgpnb6v5CKG8ag93bxbtOaISnUTO19ud8bA0Bo3y1c6fCRKg== X-Gm-Gg: ASbGncsdOW1Uf9jkZZrMYSNjEKKQWHACMEwYYYg9iF4mBYdSSHY/AWJEG1/koMVa8lE MmfzQocTQ/PO3xP8P+fHy2QEee1/X0VdO84sy6EcxoE6FcoTA0vp+HRWL+tTyfdIzfXk6btT+79 e5HyHt7lBgiDwXs1tXm/ZIFp2wB1wx148WJgtnv4Mksm9696wRKpHbIn2yvftWU/1MnssoExdEz pDAt+b5Ky45Amv4CWxnE5ZPfC4/TGm4d12Fa9hmC2XzNHDdlhkE34dua7tTj1lAAduV3MoViR1S t9JkxUl1bzosYGkSzKwKbdVz2TFQ2QxZu0Y0vnzmql6CvY+JtpKt+Z3Ch5pJ X-Google-Smtp-Source: AGHT+IG7SvR9+43q0w3tD4Jc6Qzufyck2aylhnwKaz1NIg3JV8rkEIllg4ctiaSXGnqawgEbXVjBYw== X-Received: by 2002:aa7:91d3:0:b0:736:4c3d:2cba with SMTP id d2e1a72fcca58-7429625dd7fmr6578658b3a.9.1747360957172; Thu, 15 May 2025 19:02:37 -0700 (PDT) Received: from terra ([2405:6586:be0:0:83c8:d31d:2cec:f542]) by smtp.gmail.com with ESMTPSA id d2e1a72fcca58-742a970b9basm482286b3a.49.2025.05.15.19.02.35 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Thu, 15 May 2025 19:02:36 -0700 (PDT) From: Maxim Cournoyer In-Reply-To: <1f148e2994e78ed4614efe885380c06740515d0b.1746431874.git.goodoldpaul@autistici.org> (Giacomo Leidi's message of "Mon, 5 May 2025 09:57:53 +0200") References: <2b78b4ce9b0a3a6c0bdbdec5bb16702a5b5083a3.1746431874.git.goodoldpaul@autistici.org> <1f148e2994e78ed4614efe885380c06740515d0b.1746431874.git.goodoldpaul@autistici.org> Date: Fri, 16 May 2025 11:02:34 +0900 Message-ID: <87bjrtia85.fsf@gmail.com> User-Agent: Gnus/5.13 (Gnus v5.13) MIME-Version: 1.0 Content-Type: text/plain X-Spam-Score: 0.0 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) Hi, Giacomo Leidi writes: > This commit migrates oci-configuration to (guix records) singe it > appears (for-home (oci-configuration ...)) does not work as expected > with (gnu services configuration). This is supposed to be completely > transparent for users and can be reverted in the > future once this has been implemented. > > * gnu/service/containers.scm: Migrate oci-configuration to (guix records). I'd like to understand and resolve this issue and avoid pushing this commit. What is the errors you are seeing? It at least byte-compiles fine with this commit reverted and the following diff applied: --8<---------------cut here---------------start------------->8--- modified gnu/home/services/containers.scm @@ -32,16 +32,14 @@ (define home-oci-service-type (extensions (list (service-extension home-profile-service-type - (oci-service-extension-wrap-validate - (lambda (config) - (let ((runtime-cli - (oci-configuration-runtime-cli config)) - (runtime - (oci-configuration-runtime config))) - (oci-service-profile runtime runtime-cli))))) + (lambda (config) + (let ((runtime-cli + (oci-configuration-runtime-cli config)) + (runtime + (oci-configuration-runtime config))) + (oci-service-profile runtime runtime-cli)))) (service-extension home-shepherd-service-type - (oci-service-extension-wrap-validate - oci-configuration->shepherd-services)))) + oci-configuration->shepherd-services))) (extend (lambda (config extension) (for-home --8<---------------cut here---------------end--------------->8--- Also, there are other home services using a define-configuration'd record with for-home, such as the home-snuik-service-type, so it should be possible to make it work. -- Thanks, Maxim From unknown Fri Jun 13 11:55:10 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#76081] [PATCH v10 7/7] home: Add home-oci-service-type. Resent-From: Maxim Cournoyer Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Fri, 16 May 2025 02:08:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 76081 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: Giacomo Leidi Cc: Tanguy Le Carrour , Ludovic =?UTF-8?Q?Court=C3=A8s?= , Gabriel Wicki , Andrew Tropin , Hilton Chain , 76081@debbugs.gnu.org, Janneke Nieuwenhuizen Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.174736127928741 (code B ref 76081); Fri, 16 May 2025 02:08:02 +0000 Received: (at 76081) by debbugs.gnu.org; 16 May 2025 02:07:59 +0000 Received: from localhost ([127.0.0.1]:58941 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1uFkUR-0007TT-5B for submit@debbugs.gnu.org; Thu, 15 May 2025 22:07:59 -0400 Received: from mail-pj1-x102b.google.com ([2607:f8b0:4864:20::102b]:44298) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.84_2) (envelope-from ) id 1uFkUO-0007Sx-Ft for 76081@debbugs.gnu.org; Thu, 15 May 2025 22:07:57 -0400 Received: by mail-pj1-x102b.google.com with SMTP id 98e67ed59e1d1-30e7bfef364so544828a91.1 for <76081@debbugs.gnu.org>; Thu, 15 May 2025 19:07:56 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20230601; t=1747361270; x=1747966070; darn=debbugs.gnu.org; h=mime-version:user-agent:message-id:date:references:in-reply-to :subject:cc:to:from:from:to:cc:subject:date:message-id:reply-to; bh=9tiwGERraBsFgh4U2iphY7hbNznCcQJSW43dMULMFOA=; b=Yc2bj8aIOjfxuLaVu8WAhetuTU9lCpWaGvLQFKDFy5tsiM0MmR/H8B/iLSPi3Z5xr2 5jCSpgQRi/Qt7nzrfL1LR3EaxvoYzTdZoCYpolpyj4P/QLVxTB7VrRD7YXyCGd0tEgvD 98w7Y62zPnhjqZh5a3IYFaFkWjjjmXuMm/Q5kvJibrA5AkeUVWqhKR+8UGT4Kv++iDO2 E4I8QmVrJaZFyUwx3KjbOPRyBdqmLd7mIPQnD3pIzKLks5FRmoCWVXPeE0phQ8nbmZuy 2Euyk0iC5+6NX4fmosM2dkn6DPg8e7ALF+p2c8AvfTV4u7wU68bV7HPf3Dxznzj4D2J9 jr2Q== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1747361270; x=1747966070; h=mime-version:user-agent:message-id:date:references:in-reply-to :subject:cc:to:from:x-gm-message-state:from:to:cc:subject:date :message-id:reply-to; bh=9tiwGERraBsFgh4U2iphY7hbNznCcQJSW43dMULMFOA=; b=AL9oqXWjIj0MM+i0CLMOSKqS7yO7iCKG1BTO4RhMbfOh9Q3r0LlBqpEdMAnX1KLoiH 5WAFTw0iQK6N8jxJtSSKblgu8Bcg/GRPdWdqVxcAwBdOd9CwNZ4bWY3OM1w8taA/DkLd 5tH15TnISKTmJAeWgjjKlnGsPlvXkj8+CFGWu5cuOc0v075H+Y1pWFanSqjjUh6j5/Xb fMlF8i9uEWUb973EqYT2Q2ItR7g2W2ZRsJO8CKRzFz07qhEC28fFrQui2COQ/Xei7bVe ohauJIHWfUnFHsai5rYxVxlRfhXWwDDdArdhMp4fub+CUBKn3qzQESEcXx3wYjhSY8yi YucA== X-Gm-Message-State: AOJu0YyeSUmyGrT32+UMn2IacEfAESv8NG348GQCYCAavIys0c/mQL7l 5SKfvzN3rNNto5Uwpmqlki2J6BO/FknjzpEK8gO+fPFYZVgcRnEiX063 X-Gm-Gg: ASbGncupYUICwNy30AhrocCMahf+aS6dHTqahWBpYvTW6o2iZtW9Gaxqldi6RDyfeLn uao6ORtwBPgRXHmo7QTmbZ2o/+8TsI5YDdZdgEdQ/3Y8f9itQieuyT/JGyeIfUo4bRoOlkrCz10 BM1KFxUziV42uznkzFSPR4AAcjcYu3QZlnAFAcKnON54X5hRL8iEA8IIcMiAmRHuyvuWCKa12eH fGdQk7FMo9y0rT8+0Q9NpZzgQIxr4f3cBK+tjrRKnCGPMzoz6woYBD8S6LIu7eggE061VcsKuSj skhz3C/3sTar3UBO8bYjn8xJ4EmceHM/O3J8+uk0P21KIGz0bQ== X-Google-Smtp-Source: AGHT+IHImlXFfJbZQ7FyIM7SHnBVlFs8+YxjDPT4Cu4n5v1BbI7u7FR5/RwaKj0zc6+TA/+pk9h/MQ== X-Received: by 2002:a17:90b:33c2:b0:30e:6a9d:d787 with SMTP id 98e67ed59e1d1-30e7d50b04bmr2267950a91.11.1747361270391; Thu, 15 May 2025 19:07:50 -0700 (PDT) Received: from terra ([2405:6586:be0:0:83c8:d31d:2cec:f542]) by smtp.gmail.com with ESMTPSA id 98e67ed59e1d1-30e334fb829sm4202414a91.45.2025.05.15.19.07.47 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Thu, 15 May 2025 19:07:49 -0700 (PDT) From: Maxim Cournoyer In-Reply-To: <91c9920430684861541c86a01c28bd46423102c8.1746431874.git.goodoldpaul@autistici.org> (Giacomo Leidi's message of "Mon, 5 May 2025 09:57:54 +0200") References: <2b78b4ce9b0a3a6c0bdbdec5bb16702a5b5083a3.1746431874.git.goodoldpaul@autistici.org> <91c9920430684861541c86a01c28bd46423102c8.1746431874.git.goodoldpaul@autistici.org> Date: Fri, 16 May 2025 11:07:46 +0900 Message-ID: <877c2hi9zh.fsf@gmail.com> User-Agent: Gnus/5.13 (Gnus v5.13) MIME-Version: 1.0 Content-Type: text/plain X-Spam-Score: 0.0 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) Hi, Giacomo Leidi writes: > * gnu/home/service/containers.scm: New file; > * gnu/local.mk (GNU_SYSTEM_MODULES): Add it. > * doc/guix.texi (OCI backed services): Document it. LGTM, but please break long lines so they fit in 80 columns. This shouldn't be merged until 6/7 has been understood; if it can be eliminated this will need to be adjusted like: --8<---------------cut here---------------start------------->8--- modified gnu/home/services/containers.scm @@ -32,16 +32,14 @@ (define home-oci-service-type (extensions (list (service-extension home-profile-service-type - (oci-service-extension-wrap-validate - (lambda (config) - (let ((runtime-cli - (oci-configuration-runtime-cli config)) - (runtime - (oci-configuration-runtime config))) - (oci-service-profile runtime runtime-cli))))) + (lambda (config) + (let ((runtime-cli + (oci-configuration-runtime-cli config)) + (runtime + (oci-configuration-runtime config))) + (oci-service-profile runtime runtime-cli)))) (service-extension home-shepherd-service-type - (oci-service-extension-wrap-validate - oci-configuration->shepherd-services)))) + oci-configuration->shepherd-services))) (extend (lambda (config extension) (for-home --8<---------------cut here---------------end--------------->8--- -- Thanks, Maxim From debbugs-submit-bounces@debbugs.gnu.org Thu May 15 22:08:13 2025 Received: (at control) by debbugs.gnu.org; 16 May 2025 02:08:13 +0000 Received: from localhost ([127.0.0.1]:58945 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1uFkUe-0007UV-OZ for submit@debbugs.gnu.org; Thu, 15 May 2025 22:08:12 -0400 Received: from mail-pf1-x42c.google.com ([2607:f8b0:4864:20::42c]:49450) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.84_2) (envelope-from ) id 1uFkUZ-0007To-GC for control@debbugs.gnu.org; Thu, 15 May 2025 22:08:07 -0400 Received: by mail-pf1-x42c.google.com with SMTP id d2e1a72fcca58-74251cb4a05so2278163b3a.3 for ; Thu, 15 May 2025 19:08:07 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20230601; t=1747361281; x=1747966081; darn=debbugs.gnu.org; h=subject:from:to:message-id:date:from:to:cc:subject:date:message-id :reply-to; bh=VBGWTxGbx9JONrN4hbAiwhBrljss+aU82y0Ynq3xMH8=; b=ab8ZMeh+Wxiy+MrDZUI8DtF1m5RwlmfOuQq5XhFbCwu48ZWx5I/iQgfq2oXnBQwFAB Asi9MMH1ZoiijAharjCMK6l0jK69ndggN5LauP4Dm+yUxUiKtZ6EA2/oeyxCJyUYD0F2 J7+RuLEUXsAgPgODDmWGRx4w9dMk0nkTbmygiHLWY+nqetofP5+DACsSudz85y+IhFYs jjn6pVUUk/DNhj4B2VNQEsQWJhjCSbD+9BsQqg4SdjJi3O+GtedEqdFXRn+w2xGmN0kG REONH5+mP+NxSX5urO2yYwg3Ph4yle0RlslcPanESs2oPLweoRG0iUSKeUCjUcyq4s9H QATg== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1747361281; x=1747966081; h=subject:from:to:message-id:date:x-gm-message-state:from:to:cc :subject:date:message-id:reply-to; bh=VBGWTxGbx9JONrN4hbAiwhBrljss+aU82y0Ynq3xMH8=; b=Frh3qToF3R9+w5uehVBINp+8hMyG9yVkVNPaxVfQmRNwfXCl6jD49Rerg/lWtmcHoN vKa+qAOa6YcKz8MxQHcsRHeB488gFZ5X21sMmmlnvljST6v0abiU9NPfQfFX5lQkmpv6 H+hAy8+Cw6sFTPme1OP51+wMKStfLYgPXYRrkSNB65Tsi8zQ79dFkGvyiIq2EcyY+d4D 4EWiqYCyweXiUa7x7wTGcEaUpwsLmEk1WBcHwf6SLLMgUXIdO5TfiFiJagQsuRDpvDfq wnPQZ3u3RqNDUhIY44IiKWdZAEnDcsp/k3+78Ay1lr+7ofSzUYzjP8gkrgmqXnqrdBHM TMDA== X-Gm-Message-State: AOJu0Yz5ye392OL2BN+MDyRBkC6mGc0AX//qmCATMBjCjEsW/ZpFqKbI OVuDu4szJHSqn3G76ej7XREoUdfj1NWC8usoy5KIEiN+Drp2kkV/bk1CYUTLqQ== X-Gm-Gg: ASbGncvoswQmN9KqX3d5Z4D6jwjy3FwHnpQEVEeiZvlw3n2DZ+YELPqzB5sczAGBjAS kO48mGfwQKg02oh5TQrAAHRxYzPzjobcOloaZPZVzYlC24DmqT9n5lnl2a0qV5CBoRvBJVGNbd9 ffxrsMeqHaEloMzcWHZSLOdz6CLkn4+r4U+gNFNjlrZHm853n68rCZPciOwoFRJaLjV1cDZm0NE ViFh8ZmbW+V5pT1irnw6b73EbSzFIKBLfq5mIAknsWBGyam3P5xOk73zN4RVxpoWSLF5tLpt5uL UXmLjCbWFu28FVmNU4gsDEJDPvHMmrsDtONPSVF2h21EstSMXQ== X-Google-Smtp-Source: AGHT+IFYfmoNgy6ZWf3ShU04CWz2PYqQqd9eV1xMWwnvYfnrT9ZvJkj0fsioQicaoScFtyVd0Kw3bg== X-Received: by 2002:a05:6a00:1797:b0:736:6043:69f9 with SMTP id d2e1a72fcca58-742a98abc88mr1921393b3a.19.1747361280972; Thu, 15 May 2025 19:08:00 -0700 (PDT) Received: from terra ([2405:6586:be0:0:83c8:d31d:2cec:f542]) by smtp.gmail.com with ESMTPSA id d2e1a72fcca58-742a982b7f3sm487772b3a.87.2025.05.15.19.07.59 for (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Thu, 15 May 2025 19:08:00 -0700 (PDT) Date: Fri, 16 May 2025 11:07:57 +0900 Message-Id: <875xi1i9z6.fsf@gmail.com> To: control@debbugs.gnu.org From: Maxim Cournoyer Subject: control message for bug #76081 X-Spam-Score: 0.0 (/) X-Debbugs-Envelope-To: control X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) tags 76081 + moreinfo quit From unknown Fri Jun 13 11:55:10 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#76081] [PATCH v10 3/7] tests: oci-container: Set explicit timeouts. Resent-From: paul Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sat, 17 May 2025 15:27:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 76081 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: moreinfo To: Maxim Cournoyer Cc: 76081@debbugs.gnu.org Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.174749558021507 (code B ref 76081); Sat, 17 May 2025 15:27:02 +0000 Received: (at 76081) by debbugs.gnu.org; 17 May 2025 15:26:20 +0000 Received: from localhost ([127.0.0.1]:49950 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1uGJQX-0005aI-J5 for submit@debbugs.gnu.org; Sat, 17 May 2025 11:26:19 -0400 Received: from confino.investici.org ([2a11:7980:1::2:0]:43267) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1uGJQU-0005Zn-JY for 76081@debbugs.gnu.org; Sat, 17 May 2025 11:26:15 -0400 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org; s=stigmate; t=1747495571; bh=jj6vK3YpZuK1h00KwDYBxr/EvLswRilJ3xzPacJRlM4=; h=Date:Subject:To:Cc:References:From:In-Reply-To:From; b=sgY6ym/WmoCSEM9aKKK89uPSgJ+Q6PdhwGXoeXQQcH2jnGXP15+3pjAFt4FdnLvNu 11vXGc10uWgY4KxVS14kOXI/Phly7/3wl/2wqEbO0iF0idDoujoa1VerssiHdrmPn9 9nC3Ubp64uuXbuxJ2/2WAACrgPw5RKxPOy3wexN4= Received: from mx1.investici.org (unknown [127.0.0.1]) by confino.investici.org (Postfix) with ESMTP id 4b07835H4vz11K3; Sat, 17 May 2025 15:26:11 +0000 (UTC) Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19]) (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with ESMTPSA id 4b07834M3xz11Jy; Sat, 17 May 2025 15:26:11 +0000 (UTC) Content-Type: multipart/alternative; boundary="------------wCzqJ005QMUYGaIum4x04eiS" Message-ID: Date: Sat, 17 May 2025 17:26:11 +0200 MIME-Version: 1.0 User-Agent: Icedove Daily References: <2b78b4ce9b0a3a6c0bdbdec5bb16702a5b5083a3.1746431874.git.goodoldpaul@autistici.org> <87r00qibjd.fsf@gmail.com> Content-Language: en-US From: paul In-Reply-To: <87r00qibjd.fsf@gmail.com> X-Spam-Score: -0.0 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) This is a multi-part message in MIME format. --------------wCzqJ005QMUYGaIum4x04eiS Content-Type: text/plain; charset=UTF-8; format=flowed Content-Transfer-Encoding: 7bit Hi Maxim, thank you for your feedback, I should have addressed all your comments. On 5/15/25 09:21, Maxim Cournoyer wrote: >> + (let loop ((attempts 0)) >> + (if (= attempts 60) >> + (error "Service didn't come up after more than 60 seconds") > I'm curious as to why this is necessary, given in the previous test we > wait for the docker-guile service to be ready? > I think it is because between once the docker run command is run and the container is actually started and available through docker ps, there seems to be a delay. If the system is not overloaded it is minimal, but it happened to me that similarly to what happened in issue 72740 sometimes container are slow to start. I think the core problem is that the Shepherd services goes to early in the running state, I should make it stay in starting state until the container is actually started but I don't know how. If you have any pointers on how to achieve this I would be very happy to learn more. I would address it in a separate issue if you agree. It happened to me that running the test suite while compiling other guix packages could make the test fail, so I think if we keep this patch we could be safer against flaky tests. What do you think? thank you, cheers, giacomo --------------wCzqJ005QMUYGaIum4x04eiS Content-Type: text/html; charset=UTF-8 Content-Transfer-Encoding: 7bit

Hi Maxim,

thank you for your feedback, I should have addressed all your comments.

On 5/15/25 09:21, Maxim Cournoyer wrote:
+              (let loop ((attempts 0))
+                (if (= attempts 60)
+                    (error "Service didn't come up after more than 60 seconds")

I'm curious as to why this is necessary, given in the previous test we
wait for the docker-guile service to be ready?

I think it is because between once the docker run command is run and the container is actually started and available through docker ps, there seems to be a delay. If the system is not overloaded it is minimal, but it happened to me that similarly to what happened in issue 72740 sometimes container are slow to start.

I think the core problem is that the Shepherd services goes to early in the running state, I should make it stay in starting state until the container is actually started but I don't know how. If you have any pointers on how to achieve this I would be very happy to learn more. I would address it in a separate issue if you agree.

It happened to me that running the test suite while compiling other guix packages could make the test fail, so I think if we keep this patch we could be safer against flaky tests. What do you think?

thank you,


cheers,

giacomo

--------------wCzqJ005QMUYGaIum4x04eiS-- From unknown Fri Jun 13 11:55:10 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#76081] [PATCH v10 3/7] tests: oci-container: Set explicit timeouts. Resent-From: Maxim Cournoyer Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Tue, 20 May 2025 09:24:03 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 76081 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: moreinfo To: paul Cc: 76081@debbugs.gnu.org Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.174773303514186 (code B ref 76081); Tue, 20 May 2025 09:24:03 +0000 Received: (at 76081) by debbugs.gnu.org; 20 May 2025 09:23:55 +0000 Received: from localhost ([127.0.0.1]:54557 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1uHJCU-0003gh-Ku for submit@debbugs.gnu.org; Tue, 20 May 2025 05:23:55 -0400 Received: from [2607:f8b0:4864:20::52c] (port=60910 helo=mail-pg1-x52c.google.com) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.84_2) (envelope-from ) id 1uHJCP-0003fQ-Mi for 76081@debbugs.gnu.org; Tue, 20 May 2025 05:23:51 -0400 Received: by mail-pg1-x52c.google.com with SMTP id 41be03b00d2f7-b07d607dc83so4268472a12.1 for <76081@debbugs.gnu.org>; Tue, 20 May 2025 02:23:49 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20230601; t=1747733013; x=1748337813; darn=debbugs.gnu.org; h=mime-version:user-agent:message-id:date:references:in-reply-to :subject:cc:to:from:from:to:cc:subject:date:message-id:reply-to; bh=974X7Rl1JckvH1spa9Yvs+h223u3m7BsddO26aDpAWM=; b=VT+z/vpulP4Twsaax6IO1uRK1fvNJDhz2AsiOb7YdAq23Yf6AkL+lhmzi76WYGuIo5 MHXcyPSVRpTfWvEhkRqDMClWLjgmiFA6dbzj9u0sU5lQ0uMiDjsnqp7xwwpElci5rqNU SCeLbmBUiTG1JWrZtvv3awfjS8KGdQhvMIcS5yvCzVKaG6bnkctpNTT9KpKEsbbQAD7c 5fpjBoxIgS8lKTUFujxvWrq7T7bWeVDkhTeIFDWG/EkQKgr4Bj3jMliSiyWihzaVw+xt KcmNhRPj85lK2WBDF/+NPr0TCupLzAgGaaf6hmjzI5jXsOnfNY4XWoCDM68MXP+LduL7 DqcQ== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1747733013; x=1748337813; h=mime-version:user-agent:message-id:date:references:in-reply-to :subject:cc:to:from:x-gm-message-state:from:to:cc:subject:date :message-id:reply-to; bh=974X7Rl1JckvH1spa9Yvs+h223u3m7BsddO26aDpAWM=; b=Pr8m+mfQMG1aV4ePiJIgCL35yeyvAdLr113BFx5Y3xdL+qq+bxzNPibQFi9/3LzFVb GblT9lBcdoivi/9IirGlhg4x6jF0v9DH758SKIO0xl9zd4G49w5DpXN4nccDvvWqsNLD L1iaIZa1FFZWHsYsBHT8EO2ICTG8vebd3LaDUymjfVPa6POR76yy0J+2TCa4d3t1ELRh SNWD1/zEkSyAkIQbVz6QBtBgzZRpcjroE+AwO3b/NwVX45OAr7iY8UVwNZCp2p5XWNvv j7Y4oopYYx0nilMB2ALCVlsz19ujeWd+vy5yV5eTdTj7D6D8KpfSQaCdCWGxzaaavlrf KShA== X-Gm-Message-State: AOJu0YwmBrew65foAKqfx39+1o43iw2nFE7VZnzKMRIqxsGFxGXtUuKK C9gA4qcsKXJpud2MZCKlngHeRZ8M5JWX7JjAeRViK5TsIlPdEXf2ZfQK8MZuqg== X-Gm-Gg: ASbGncslR+Shr0gwJoiB6puiw6R1mMEFgQ3fR4SCHoPZR2o/nLdimpPOz/tXXAtuDnp 6yqjg+TDdpPDw8rFSX3cnSGcs9m70CBsTYoEYndaSsj4ga7TYnVuhziGfQdlo3OSY3AsWhb6jy7 W9Rm/Pmm/h/kHZq5Bm6ITiCn9GAasysYfmPXNLhOHUXvT5jpb11x0V9TkgczQ5IYLUwkw1g0B23 kW7PgKKSAzco5VJqz3nWAsq081HOo6iwAvNgw4OFdhkhDFnf4+VYBkOjuwsGbpsgHt7DP8+Sm9o /er4lE+31f3QAt6KBveL84MxjxpGx0poEL5jM3ezKKTU9+mWNw== X-Google-Smtp-Source: AGHT+IGw8miSzuLCHCFVkLiFlUDO52xANTakpeUpZbLE/VBmtpTXOitg6DMBUkCk1D7S+H+JfjhkTg== X-Received: by 2002:a17:90b:48ce:b0:30a:214a:c64f with SMTP id 98e67ed59e1d1-30e7d5bb36fmr20111707a91.32.1747733012709; Tue, 20 May 2025 02:23:32 -0700 (PDT) Received: from terra ([2405:6586:be0:0:83c8:d31d:2cec:f542]) by smtp.gmail.com with ESMTPSA id 98e67ed59e1d1-30f36386a70sm1222690a91.18.2025.05.20.02.23.31 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Tue, 20 May 2025 02:23:32 -0700 (PDT) From: Maxim Cournoyer In-Reply-To: (paul's message of "Sat, 17 May 2025 17:26:11 +0200") References: <2b78b4ce9b0a3a6c0bdbdec5bb16702a5b5083a3.1746431874.git.goodoldpaul@autistici.org> <87r00qibjd.fsf@gmail.com> Date: Tue, 20 May 2025 18:23:29 +0900 Message-ID: <8734czbppq.fsf@gmail.com> User-Agent: Gnus/5.13 (Gnus v5.13) MIME-Version: 1.0 Content-Type: text/plain X-Spam-Score: 1.3 (+) X-Spam-Report: Spam detection software, running on the system "debbugs.gnu.org", has NOT identified this incoming email as spam. The original message has been attached to this so you can view it or label similar future email. If you have any questions, see the administrator of that system for details. Content preview: Hi Paul, paul writes: > Hi Maxim, > > thank you for your feedback, I should have addressed all your comments. > > On 5/15/25 09:21, Maxim Cournoyer wrote: >>> + (let loop ((attempts 0)) >>> + (if (= attempts 60) >>> + (err [...] Content analysis details: (1.3 points, 10.0 required) pts rule name description ---- ---------------------- -------------------------------------------------- -0.0 RCVD_IN_DNSWL_NONE RBL: Sender listed at https://www.dnswl.org/, no trust [2607:f8b0:4864:20:0:0:0:52c listed in] [list.dnswl.org] -0.0 SPF_PASS SPF: sender matches SPF record 0.0 SPF_HELO_NONE SPF: HELO does not publish an SPF Record 0.0 FREEMAIL_FROM Sender email is commonly abused enduser mail provider (maxim.cournoyer[at]gmail.com) 1.3 RDNS_NONE Delivered to internal network by a host with no rDNS X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: 0.3 (/) Hi Paul, paul writes: > Hi Maxim, > > thank you for your feedback, I should have addressed all your comments. > > On 5/15/25 09:21, Maxim Cournoyer wrote: >>> + (let loop ((attempts 0)) >>> + (if (= attempts 60) >>> + (error "Service didn't come up after more than 60 seconds") >> I'm curious as to why this is necessary, given in the previous test we >> wait for the docker-guile service to be ready? >> > I think it is because between once the docker run command is run and > the container is actually started and available through docker ps, > there seems to be a delay. If the system is not overloaded it is > minimal, but it happened to me that similarly to what happened in > issue 72740 sometimes container are slow to start. > > I think the core problem is that the Shepherd services goes to early > in the running state, I should make it stay in starting state until > the container is actually started but I don't know how. If you have > any pointers on how to achieve this I would be very happy to learn > more. I would address it in a separate issue if you agree. > > It happened to me that running the test suite while compiling other > guix packages could make the test fail, so I think if we keep this > patch we could be safer against flaky tests. What do you think? Thanks for explaining; yes, it seems reasonable to retry for now, and it'd be nice if you could address the root cause in the future. -- Thanks, Maxim From unknown Fri Jun 13 11:55:10 2025 X-Loop: help-debbugs@gnu.org Subject: [bug#76081] [PATCH v10 4/7] services: Add oci-service-type. Resent-From: paul Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sun, 01 Jun 2025 00:19:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 76081 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: moreinfo To: Maxim Cournoyer Cc: Ludovic =?UTF-8?Q?Court=C3=A8s?= , Gabriel Wicki , 76081@debbugs.gnu.org Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.174873710823683 (code B ref 76081); Sun, 01 Jun 2025 00:19:02 +0000 Received: (at 76081) by debbugs.gnu.org; 1 Jun 2025 00:18:28 +0000 Received: from localhost ([127.0.0.1]:33581 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1uLWPB-00069g-UZ for submit@debbugs.gnu.org; Sat, 31 May 2025 20:18:28 -0400 Received: from confino.investici.org ([2a11:7980:1::2:0]:41443) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1uLWP6-00068s-Kw for 76081@debbugs.gnu.org; Sat, 31 May 2025 20:18:24 -0400 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org; s=stigmate; t=1748737097; bh=Ce57pqgc0K8Cs9RLkzqtNAbd7VPBwdwGiG5zmBWqvG0=; h=Date:From:Subject:To:Cc:References:In-Reply-To:From; b=VdNvxKRxNyQ8L8CuZh5FO1bQ2f96KLnmEIoFEM79gBvj/FpagCFsWGUcYw71BEAad pFOPyDDokkLZUEcqJnLSy5SMIYmkjAZDpG7czZARTeZtYiy+7gyyl/jz7rtn3hVIwI mNyGVhj7DDlLh30BeKpL7J5Ta1KJJahTj2xk7M54= Received: from mx1.investici.org (unknown [127.0.0.1]) by confino.investici.org (Postfix) with ESMTP id 4b8yHY27HLz118s; Sun, 1 Jun 2025 00:18:17 +0000 (UTC) Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19]) (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with ESMTPSA id 4b8yHX73fjz118r; Sun, 1 Jun 2025 00:18:16 +0000 (UTC) Content-Type: multipart/alternative; boundary="------------080EeCE336IwOSqhtDJqPoZs" Message-ID: Date: Sun, 1 Jun 2025 02:18:16 +0200 MIME-Version: 1.0 User-Agent: Icedove Daily From: paul References: <2b78b4ce9b0a3a6c0bdbdec5bb16702a5b5083a3.1746431874.git.goodoldpaul@autistici.org> <87jz6hibbl.fsf@gmail.com> Content-Language: en-US In-Reply-To: <87jz6hibbl.fsf@gmail.com> X-Spam-Score: -0.0 (/) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: debbugs-submit-bounces@debbugs.gnu.org Sender: "Debbugs-submit" X-Spam-Score: -1.0 (-) This is a multi-part message in MIME format. --------------080EeCE336IwOSqhtDJqPoZs Content-Type: text/plain; charset=UTF-8; format=flowed Content-Transfer-Encoding: 7bit Hi, On 5/16/25 03:38, Maxim Cournoyer wrote: >> @lisp >> -(service oci-container-service-type >> - (list >> - (oci-container-configuration >> - (network "host") >> - (image >> - (oci-image >> - (repository "guile") >> - (tag "3") >> - (value (specifications->manifest '("guile"))) >> - (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile")) >> - #:max-layers 2)))) >> - (entrypoint "/bin/guile") >> - (command >> - '("-c" "(display \"hello!\n\")"))) >> - (oci-container-configuration >> - (image "prom/prometheus") >> - (ports >> - '(("9000" . "9000") >> - ("9090" . "9090")))) >> - (oci-container-configuration >> - (image "grafana/grafana:10.0.1") >> - (network "host") >> - (volumes >> - '("/var/lib/grafana:/var/lib/grafana"))))) >> +(simple-service 'oci-provisioning >> + oci-service-type >> + (oci-extension >> + (networks >> + (list >> + (oci-network-configuration (name "monitoring")))) >> + (containers >> + (list >> + (oci-container-configuration >> + (network "monitoring") >> + (image >> + (oci-image >> + (repository "guile") >> + (tag "3") >> + (value (specifications->manifest '("guile"))) >> + (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile")) >> + #:max-layers 2)))) >> + (entrypoint "/bin/guile") >> + (command >> + '("-c" "(display \"hello!\n\")"))) >> + (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"))))))) > I was curious: was is the gain to have by using the extension mechanism > instead of directly accepting a list of 'oci-configuration' or similarly > named record to the oci-service-type? One can always pass a list of 'oci-{container,network,volume}-configuration's to an 'oci-configuration': (service oci-service-type (oci-configuration (runtime 'podman) (containers (list (oci-container-configuration ...))))) but you loose the deduplication checks done by the extension mechanisms. This is useful especially for containers: both System/Home services and users of plain 'simple-service' in the system configuration can add Shepherd services for different reasons, if users do not set an explicit value to the 'provision' field of 'oci-container-configuration', the Shepherd service name will be derived from the image. So the 'oci-extension' suggestion in the documentation is to take care of duplicates. >> +(define (oci-object-exists? runtime runtime-cli object verbose?) >> + #~(lambda* (name #:key (format-string "{{.Name}}")) >> + (use-modules (ice-9 format) >> + (ice-9 match) >> + (ice-9 popen) >> + (ice-9 rdelim) >> + (srfi srfi-1)) >> + >> + (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))) >> + >> + #$(if (eq? runtime 'podman) >> + #~(let ((command >> + (list #$runtime-cli >> + #$object "exists" name))) >> + (when #$verbose? >> + (format #t "Running~{ ~a~}~%" command)) >> + (define exit-code (status:exit-val (apply system* command))) >> + (when #$verbose? >> + (format #t "Exit code: ~a~%" exit-code)) >> + (equal? EXIT_SUCCESS exit-code)) >> + #~(let ((command >> + (string-append #$runtime-cli >> + " " #$object " ls --format " >> + "\"" format-string "\""))) >> + (when #$verbose? >> + (format #t "Running ~a~%" command)) >> + (member name (read-lines (open-input-pipe command))))))) > That's a complex piece of staged code; have you considered placing it in > a supporting build-side module, e.g. gnu/build/oci-containers.scm ? > Then it could be more simply imported in the gexp environment and used. > See the gnu/build/jami-service.scm for an example. Thank you I was not aware of this option, I tried to move as much as I could to gnu/build/oci-containers.scm. >> +(define* (oci-image-loader runtime runtime-cli name image tag #:key (verbose? #f)) >> + "Return a file-like object that, once lowered, will evaluate to a program able >> +to load IMAGE through RUNTIME-CLI and to tag it with TAG afterwards." >> + (let ((tarball (lower-oci-image name image))) >> (with-imported-modules '((guix build utils)) >> - (program-file (format #f "~a-image-loader" name) >> + (program-file >> + (format #f "~a-image-loader" name) >> #~(begin >> (use-modules (guix build utils) >> + (ice-9 match) >> (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)) >> + (ice-9 rdelim) >> + (srfi srfi-1)) >> + (define object-exists? >> + #$(oci-object-exists? runtime runtime-cli "image" verbose?)) >> + (define load-command >> + (string-append #$runtime-cli >> + " load -i " #$tarball)) >> + >> + (if (object-exists? #$tag #:format-string "{{.Repository}}:{{.Tag}}") >> + (format #t "~a image already exists, skipping.~%" #$tag) >> + (begin >> + (format #t "Loading image for ~a from ~a...~%" #$name #$tarball) >> + (when #$verbose? >> + (format #t "Running ~a~%" load-command)) >> + (let ((line (read-line >> + (open-input-pipe load-command)))) >> + (unless (or (eof-object? line) >> + (string-null? line)) >> + (format #t "~a~%" line) >> + (let* ((repository&tag >> + (string-drop line >> + (string-length >> + "Loaded image: "))) >> + (tag-command >> + (list #$runtime-cli "tag" repository&tag #$tag)) >> + (drop-old-tag-command >> + (list #$runtime-cli "image" "rm" "-f" repository&tag))) >> + >> + (unless (string=? repository&tag #$tag) >> + (when #$verbose? >> + (format #t "Running~{ ~a~}~%" tag-command)) >> + >> + (let ((exit-code >> + (status:exit-val (apply system* tag-command)))) >> + (format #t "Tagged ~a with ~a...~%" #$tarball #$tag) >> + >> + (when #$verbose? >> + (format #t "Exit code: ~a~%" exit-code)) >> + >> + (when (equal? EXIT_SUCCESS exit-code) >> + (when #$verbose? >> + (format #t "Running~{ ~a~}~%" drop-old-tag-command)) >> + (let ((drop-exit-code >> + (status:exit-val (apply system* drop-old-tag-command)))) >> + (when #$verbose? >> + (format #t "Exit code: ~a~%" drop-exit-code)))))))))))))))) >> + >> +(define (oci-container-run-invocation runtime runtime-cli name command image-reference >> + options runtime-extra-arguments run-extra-arguments) > That's a lot of arguments! Perhaps it could accept a record instead? > Please also mind the 80 chars max width. Good idea, I made an intermediate oci-container-invocation record. >> + "Return a list representing the OCI runtime >> +invocation for running containers." >> + ;; run [OPTIONS] IMAGE [COMMAND] [ARG...] >> + `(,runtime-cli ,@runtime-extra-arguments "run" "--rm" >> + ,@(if (eq? runtime 'podman) >> + ;; This is because podman takes some time to >> + ;; release container names. --replace seems >> + ;; to be required to be able to restart services. >> + '("--replace") >> + '()) >> + "--name" ,name >> + ,@options ,@run-extra-arguments >> + ,image-reference ,@command)) >> + >> +(define* (oci-container-entrypoint runtime runtime-cli name image image-reference >> + invocation #:key (verbose? #f) (pre-script #~())) > The default value for a keyword argument is #f, so I'd omit the explicit > default for verbose?. >> + (begin >> + (when #$verbose? >> + (format #t "Running~{ ~a~}~%" invocation)) >> + (let ((exit-code (status:exit-val (apply system* invocation)))) >> + (when #$verbose? >> + (format #t "Exit code: ~a~%" exit-code)))))) >> + (list #$@invocations))))) >> + >> +(define* (oci-object-shepherd-service object runtime runtime-cli name requirement invocations > Max width :-). I should have dropped the default #f for keywords in all procedure, thanks. >> + "Return a file-like object that, once lowered, will evaluate to the entrypoint >> +for the Shepherd service that will run IMAGE through RUNTIME-CLI." >> + (program-file >> + (string-append "oci-entrypoint-" name) >> + #~(begin >> + (use-modules (ice-9 format) >> + (srfi srfi-1)) >> + (when #$verbose? >> + (format #t "Running in verbose mode...~%") >> + (format #t "Current user: ~a ~a~%" >> + (getuid) (passwd:name (getpwuid (getuid)))) >> + (format #t "Current group: ~a ~a~%" >> + (getgid) (group:name (getgrgid (getgid)))) >> + (format #t "Current directory ~a~%" (getcwd))) > I'd use a single format call; you can format the string naturally like > > (format #t "\ > Running in verbose mode... > Current user: ~a ~a > ... > " arg1 arg2, ...) > > >> + (define invocation (list #$@invocation)) >> + #$@pre-script >> + (when #$verbose? >> + (format #t "Running~{ ~a~}~%" invocation)) >> + (apply execlp `(,(first invocation) ,@invocation))))) > You can more simply: (apply execlp (first invocation) invocation) Thank you, I have addressed this in gnu/build/oci-containers.scm >> + >> +(define* (oci-container-shepherd-service runtime runtime-cli config >> + #:key >> + (runtime-environment #~()) >> + (runtime-extra-arguments '()) >> + (oci-requirement '()) >> + (user #f) >> + (group #f) >> + (verbose? #f)) >> + "Return a Shepherd service object that will run the OCI container represented >> +by CONFIG through RUNTIME-CLI." >> + (let* ((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)) >> + (maybe-user (oci-container-configuration-user config)) >> + (maybe-group (oci-container-configuration-group config)) >> + (user (if (maybe-value-set? maybe-user) >> + maybe-user >> + user)) >> + (group (if (maybe-value-set? maybe-group) >> + maybe-group >> + group)) >> (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)) >> + (name >> + (oci-container-shepherd-name runtime config)) >> (extra-arguments >> - (oci-container-configuration-extra-arguments config))) >> + (oci-container-configuration-extra-arguments config)) >> + (invocation >> + (oci-container-run-invocation >> + runtime runtime-cli name command image-reference >> + options runtime-extra-arguments extra-arguments)) >> + (container-action >> + (lambda* (command #:key (environment-variables #f)) >> + #~(lambda _ >> + (fork+exec-command >> + (list #$@command) >> + #$@(if user (list #:user user) '()) >> + #$@(if group (list #:group group) '()) >> + #$@(if (maybe-value-set? log-file) >> + (list #:log-file log-file) >> + '()) >> + #$@(if (and user (eq? runtime 'podman)) >> + (list #:directory >> + #~(passwd:dir (getpwnam #$user))) >> + '()) >> + #$@(if environment-variables >> + (list #:environment-variables >> + environment-variables) >> + '())))))) > That's a very long let. Since many values appear to simply be accessed > from theh oci-container-configuration, match-record could be used to > great effect. For readability, I'd also define the action procedures > using nested 'define' inside the let/match-record. I tried to address this but it's really difficult to trim much, please let me know if there's some better way. >> +(define (oci-service-subids config) >> + "Return a subids-extension record representing subuids and subgids required by >> +the rootless Podman backend." >> + (define (delete-duplicate-ranges ranges) >> + (delete-duplicates ranges >> + (lambda args >> + (apply string=? (map subid-range-name ranges))))) > I don't understand how the above 'delete-duplicate-ranges' procedure > works; the 2nd argument of delete-duplicates is normally a predicate > that accepts two values, but here it's a lambda that disregards the > arguments: it seems it'd be wasteful to compute the same result over and > over? It is, I just replace this with a more descriptive error that allows the users to drop the duplicate without silently dropping a random one between the two. >> + (response1 >> + (slurp bash "-c" >> + (string-append "ls -la /sys/fs/cgroup | " >> + "grep -E ' \\./?$' | awk '{ print $4 }'"))) >> + (response2 (slurp bash "-c" >> + (string-append "ls -l /sys/fs/cgroup/cgroup" >> + ".{procs,subtree_control,threads} | " >> + "awk '{ print $4 }' | sort -u")))) > Is there perhaps an easier way to check that the podman services were > started successfully? Perhaps using the podman command directly to > query the state of the running containers? > > 'ls' is usually frowned for scripting; it's meant for interactive use. > Perhaps you could use the shell wildcard feature or the find command > instead? I comment explaining what the above does/check exactly would > be useful; it's not obvious. I think this test can be dropped anyway since we later wait for Shepherd services to be started, it is a development leftover. >> + (let loop ((attempts 0)) >> + (if (= attempts 60) >> + (error "Services didn't come up after more than 60 seconds") >> + (if (equal? '("cgroup" "cgroup") >> + (run-test)) >> + #t >> + (begin >> + (sleep 1) >> + (format #t "Services didn't come up yet, retrying with attempt ~a~%" >> + (+ 1 attempts)) >> + (loop (+ 1 attempts)))))))) > Note that we have a 'with-retries' definition in (gnu build > jami-service) which could be used here; perhaps it should be relocated > elsewhere. Thank you for the hint, I created gnu/build/utils.scm and tested my changes with: guix shell -CPWN --writable-root nss-certs -m manifest.scm -- make check-system TESTS="pounce jami ngircd" >> + (lambda (port) >> + (display (string-join response "\n") port))))) >> + (lambda () >> + (primitive-exit 127)))) > The fork is used to be able to run the podman command with the right > passwd and uid, right? Maybe you could use the shepherd's provided > 'command' or 'fork+exec-command', which have a nice API to do this. > Also, is the dynamic-wind unnecessary? I would have thought that if a > forked children aborts, its exit status should be reflected accordingly? You bring two good points, addressed by dropping dynamic-wind and refactoring duplicate code in tests. > The idiom of forking ot invoke podman is used so commonly it should be > extracted to a procedure or syntax and reused. This should be addressed now. > Phew, that was a large chunk! I'll continue my review with the > remaining commits, but when I'm done, could you please submit a v11, > taking into account my comments? Thank you a lot for taking the time to go through all of this, I hope I addressed all your comments successfully. Please let me know if something seems off. I'll send a v11 soon. cheers, giacomo --------------080EeCE336IwOSqhtDJqPoZs Content-Type: text/html; charset=UTF-8 Content-Transfer-Encoding: 7bit

Hi,

On 5/16/25 03:38, Maxim Cournoyer wrote:
 @lisp
-(service oci-container-service-type
-         (list
-          (oci-container-configuration
-           (network "host")
-           (image
-            (oci-image
-             (repository "guile")
-             (tag "3")
-             (value (specifications->manifest '("guile")))
-             (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile"))
-                             #:max-layers 2))))
-           (entrypoint "/bin/guile")
-           (command
-            '("-c" "(display \"hello!\n\")")))
-          (oci-container-configuration
-           (image "prom/prometheus")
-           (ports
-             '(("9000" . "9000")
-               ("9090" . "9090"))))
-          (oci-container-configuration
-           (image "grafana/grafana:10.0.1")
-           (network "host")
-           (volumes
-             '("/var/lib/grafana:/var/lib/grafana")))))
+(simple-service 'oci-provisioning
+                oci-service-type
+                (oci-extension
+                  (networks
+                    (list
+                      (oci-network-configuration (name "monitoring"))))
+                  (containers
+                   (list
+                    (oci-container-configuration
+                     (network "monitoring")
+                     (image
+                      (oci-image
+                        (repository "guile")
+                        (tag "3")
+                        (value (specifications->manifest '("guile")))
+                        (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile"))
+                                        #:max-layers 2))))
+                     (entrypoint "/bin/guile")
+                     (command
+                      '("-c" "(display \"hello!\n\")")))
+                    (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")))))))

I was curious: was is the gain to have by using the extension mechanism
instead of directly accepting a list of 'oci-configuration' or similarly
named record to the oci-service-type?
One can always pass a list of 'oci-{container,network,volume}-configuration's to an 'oci-configuration':

(service oci-service-type
         (oci-configuration
          (runtime 'podman)
          (containers
           (list
            (oci-container-configuration ...)))))

but you loose the deduplication checks done by the extension mechanisms. This is useful especially for containers: both System/Home services and users of plain 'simple-service' in the system configuration can add Shepherd services for different reasons, if users do not set an explicit value to the 'provision' field of 'oci-container-configuration', the Shepherd service name will be derived from the image. So the 'oci-extension' suggestion in the documentation is to take care of duplicates. 
+(define (oci-object-exists? runtime runtime-cli object verbose?)
+  #~(lambda* (name #:key (format-string "{{.Name}}"))
+      (use-modules (ice-9 format)
+                   (ice-9 match)
+                   (ice-9 popen)
+                   (ice-9 rdelim)
+                   (srfi srfi-1))
+
+      (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)))
+
+      #$(if (eq? runtime 'podman)
+            #~(let ((command
+                     (list #$runtime-cli
+                           #$object "exists" name)))
+                (when #$verbose?
+                  (format #t "Running~{ ~a~}~%" command))
+                (define exit-code (status:exit-val (apply system* command)))
+                (when #$verbose?
+                  (format #t "Exit code: ~a~%" exit-code))
+                (equal? EXIT_SUCCESS exit-code))
+            #~(let ((command
+                     (string-append #$runtime-cli
+                                    " " #$object " ls --format "
+                                    "\"" format-string "\"")))
+                (when #$verbose?
+                  (format #t "Running ~a~%" command))
+                (member name (read-lines (open-input-pipe command)))))))

That's a complex piece of staged code; have you considered placing it in
a supporting build-side module, e.g. gnu/build/oci-containers.scm ?
Then it could be more simply imported in the gexp environment and used.
See the gnu/build/jami-service.scm for an example.
Thank you I was not aware of this option, I tried to move as much as I could to gnu/build/oci-containers.scm.
+(define* (oci-image-loader runtime runtime-cli name image tag #:key (verbose? #f))
+  "Return a file-like object that, once lowered, will evaluate to a program able
+to load IMAGE through RUNTIME-CLI and to tag it with TAG afterwards."
+  (let ((tarball (lower-oci-image name image)))
     (with-imported-modules '((guix build utils))
-      (program-file (format #f "~a-image-loader" name)
+      (program-file
+       (format #f "~a-image-loader" name)
        #~(begin
            (use-modules (guix build utils)
+                        (ice-9 match)
                         (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))
+                        (ice-9 rdelim)
+                        (srfi srfi-1))
+           (define object-exists?
+             #$(oci-object-exists? runtime runtime-cli "image" verbose?))
+           (define load-command
+             (string-append #$runtime-cli
+                            " load -i " #$tarball))
+
+           (if (object-exists? #$tag #:format-string "{{.Repository}}:{{.Tag}}")
+               (format #t "~a image already exists, skipping.~%" #$tag)
+               (begin
+                 (format #t "Loading image for ~a from ~a...~%" #$name #$tarball)
+                 (when #$verbose?
+                   (format #t "Running ~a~%" load-command))
+                 (let ((line (read-line
+                              (open-input-pipe load-command))))
+                   (unless (or (eof-object? line)
+                               (string-null? line))
+                     (format #t "~a~%" line)
+                     (let* ((repository&tag
+                             (string-drop line
+                                          (string-length
+                                           "Loaded image: ")))
+                            (tag-command
+                             (list #$runtime-cli "tag" repository&tag #$tag))
+                            (drop-old-tag-command
+                             (list #$runtime-cli "image" "rm" "-f" repository&tag)))
+
+                       (unless (string=? repository&tag #$tag)
+                         (when #$verbose?
+                           (format #t "Running~{ ~a~}~%" tag-command))
+
+                         (let ((exit-code
+                                (status:exit-val (apply system* tag-command))))
+                           (format #t "Tagged ~a with ~a...~%" #$tarball #$tag)
+
+                           (when #$verbose?
+                             (format #t "Exit code: ~a~%" exit-code))
+
+                           (when (equal? EXIT_SUCCESS exit-code)
+                             (when #$verbose?
+                               (format #t "Running~{ ~a~}~%" drop-old-tag-command))
+                             (let ((drop-exit-code
+                                    (status:exit-val (apply system* drop-old-tag-command))))
+                               (when #$verbose?
+                                 (format #t "Exit code: ~a~%" drop-exit-code))))))))))))))))
+
+(define (oci-container-run-invocation runtime runtime-cli name command image-reference
+                                      options runtime-extra-arguments run-extra-arguments)

That's a lot of arguments!  Perhaps it could accept a record instead?
Please also mind the 80 chars max width.
Good idea, I made an intermediate oci-container-invocation record.
+  "Return a list representing the OCI runtime
+invocation for running containers."
+  ;; run [OPTIONS] IMAGE [COMMAND] [ARG...]
+  `(,runtime-cli ,@runtime-extra-arguments "run" "--rm"
+    ,@(if (eq? runtime 'podman)
+          ;; This is because podman takes some time to
+          ;; release container names.  --replace seems
+          ;; to be required to be able to restart services.
+          '("--replace")
+          '())
+    "--name" ,name
+    ,@options ,@run-extra-arguments
+    ,image-reference ,@command))
+
+(define* (oci-container-entrypoint runtime runtime-cli name image image-reference
+                                   invocation #:key (verbose? #f) (pre-script #~()))

The default value for a keyword argument is #f, so I'd omit the explicit
default for verbose?.
+              (begin
+                (when #$verbose?
+                  (format #t "Running~{ ~a~}~%" invocation))
+                (let ((exit-code (status:exit-val (apply system* invocation))))
+                  (when #$verbose?
+                    (format #t "Exit code: ~a~%" exit-code))))))
+        (list #$@invocations)))))
+
+(define* (oci-object-shepherd-service object runtime runtime-cli name requirement invocations
Max width :-).

I should have dropped the default #f for keywords in all procedure, thanks. 

+  "Return a file-like object that, once lowered, will evaluate to the entrypoint
+for the Shepherd service that will run IMAGE through RUNTIME-CLI."
+  (program-file
+   (string-append "oci-entrypoint-" name)
+   #~(begin
+       (use-modules (ice-9 format)
+                    (srfi srfi-1))
+       (when #$verbose?
+         (format #t "Running in verbose mode...~%")
+         (format #t "Current user: ~a ~a~%"
+                 (getuid) (passwd:name (getpwuid (getuid))))
+         (format #t "Current group: ~a ~a~%"
+                 (getgid) (group:name (getgrgid (getgid))))
+         (format #t "Current directory ~a~%" (getcwd)))

I'd use a single format call; you can format the string naturally like

            (format #t "\
Running in verbose mode...
Current user: ~a ~a
...
" arg1 arg2, ...)



+       (define invocation (list #$@invocation))
+       #$@pre-script
+       (when #$verbose?
+         (format #t "Running~{ ~a~}~%" invocation))
+       (apply execlp `(,(first invocation) ,@invocation)))))

You can more simply: (apply execlp (first invocation) invocation)
Thank you, I have addressed this in gnu/build/oci-containers.scm
+
+(define* (oci-container-shepherd-service runtime runtime-cli config
+                                         #:key
+                                         (runtime-environment #~())
+                                         (runtime-extra-arguments '())
+                                         (oci-requirement '())
+                                         (user #f)
+                                         (group #f)
+                                         (verbose? #f))
+  "Return a Shepherd service object that will run the OCI container represented
+by CONFIG through RUNTIME-CLI."
+  (let* ((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))
+         (maybe-user (oci-container-configuration-user config))
+         (maybe-group (oci-container-configuration-group config))
+         (user (if (maybe-value-set? maybe-user)
+                    maybe-user
+                    user))
+         (group (if (maybe-value-set? maybe-group)
+                    maybe-group
+                    group))
          (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))
+         (name
+          (oci-container-shepherd-name runtime config))
          (extra-arguments
-          (oci-container-configuration-extra-arguments config)))
+          (oci-container-configuration-extra-arguments config))
+         (invocation
+          (oci-container-run-invocation
+           runtime runtime-cli name command image-reference
+           options runtime-extra-arguments extra-arguments))
+         (container-action
+          (lambda* (command #:key (environment-variables #f))
+            #~(lambda _
+                (fork+exec-command
+                 (list #$@command)
+                 #$@(if user (list #:user user) '())
+                 #$@(if group (list #:group group) '())
+                 #$@(if (maybe-value-set? log-file)
+                        (list #:log-file log-file)
+                        '())
+                 #$@(if (and user (eq? runtime 'podman))
+                        (list #:directory
+                              #~(passwd:dir (getpwnam #$user)))
+                        '())
+                 #$@(if environment-variables
+                        (list #:environment-variables
+                              environment-variables)
+                        '()))))))

That's a very long let.  Since many values appear to simply be accessed
from theh oci-container-configuration, match-record could be used to
great effect.  For readability, I'd also define the action procedures
using nested 'define' inside the let/match-record.
I tried to address this but it's really difficult to trim much, please let me know if there's some better way. 
+(define (oci-service-subids config)
+  "Return a subids-extension record representing subuids and subgids required by
+the rootless Podman backend."
+  (define (delete-duplicate-ranges ranges)
+    (delete-duplicates ranges
+                       (lambda args
+                         (apply string=? (map subid-range-name ranges)))))

I don't understand how the above 'delete-duplicate-ranges' procedure
works; the 2nd argument of delete-duplicates is normally a predicate
that accepts two values, but here it's a lambda that disregards the
arguments: it seems it'd be wasteful to compute the same result over and
over?
It is, I just replace this with a more descriptive error that allows the users to drop the duplicate without silently dropping a random one between the two.
+                          (response1
+                           (slurp bash "-c"
+                                  (string-append "ls -la /sys/fs/cgroup | "
+                                                 "grep -E ' \\./?$' | awk '{ print $4 }'")))
+                          (response2 (slurp bash "-c"
+                                            (string-append "ls -l /sys/fs/cgroup/cgroup"
+                                                           ".{procs,subtree_control,threads} | "
+                                                           "awk '{ print $4 }' | sort -u"))))

Is there perhaps an easier way to check that the podman services were
started successfully?  Perhaps using the podman command directly to
query the state of the running containers?

'ls' is usually frowned for scripting; it's meant for interactive use.
Perhaps you could use the shell wildcard feature or the find command
instead?  I comment explaining what the above does/check exactly would
be useful; it's not obvious.
I think this test can be dropped anyway since we later wait for Shepherd services to be started, it is a development leftover. 
+             (let loop ((attempts 0))
+               (if (= attempts 60)
+                   (error "Services didn't come up after more than 60 seconds")
+                   (if (equal? '("cgroup" "cgroup")
+                               (run-test))
+                       #t
+                       (begin
+                         (sleep 1)
+                         (format #t "Services didn't come up yet, retrying with attempt ~a~%"
+                                 (+ 1 attempts))
+                         (loop (+ 1 attempts))))))))

Note that we have a 'with-retries' definition in (gnu build
jami-service) which could be used here;  perhaps it should be relocated
elsewhere.

Thank you for the hint, I created gnu/build/utils.scm and tested my changes with:

guix shell -CPWN --writable-root nss-certs -m manifest.scm -- make check-system TESTS="pounce jami ngircd"

+                               (lambda (port)
+                                 (display (string-join response "\n") port)))))
+                         (lambda ()
+                           (primitive-exit 127))))

The fork is used to be able to run the podman command with the right
passwd and uid, right?  Maybe you could use the shepherd's provided
'command' or 'fork+exec-command', which have a nice API to do this.
Also, is the dynamic-wind unnecessary?  I would have thought that if a
forked children aborts, its exit status should be reflected accordingly?
You bring two good points, addressed by dropping dynamic-wind and refactoring duplicate code in tests.
The idiom of forking ot invoke podman is used so commonly it should be
extracted to a procedure or syntax and reused.
This should be addressed now. 
Phew, that was a large chunk!  I'll continue my review with the
remaining commits, but when I'm done, could you please submit a v11,
taking into account my comments?
Thank you a lot for taking the time to go through all of this, I hope I addressed all your comments successfully. Please let me know if something seems off.

I'll send a v11 soon.

cheers,

giacomo

    

  


--------------080EeCE336IwOSqhtDJqPoZs--




From unknown Fri Jun 13 11:55:10 2025
X-Loop: help-debbugs@gnu.org
Subject: [bug#76081] [PATCH v10 5/7] tests: Use lower-oci-image-state in container tests.
Resent-From: paul 
Original-Sender: "Debbugs-submit" 
Resent-CC: guix-patches@gnu.org
Resent-Date: Sun, 01 Jun 2025 01:43:05 +0000
Resent-Message-ID: 
Resent-Sender: help-debbugs@gnu.org
X-GNU-PR-Message: followup 76081
X-GNU-PR-Package: guix-patches
X-GNU-PR-Keywords: moreinfo
To: Maxim Cournoyer 
Cc: 76081@debbugs.gnu.org
Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.174874214822531
          (code B ref 76081); Sun, 01 Jun 2025 01:43:05 +0000
Received: (at 76081) by debbugs.gnu.org; 1 Jun 2025 01:42:28 +0000
Received: from localhost ([127.0.0.1]:34184 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from )
	id 1uLXiT-0005qz-Ni
	for submit@debbugs.gnu.org; Sat, 31 May 2025 21:42:27 -0400
Received: from confino.investici.org ([93.190.126.19]:46915)
 by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
 (Exim 4.84_2) (envelope-from )
 id 1uLXiQ-0005q6-J0
 for 76081@debbugs.gnu.org; Sat, 31 May 2025 21:42:24 -0400
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org;
 s=stigmate; t=1748742140;
 bh=yiaFOeWUsEuM4UfM5tghBUGmaJ38tHaI5fruiRnpkKc=;
 h=Date:Subject:To:Cc:References:From:In-Reply-To:From;
 b=ocWeOgZz82CpR6ddpeVQ2+MY3lMpXbw52lLlaH9ThtRPXdeF22lYsa/7XNZAkZ+xA
 0eJe2UQaUVqgFvVN3Bvn+HGZsCRwv+18GXkVyYCrjQrT0FBgQKKSWYSAfOtg0ZB23O
 CUfhKdsdEKx6MAAU7S/mb+F/EGNChpp2EPUXbm1k=
Received: from mx1.investici.org (unknown [127.0.0.1])
 by confino.investici.org (Postfix) with ESMTP id 4b908X3zb2z118c;
 Sun,  1 Jun 2025 01:42:20 +0000 (UTC)
Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19])
 (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with
 ESMTPSA id 4b908X34YDz1183; Sun,  1 Jun 2025 01:42:20 +0000 (UTC)
Message-ID: <4e650b54-c892-4bd0-af84-7601d895e560@autistici.org>
Date: Sun, 1 Jun 2025 03:42:19 +0200
MIME-Version: 1.0
User-Agent: Icedove Daily
References: <2b78b4ce9b0a3a6c0bdbdec5bb16702a5b5083a3.1746431874.git.goodoldpaul@autistici.org>
 
 <87frh5ib0j.fsf@gmail.com>
Content-Language: en-US
From: paul 
In-Reply-To: <87frh5ib0j.fsf@gmail.com>
Content-Type: text/plain; charset=UTF-8; format=flowed
Content-Transfer-Encoding: 7bit
X-Spam-Score: -0.7 (/)
X-BeenThere: debbugs-submit@debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: 
List-Unsubscribe: , 
 
List-Archive: 
List-Post: 
List-Help: 
List-Subscribe: , 
 
Errors-To: debbugs-submit-bounces@debbugs.gnu.org
Sender: "Debbugs-submit" 
X-Spam-Score: -1.7 (-)

Hi,

On 5/16/25 03:45, Maxim Cournoyer wrote:
> Hi,
>
> Giacomo Leidi  writes:
>
>> This patch replaces boilerplate in container related tests with
>> oci-image plumbing from (gnu services containers).
>>
>> * gnu/services/containers.scm: Export lower-oci-image-state.
> I don't think that's a nice API to export; you can instead use the
>
> (define lower-oci-image-state
>    (@@ (gnu services containers) lower-oci-image-state)
>
> trick to expose internals (white box testing).
Good point, addressed.
>> * gnu/tests/containers.scm (%oci-tarball): New variable;
>> (run-rootless-podman-test): use %oci-tarball;
>> (build-tarball&run-rootless-podman-test): drop procedure.
>> * gnu/tests/docker.scm (%docker-tarball): New variable;
>> (build-tarball&run-docker-test): use %docker-tarball;
>> (%docker-system-tarball): New variable;
>> (build-tarball&run-docker-system-test): new procedure.
>>
>> Change-Id: Iad6f0704aee188d89464c83722dea0bb7adb084a
>> ---
>>   gnu/services/containers.scm |   2 +
>>   gnu/tests/containers.scm    |  80 ++++++++++++++---------------
>>   gnu/tests/docker.scm        | 100 ++++++++++++++++++++----------------
>>   3 files changed, 95 insertions(+), 87 deletions(-)
> The diffstats suggest the result is not that impactful in terms of
> reducing boilerplate, ah!
I would like to work to a single Scheme API in the future, that can be 
common to guix pack, guix system internals and the oci-service-type 
internals. But yeah the boilerplate is not much less.

v11 should have all your comments addressed, thank you for your review.

cheers,
giacomo




From unknown Fri Jun 13 11:55:10 2025
X-Loop: help-debbugs@gnu.org
Subject: [bug#76081] [PATCH v10 6/7] services: oci: Migrate oci-configuration to (guix records).
Resent-From: paul 
Original-Sender: "Debbugs-submit" 
Resent-CC: guix-patches@gnu.org
Resent-Date: Sun, 01 Jun 2025 02:25:05 +0000
Resent-Message-ID: 
Resent-Sender: help-debbugs@gnu.org
X-GNU-PR-Message: followup 76081
X-GNU-PR-Package: guix-patches
X-GNU-PR-Keywords: moreinfo
To: Maxim Cournoyer 
Cc: 76081@debbugs.gnu.org
Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.174874468710492
          (code B ref 76081); Sun, 01 Jun 2025 02:25:05 +0000
Received: (at 76081) by debbugs.gnu.org; 1 Jun 2025 02:24:47 +0000
Received: from localhost ([127.0.0.1]:34419 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from )
	id 1uLYNR-0002is-5k
	for submit@debbugs.gnu.org; Sat, 31 May 2025 22:24:46 -0400
Received: from confino.investici.org ([93.190.126.19]:49229)
 by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
 (Exim 4.84_2) (envelope-from )
 id 1uLYNN-0002hu-7Q
 for 76081@debbugs.gnu.org; Sat, 31 May 2025 22:24:42 -0400
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org;
 s=stigmate; t=1748744678;
 bh=fFTgbGlZnTyIEk841fbvq8Y+8pa2NySZxJq/9N6FF9M=;
 h=Date:Subject:To:Cc:References:From:In-Reply-To:From;
 b=Hi6vFFtsvAPXDE1fieani79VqdXyLj7lygMz3PbIW8N5dhj0e6DJPMCVcNLiBk4kQ
 a8VJMMyW1mq8YEAxNQxvJo/bzR1kS6eC2VkaGBzpECa0tC7D5d6nh22+D+m42skWB4
 q3HeO8jxJ1I/8taDqZmBDU4xgPGanFQz4LdfIZhM=
Received: from mx1.investici.org (unknown [127.0.0.1])
 by confino.investici.org (Postfix) with ESMTP id 4b915L5qLGz118Z;
 Sun,  1 Jun 2025 02:24:38 +0000 (UTC)
Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19])
 (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with
 ESMTPSA id 4b915L4z54z117t; Sun,  1 Jun 2025 02:24:38 +0000 (UTC)
Content-Type: multipart/alternative;
 boundary="------------7opaj8KI6HyEpH5uOS4nc7PX"
Message-ID: 
Date: Sun, 1 Jun 2025 04:24:38 +0200
MIME-Version: 1.0
User-Agent: Icedove Daily
References: <2b78b4ce9b0a3a6c0bdbdec5bb16702a5b5083a3.1746431874.git.goodoldpaul@autistici.org>
 <1f148e2994e78ed4614efe885380c06740515d0b.1746431874.git.goodoldpaul@autistici.org>
 <87bjrtia85.fsf@gmail.com>
Content-Language: en-US
From: paul 
In-Reply-To: <87bjrtia85.fsf@gmail.com>
X-Spam-Score: -0.7 (/)
X-BeenThere: debbugs-submit@debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: 
List-Unsubscribe: , 
 
List-Archive: 
List-Post: 
List-Help: 
List-Subscribe: , 
 
Errors-To: debbugs-submit-bounces@debbugs.gnu.org
Sender: "Debbugs-submit" 
X-Spam-Score: -1.7 (-)

This is a multi-part message in MIME format.
--------------7opaj8KI6HyEpH5uOS4nc7PX
Content-Type: text/plain; charset=UTF-8; format=flowed
Content-Transfer-Encoding: 7bit

Hi,

On 5/16/25 04:02, Maxim Cournoyer wrote:
> Also, there are other home services using a define-configuration'd
> record with for-home, such as the home-snuik-service-type, so it should
> be possible to make it work.

You are right, thank you! I was probably mistaken. I dropped the patch.

cheers,

giacomo

--------------7opaj8KI6HyEpH5uOS4nc7PX
Content-Type: text/html; charset=UTF-8
Content-Transfer-Encoding: 7bit



  
    
  
  
    
Hi,

    

    
On 5/16/25 04:02, Maxim Cournoyer
      wrote:

    

    



      
Also, there are other home services using a define-configuration'd
record with for-home, such as the home-snuik-service-type, so it should
be possible to make it work.


    

    
You are right, thank you! I was probably mistaken. I dropped the
      patch.

    
cheers,

    
giacomo

    

  


--------------7opaj8KI6HyEpH5uOS4nc7PX--




From unknown Fri Jun 13 11:55:10 2025
X-Loop: help-debbugs@gnu.org
Subject: [bug#76081] [PATCH v10 7/7] home: Add home-oci-service-type.
Resent-From: paul 
Original-Sender: "Debbugs-submit" 
Resent-CC: guix-patches@gnu.org
Resent-Date: Sun, 01 Jun 2025 02:50:05 +0000
Resent-Message-ID: 
Resent-Sender: help-debbugs@gnu.org
X-GNU-PR-Message: followup 76081
X-GNU-PR-Package: guix-patches
X-GNU-PR-Keywords: moreinfo
To: Maxim Cournoyer 
Cc: Tanguy Le Carrour , Ludovic =?UTF-8?Q?Court=C3=A8s?= , Gabriel Wicki , Andrew Tropin , Hilton Chain , 76081@debbugs.gnu.org, Janneke Nieuwenhuizen 
Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.174874618721007
          (code B ref 76081); Sun, 01 Jun 2025 02:50:05 +0000
Received: (at 76081) by debbugs.gnu.org; 1 Jun 2025 02:49:47 +0000
Received: from localhost ([127.0.0.1]:34543 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from )
	id 1uLYla-0005SM-UL
	for submit@debbugs.gnu.org; Sat, 31 May 2025 22:49:46 -0400
Received: from confino.investici.org ([2a11:7980:1::2:0]:28851)
 by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
 (Exim 4.84_2) (envelope-from )
 id 1uLYlV-0005Re-3w
 for 76081@debbugs.gnu.org; Sat, 31 May 2025 22:49:39 -0400
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org;
 s=stigmate; t=1748746174;
 bh=gSPGbUvmSHwNumxqNYSGKsBZqzC3yq8nm8HqszIZGIM=;
 h=Date:Subject:To:Cc:References:From:In-Reply-To:From;
 b=RZKYVk5a7C8l/Syp3EpS2nRP+cSTGz2It3SN9BLoUGncq0yioWVZ0ugpgWWtCyLdN
 uOwvSw4bqC8Il6Dq5d0TgtmH379Tv2BXR7dAs7qhqapkFh1GZvGwGtRN8/YlZmNRML
 VEosaW/qt+ZCZOCyc/iKbG+UdQsn7oI4UlSgLXMo=
Received: from mx1.investici.org (unknown [127.0.0.1])
 by confino.investici.org (Postfix) with ESMTP id 4b91f60krCz118Z;
 Sun,  1 Jun 2025 02:49:34 +0000 (UTC)
Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19])
 (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with
 ESMTPSA id 4b91f554Ddz1181; Sun,  1 Jun 2025 02:49:33 +0000 (UTC)
Content-Type: multipart/alternative;
 boundary="------------Kvo0xWb0IgLjL7KU6xfTMIXg"
Message-ID: <772c4c9b-ae5b-4073-9029-fbfa34c2ae6d@autistici.org>
Date: Sun, 1 Jun 2025 04:49:33 +0200
MIME-Version: 1.0
User-Agent: Icedove Daily
References: <2b78b4ce9b0a3a6c0bdbdec5bb16702a5b5083a3.1746431874.git.goodoldpaul@autistici.org>
 <91c9920430684861541c86a01c28bd46423102c8.1746431874.git.goodoldpaul@autistici.org>
 <877c2hi9zh.fsf@gmail.com>
Content-Language: en-US
From: paul 
In-Reply-To: <877c2hi9zh.fsf@gmail.com>
X-Spam-Score: -0.0 (/)
X-BeenThere: debbugs-submit@debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: 
List-Unsubscribe: , 
 
List-Archive: 
List-Post: 
List-Help: 
List-Subscribe: , 
 
Errors-To: debbugs-submit-bounces@debbugs.gnu.org
Sender: "Debbugs-submit" 
X-Spam-Score: -1.0 (-)

This is a multi-part message in MIME format.
--------------Kvo0xWb0IgLjL7KU6xfTMIXg
Content-Type: text/plain; charset=UTF-8; format=flowed
Content-Transfer-Encoding: 7bit

Hi Maxim,

thank you for your extensive help. I'm sending a v11 which hopefully 
addresses everything. I tested my changes with:

guix shell -CPWN --writable-root nss-certs -m manifest.scm -- make check-system TESTS="pounce jami ngircd oci-service-rootless-podman oci-service-docker oci-container rootless-podman docker docker-system"

cheers,
giacomo

--------------Kvo0xWb0IgLjL7KU6xfTMIXg
Content-Type: text/html; charset=UTF-8
Content-Transfer-Encoding: 7bit



  
    
  
  
    
Hi Maxim,

    
thank you for your extensive help. I'm sending a v11 which
      hopefully addresses everything. I tested my changes with:

      

    

    
guix shell -CPWN --writable-root nss-certs -m manifest.scm -- make check-system TESTS="pounce jami ngircd oci-service-rootless-podman oci-service-docker oci-container rootless-podman docker docker-system"



    
cheers,

      giacomo

    

  


--------------Kvo0xWb0IgLjL7KU6xfTMIXg--




From unknown Fri Jun 13 11:55:10 2025
X-Loop: help-debbugs@gnu.org
Subject: [bug#76081] [PATCH v11 3/5] services: Add oci-service-type.
Resent-From: Giacomo Leidi 
Original-Sender: "Debbugs-submit" 
Resent-CC: gabriel@erlikon.ch, ludo@gnu.org, maxim.cournoyer@gmail.com, guix-patches@gnu.org
Resent-Date: Sun, 01 Jun 2025 02:52:05 +0000
Resent-Message-ID: 
Resent-Sender: help-debbugs@gnu.org
X-GNU-PR-Message: followup 76081
X-GNU-PR-Package: guix-patches
X-GNU-PR-Keywords: moreinfo
To: 76081@debbugs.gnu.org
Cc: Giacomo Leidi , Gabriel Wicki , Ludovic =?UTF-8?Q?Court=C3=A8s?= , Maxim Cournoyer 
X-Debbugs-Original-Xcc: Gabriel Wicki , Ludovic =?UTF-8?Q?Court=C3=A8s?= , Maxim Cournoyer 
Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.174874629922007
          (code B ref 76081); Sun, 01 Jun 2025 02:52:05 +0000
Received: (at 76081) by debbugs.gnu.org; 1 Jun 2025 02:51:39 +0000
Received: from localhost ([127.0.0.1]:34553 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from )
	id 1uLYnR-0005iq-PR
	for submit@debbugs.gnu.org; Sat, 31 May 2025 22:51:37 -0400
Received: from confino.investici.org ([2a11:7980:1::2:0]:30065)
 by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
 (Exim 4.84_2) (envelope-from )
 id 1uLYnO-0005i8-29
 for 76081@debbugs.gnu.org; Sat, 31 May 2025 22:51:34 -0400
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org;
 s=stigmate; t=1748746293;
 bh=nOvNzAeUUqWY56T9zoJh/y4pYUmsawjQdb7in7TRP0g=;
 h=From:To:Cc:Subject:Date:In-Reply-To:References:From;
 b=oPc0tIGjO37jkPwKkyLZzKI7hZXt2hZPteCeU1Gy0TVt2TAPJnMPks6ZkFflDzvfl
 ltNJGvwpPppoA+1OPqSB3NuWv2oVzsyRJcSA7AWwRVGFt5ViBI5n7Lr8BDxn0k6iJ6
 JoggBAsExCfRITzPGdJpVWQwOBRrpz/Mj8568IBI=
Received: from mx1.investici.org (unknown [127.0.0.1])
 by confino.investici.org (Postfix) with ESMTP id 4b91hP12nHz118c;
 Sun,  1 Jun 2025 02:51:33 +0000 (UTC)
Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19])
 (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with
 ESMTPSA id 4b91hN6YWSz1181; Sun,  1 Jun 2025 02:51:32 +0000 (UTC)
From: Giacomo Leidi 
Date: Sun,  1 Jun 2025 04:51:16 +0200
Message-ID: <289b2dbdb1aea74d65d04aa1290fd7fa2d39afaf.1748746278.git.goodoldpaul@autistici.org>
X-Mailer: git-send-email 2.49.0
In-Reply-To: <8ac2edf51988af974ed0b4cd4ac63da23ce17118.1748746278.git.goodoldpaul@autistici.org>
References: <8ac2edf51988af974ed0b4cd4ac63da23ce17118.1748746278.git.goodoldpaul@autistici.org>
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
X-BeenThere: debbugs-submit@debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: 
List-Unsubscribe: , 
 
List-Archive: 
List-Post: 
List-Help: 
List-Subscribe: , 
 
Errors-To: debbugs-submit-bounces@debbugs.gnu.org
Sender: "Debbugs-submit" 

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
Signed-off-by: Giacomo Leidi 
---
 doc/guix.texi                |  306 ++++++--
 gnu/build/oci-containers.scm |  210 ++++++
 gnu/local.mk                 |    1 +
 gnu/services/containers.scm  | 1365 +++++++++++++++++++++++++++++-----
 gnu/services/docker.scm      |   38 +-
 gnu/tests/containers.scm     |  561 +++++++++++++-
 6 files changed, 2208 insertions(+), 273 deletions(-)
 create mode 100644 gnu/build/oci-containers.scm

diff --git a/doc/guix.texi b/doc/guix.texi
index 5fefba36342..ae49d0c547b 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -43937,59 +43937,162 @@ Miscellaneous Services
 @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: given an
-@acronym{Open Container Initiative, OCI} container image, it will run it in a
+Should you wish to manage your @acronym{Open Container Initiative, OCI} containers
+with the same consistent interface you use for your other Shepherd services,
+@var{oci-service-type} is the tool to use: given an
+OCI container image, it will run it in a
 Shepherd service.  One example where this is useful: it lets you run services
-that are available as Docker/OCI images but not yet packaged for Guix.
+that are available as OCI images but not yet packaged for Guix.
 
-@defvar oci-container-service-type
+@defvar oci-service-type
 
-This is a thin wrapper around Docker's CLI that executes OCI images backed
+This is a thin wrapper around Docker's or Podman's CLI that executes OCI images backed
 processes as Shepherd Services.
 
 @lisp
-(service oci-container-service-type
-         (list
-          (oci-container-configuration
-           (network "host")
-           (image
-            (oci-image
-             (repository "guile")
-             (tag "3")
-             (value (specifications->manifest '("guile")))
-             (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile"))
-                             #:max-layers 2))))
-           (entrypoint "/bin/guile")
-           (command
-            '("-c" "(display \"hello!\n\")")))
-          (oci-container-configuration
-           (image "prom/prometheus")
-           (ports
-             '(("9000" . "9000")
-               ("9090" . "9090"))))
-          (oci-container-configuration
-           (image "grafana/grafana:10.0.1")
-           (network "host")
-           (volumes
-             '("/var/lib/grafana:/var/lib/grafana")))))
+(simple-service 'oci-provisioning
+                oci-service-type
+                (oci-extension
+                  (networks
+                    (list
+                      (oci-network-configuration (name "monitoring"))))
+                  (containers
+                   (list
+                    (oci-container-configuration
+                     (network "monitoring")
+                     (image
+                      (oci-image
+                        (repository "guile")
+                        (tag "3")
+                        (value (specifications->manifest '("guile")))
+                        (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile"))
+                                        #:max-layers 2))))
+                     (entrypoint "/bin/guile")
+                     (command
+                      '("-c" "(display \"hello!\n\")")))
+                    (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
 
 In this example three different Shepherd services are going to be added to the
 system.  Each @code{oci-container-configuration} record translates to a
-@code{docker run} invocation and its fields directly map to options.  You can
-refer to the
-@url{https://docs.docker.com/engine/reference/commandline/run,upstream}
-documentation for the semantics of each value.  If the images are not found,
-they will be
-@url{https://docs.docker.com/engine/reference/commandline/pull/,pulled}.  The
+@samp{docker run} or @samp{podman run} invocation and its fields directly
+map to options.  You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html,Podman}
+upstream documentation for semantics of each value.  If the images are not found,
+they will be pulled.  You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/pull/,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-pull.1.html,Podman}
+upstream documentation for semantics.  The
 services with @code{(network "host")} are going to be attached to the
 host network and are supposed to behave like native processes with regard to
 networking.
 
 @end defvar
 
+@c %start of fragment
+
+@deftp {Data Type} oci-configuration
+Available @code{oci-configuration} fields are:
+
+@table @asis
+@item @code{runtime} (default: @code{'docker}) (type: symbol)
+The OCI runtime to use to run commands.  It can be either @code{'docker} or
+@code{'podman}.
+
+@item @code{runtime-cli} (type: maybe-package-or-string)
+The OCI runtime command line to be installed in the system profile and used
+to provision OCI resources, it can be either a package or a string representing
+an absolute file name to the runtime binary entrypoint.  When unset it will default
+to @code{docker-cli} package for the @code{'docker} runtime or to @code{podman}
+package for the @code{'podman} runtime.
+
+@item @code{runtime-extra-arguments} (default: @code{'()}) (type: list)
+A list of strings, gexps or file-like objects that will be placed
+after each @command{docker} or @command{podman} invokation.
+
+@item @code{user} (type: maybe-string)
+The user name under whose authority OCI commands will be run.  This field will
+override the @code{user} field of @code{oci-configuration}.
+
+@item @code{group} (type: maybe-string)
+The group name under whose authority OCI commands will be run.  When
+using the @code{'podman} OCI runtime, this field will be ignored and the
+default group of the user configured in the @code{user} field will be used.
+This field will override the @code{group} field of @code{oci-configuration}.
+
+@item @code{subuids-range} (type: maybe-subid-range)
+An optional @code{subid-range} record allocating subuids for the user from
+the @code{user} field.  When unset, with the rootless Podman OCI runtime, it
+defaults to @code{(subid-range (name "oci-container"))}.
+
+@item @code{subgids-range} (type: maybe-subid-range)
+An optional @code{subid-range} record allocating subgids for the user from
+the @code{user} field.  When unset, with the rootless Podman OCI runtime, it
+defaults to @code{(subid-range (name "oci-container"))}.
+
+@item @code{containers} (default: @code{'()}) (type: list-of-oci-containers)
+The list of @code{oci-container-configuration} records representing the
+containers to provision.  The use of the @code{oci-extension} record should
+be preferred for most cases.
+
+@item @code{networks} (default: @code{'()}) (type: list-of-oci-networks)
+The list of @code{oci-network-configuration} records representing the
+containers to provision.  The use of the @code{oci-extension} record should
+be preferred for most cases.
+
+@item @code{volumes} (default: @code{'()}) (type: list-of-oci-volumes)
+The list of @code{oci-volumes-configuration} records representing the
+containers to provision.  The use of the @code{oci-extension} record should
+be preferred for most cases.
+
+@item @code{verbose?} (default: @code{#f}) (type: boolean)
+When true, additional output will be printed, allowing to better follow the
+flow of execution.
+
+@end table
+
+@end deftp
+
+
+@c %end of fragment
+
+@c %start of fragment
+
+@deftp {Data Type} oci-extension
+Available @code{oci-extension} fields are:
+
+@table @asis
+@item @code{containers} (default: @code{'()}) (type: list-of-oci-containers)
+The list of @code{oci-container-configuration} records representing the
+containers to provision.
+
+@item @code{networks} (default: @code{'()}) (type: list-of-oci-networks)
+The list of @code{oci-network-configuration} records representing the
+containers to provision.
+
+@item @code{volumes} (default: @code{'()}) (type: list-of-oci-volumes)
+The list of @code{oci-volumes-configuration} records representing the
+containers to provision.
+
+@end table
+
+@end deftp
+
+
+@c %end of fragment
+
+
 @c %start of fragment
 
 @deftp {Data Type} oci-container-configuration
@@ -44009,16 +44112,16 @@ Miscellaneous Services
 Overwrite the default entrypoint (@code{ENTRYPOINT}) of the image.
 
 @item @code{host-environment} (default: @code{'()}) (type: 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
+Set environment variables in the host environment where @samp{docker run}
+or @samp{podman run} are invoked.  This is especially useful to pass secrets
+from the host to the container without having them on the OCI runtime command line,
+for example: by setting the @code{MYSQL_PASSWORD} on the host and by passing
 @code{--env MYSQL_PASSWORD} through the @code{extra-arguments} field, it is
 possible to securely set values in the container environment.  This field's
 value can be a list of pairs or strings, even mixed:
 
 @lisp
-(list '("LANGUAGE\" . "eo:ca:eu")
+(list '("LANGUAGE" . "eo:ca:eu")
       "JAVA_HOME=/opt/java")
 @end lisp
 
@@ -44026,22 +44129,24 @@ Miscellaneous Services
 directly to @code{make-forkexec-constructor}.
 
 @item @code{environment} (default: @code{'()}) (type: list)
-Set environment variables. This can be a list of pairs or strings, even mixed:
+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
-@uref{https://docs.docker.com/engine/reference/commandline/run/#env,upstream}
-documentation for semantics.
+Pair members can be strings, gexps or file-like objects. Strings are passed
+directly to the OCI runtime CLI.  You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#env,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#env-e-env,Podman}
+upstream documentation for semantics.
 
 @item @code{image} (type: 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{oci-image} record.  Strings are resolved by the OCI runtime,
+and follow the usual format
 @code{myregistry.local:5000/testing/test-image:tag}.
 
 @item @code{provision} (default: @code{""}) (type: string)
@@ -44069,7 +44174,7 @@ Miscellaneous Services
 by the service.
 
 @item @code{network} (default: @code{""}) (type: string)
-Set a Docker network for the spawned container.
+Set an OCI 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
@@ -44080,10 +44185,11 @@ Miscellaneous Services
       "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
-@uref{https://docs.docker.com/engine/reference/commandline/run/#publish,upstream}
-documentation for semantics.
+Pair members can be strings, gexps or file-like objects. Strings are passed
+directly to the OCI runtime CLI.  You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#publish,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#publish-p-ip-hostport-containerport-protocol,Podman}
+upstream documentation for semantics.
 
 @item @code{volumes} (default: @code{'()}) (type: list)
 Set volume mappings for the spawned container.  This can be a
@@ -44094,25 +44200,97 @@ Miscellaneous Services
       "/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
-@uref{https://docs.docker.com/engine/reference/commandline/run/#volume,upstream}
-documentation for semantics.
+Pair members can be strings, gexps or file-like objects. Strings are passed
+directly to the OCI runtime CLI.  You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#volume,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#volume-v-source-volume-host-dir-container-dir-options,Podman}
+upstream documentation for semantics.
 
 @item @code{container-user} (default: @code{""}) (type: 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.
+@url{https://docs.docker.com/engine/reference/run/#user,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#user-u-user-group,Podman}
+upstream documentation for semantics.
 
 @item @code{workdir} (default: @code{""}) (type: string)
 Set the current working directory for the spawned Shepherd service.
 You can refer to the
-@url{https://docs.docker.com/engine/reference/run/#workdir,upstream}
-documentation for semantics.
+@url{https://docs.docker.com/engine/reference/run/#workdir,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#workdir-w-dir,Podman}
+upstream documentation for semantics.
+
+@item @code{extra-arguments} (default: @code{'()}) (type: list)
+A list of strings, gexps or file-like objects that will be directly passed
+to the @samp{docker run} or @samp{podman run} invokation.
+
+@end table
+
+@end deftp
+
+
+@c %end of fragment
+
+@c %start of fragment
+
+@deftp {Data Type} oci-network-configuration
+Available @code{oci-network-configuration} fields are:
+
+@table @asis
+@item @code{name} (type: string)
+The name of the OCI network to provision.
+
+@item @code{driver} (type: maybe-string)
+The driver to manage the network.
+
+@item @code{gateway} (type: maybe-string)
+IPv4 or IPv6 gateway for the subnet.
+
+@item @code{internal?} (default: @code{#f}) (type: boolean)
+Restrict external access to the network
+
+@item @code{ip-range} (type: maybe-string)
+Allocate container ip from a sub-range in CIDR format.
+
+@item @code{ipam-driver} (type: maybe-string)
+IP Address Management Driver.
+
+@item @code{ipv6?} (default: @code{#f}) (type: boolean)
+Enable IPv6 networking.
+
+@item @code{subnet} (type: maybe-string)
+Subnet in CIDR format that represents a network segment.
+
+@item @code{labels} (default: @code{'()}) (type: list)
+The list of labels that will be used to tag the current volume.
+
+@item @code{extra-arguments} (default: @code{'()}) (type: list)
+A list of strings, gexps or file-like objects that will be directly passed
+to the @samp{docker network create} or @samp{podman network create}
+invokation.
+
+@end table
+
+@end deftp
+
+
+@c %end of fragment
+
+@c %start of fragment
+
+@deftp {Data Type} oci-volume-configuration
+Available @code{oci-volume-configuration} fields are:
+
+@table @asis
+@item @code{name} (type: string)
+The name of the OCI volume to provision.
+
+@item @code{labels} (default: @code{'()}) (type: list)
+The list of labels that will be used to tag the current volume.
 
 @item @code{extra-arguments} (default: @code{'()}) (type: list)
-A list of strings, gexps or file-like objects that will be directly
-passed to the @command{docker run} invocation.
+A list of strings, gexps or file-like objects that will be directly passed
+to the @samp{docker volume create} or @samp{podman volume create}
+invokation.
 
 @end table
 
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 
+;;;
+;;; 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 .
+
+;;; 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))
diff --git a/gnu/local.mk b/gnu/local.mk
index 4500bfc6d33..09ccd64b40a 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -840,6 +840,7 @@ GNU_SYSTEM_MODULES =				\
   %D%/build/linux-initrd.scm			\
   %D%/build/linux-modules.scm			\
   %D%/build/marionette.scm			\
+  %D%/build/oci-containers.scm			\
   %D%/build/secret-service.scm			\
   %D%/build/utils.scm   			\
 						\
diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm
index 24f31c756b8..745a40ff02b 100644
--- a/gnu/services/containers.scm
+++ b/gnu/services/containers.scm
@@ -35,12 +35,15 @@ (define-module (gnu services containers)
   #:use-module (guix diagnostics)
   #:use-module (guix gexp)
   #:use-module (guix i18n)
+  #:use-module (guix modules)
   #:use-module (guix monads)
   #:use-module (guix packages)
   #:use-module (guix profiles)
   #:use-module ((guix scripts pack) #:prefix pack:)
+  #:use-module (guix records)
   #:use-module (guix store)
   #:use-module (srfi srfi-1)
+  #:use-module (ice-9 format)
   #:use-module (ice-9 match)
   #:export (rootless-podman-configuration
             rootless-podman-configuration?
@@ -96,8 +99,82 @@ (define-module (gnu services containers)
             oci-container-configuration-workdir
             oci-container-configuration-extra-arguments
 
+            list-of-oci-containers?
+            list-of-oci-networks?
+            list-of-oci-volumes?
+
+            %oci-supported-runtimes
+            oci-runtime?
+            oci-runtime-system-environment
+            oci-runtime-system-extra-arguments
+            oci-runtime-system-requirement
+            oci-runtime-cli
+            oci-runtime-system-cli
+            oci-runtime-home-cli
+            oci-runtime-name
+            oci-runtime-group
+
+            oci-network-configuration
+            oci-network-configuration?
+            oci-network-configuration-fields
+            oci-network-configuration-name
+            oci-network-configuration-driver
+            oci-network-configuration-gateway
+            oci-network-configuration-internal?
+            oci-network-configuration-ip-range
+            oci-network-configuration-ipam-driver
+            oci-network-configuration-ipv6?
+            oci-network-configuration-subnet
+            oci-network-configuration-labels
+            oci-network-configuration-extra-arguments
+
+            oci-volume-configuration
+            oci-volume-configuration?
+            oci-volume-configuration-fields
+            oci-volume-configuration-name
+            oci-volume-configuration-labels
+            oci-volume-configuration-extra-arguments
+
+            oci-configuration
+            oci-configuration?
+            oci-configuration-fields
+            oci-configuration-runtime
+            oci-configuration-runtime-cli
+            oci-configuration-runtime-extra-arguments
+            oci-configuration-user
+            oci-configuration-group
+            oci-configuration-containers
+            oci-configuration-networks
+            oci-configuration-volumes
+            oci-configuration-verbose?
+            oci-configuration-valid?
+
+            oci-extension
+            oci-extension?
+            oci-extension-fields
+            oci-extension-containers
+            oci-extension-networks
+            oci-extension-volumes
+
+            oci-container-shepherd-name
+            oci-networks-shepherd-name
+            oci-networks-home-shepherd-name
+            oci-volumes-shepherd-name
+            oci-volumes-home-shepherd-name
+
+            oci-container-configuration->options
+            oci-network-configuration->options
+            oci-volume-configuration->options
+
             oci-container-shepherd-service
-            %oci-container-accounts))
+            oci-objects-merge-lst
+            oci-extension-merge
+            oci-service-type
+            oci-service-accounts
+            oci-service-profile
+            oci-service-subids
+            oci-configuration->shepherd-services
+            oci-configuration-extend))
 
 (define (gexp-or-string? value)
   (or (gexp? value)
@@ -296,9 +373,42 @@ (define rootless-podman-service-type
 
 
 ;;;
-;;; OCI container.
+;;; OCI provisioning service.
 ;;;
 
+(define %oci-supported-runtimes
+  '(docker podman))
+
+(define (oci-runtime-system-requirement runtime)
+  "Return a list of Shepherd service names required by a given OCI runtime,
+before it is able to run containers."
+  (if (eq? 'podman runtime)
+      '(cgroups2-fs-owner cgroups2-limits
+        rootless-podman-shared-root-fs user-processes)
+      '(dockerd user-processes)))
+
+(define (oci-runtime-name runtime)
+  "Return a human readable name for a given OCI runtime."
+  (if (eq? 'podman runtime)
+      "Podman" "Docker"))
+
+(define (oci-runtime-group runtime maybe-group)
+  "Implement the logic behind selection of the group that is to be used by
+Shepherd to execute OCI commands."
+  (if (maybe-value-set? maybe-group)
+      maybe-group
+      (if (eq? 'podman runtime)
+          "cgroup"
+          "docker")))
+
+(define (oci-runtime? value)
+  (unless (member value %oci-supported-runtimes)
+    (raise
+     (formatted-message
+      (G_ "OCI runtime must be a symbol and one of ~a,
+but ~a was found") %oci-supported-runtimes value)))
+  (symbol? value))
+
 (define (oci-sanitize-pair pair delimiter)
   (define (valid? member)
     (or (string? member)
@@ -332,21 +442,41 @@ (define (oci-sanitize-host-environment value)
   ;; '(("HOME" . "/home/nobody") "JAVA_HOME=/java")
   (oci-sanitize-mixed-list "host-environment" value "="))
 
+(define (oci-container-host-environment? value)
+  (list? (oci-sanitize-host-environment value)))
+
 (define (oci-sanitize-environment value)
   ;; Expected spec format:
   ;; '(("HOME" . "/home/nobody") "JAVA_HOME=/java")
   (oci-sanitize-mixed-list "environment" value "="))
 
+(define (oci-container-environment? value)
+  (list? (oci-sanitize-environment value)))
+
 (define (oci-sanitize-ports value)
   ;; Expected spec format:
   ;; '(("8088" . "80") "2022:22")
   (oci-sanitize-mixed-list "ports" value ":"))
 
+(define (oci-container-ports? value)
+  (list? (oci-sanitize-ports value)))
+
 (define (oci-sanitize-volumes value)
   ;; Expected spec format:
   ;; '(("/mnt/dir" . "/dir") "/run/current-system/profile:/java")
   (oci-sanitize-mixed-list "volumes" value ":"))
 
+(define (oci-container-volumes? value)
+  (list? (oci-sanitize-volumes value)))
+
+(define (oci-sanitize-labels value)
+  ;; Expected spec format:
+  ;; '(("foo" . "bar") "foo=bar")
+  (oci-sanitize-mixed-list "labels" value "="))
+
+(define (oci-object-labels? value)
+  (list? (oci-sanitize-labels value)))
+
 (define (oci-sanitize-shepherd-actions value)
   (map
    (lambda (el)
@@ -358,6 +488,9 @@ (define (oci-sanitize-shepherd-actions value)
 but ~a was found") el))))
    value))
 
+(define (oci-container-shepherd-actions? value)
+  (list? (oci-sanitize-shepherd-actions value)))
+
 (define (oci-sanitize-extra-arguments value)
   (define (valid? member)
     (or (string? member)
@@ -373,11 +506,19 @@ (define (oci-sanitize-extra-arguments value)
 but ~a was found") el))))
    value))
 
+(define (oci-object-extra-arguments? value)
+  (list? (oci-sanitize-extra-arguments value)))
+
 (define (oci-image-reference image)
-  (if (string? image)
-      image
-      (string-append (oci-image-repository image)
-                     ":" (oci-image-tag image))))
+  "Return a string OCI image reference representing IMAGE."
+  (define reference
+    (if (string? image)
+        image
+        (string-append (oci-image-repository image)
+                       ":" (oci-image-tag image))))
+  (if (> (length (string-split reference #\/)) 1)
+        reference
+        (string-append "localhost/" reference)))
 
 (define (oci-lowerable-image? image)
   (or (manifest? image)
@@ -392,7 +533,19 @@ (define (string-or-oci-image? image)
 (define list-of-symbols?
   (list-of symbol?))
 
+(define (list-of-oci-records? name predicate value)
+  (map
+   (lambda (el)
+     (if (predicate el)
+         el
+         (raise
+          (formatted-message
+           (G_ "~a contains an illegal value: ~a") name el))))
+   value))
+
 (define-maybe/no-serialization string)
+(define-maybe/no-serialization package)
+(define-maybe/no-serialization subid-range)
 
 (define-configuration/no-serialization oci-image
   (repository
@@ -437,11 +590,15 @@ (define-configuration/no-serialization oci-image
 
 (define-configuration/no-serialization oci-container-configuration
   (user
-   (string "oci-container")
-   "The user under whose authority docker commands will be run.")
+   (maybe-string)
+   "The user name under whose authority OCI commands will be run.  This field will
+override the @code{user} field of @code{oci-configuration}.")
   (group
-   (string "docker")
-   "The group under whose authority docker commands will be run.")
+   (maybe-string)
+   "The group name under whose authority OCI commands will be run.  When
+using the @code{'podman} OCI runtime, this field will be ignored and the
+default group of the user configured in the @code{user} field will be used.
+This field will override the @code{group} field of @code{oci-configuration}.")
   (command
    (list-of-strings '())
    "Overwrite the default command (@code{CMD}) of the image.")
@@ -449,11 +606,11 @@ (define-configuration/no-serialization oci-container-configuration
    (maybe-string)
    "Overwrite the default entrypoint (@code{ENTRYPOINT}) of the image.")
   (host-environment
-   (list '())
+   (oci-container-host-environment '())
    "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
+or @command{podman run} are invoked.  This is especially useful to pass secrets
+from the host to the container without having them on the OCI runtime command line,
+for example: by setting the @code{MYSQL_PASSWORD} on the host and by passing
 @code{--env MYSQL_PASSWORD} through the @code{extra-arguments} field, it is
 possible to securely set values in the container environment.  This field's
 value can be a list of pairs or strings, even mixed:
@@ -467,7 +624,7 @@ (define-configuration/no-serialization oci-container-configuration
 directly to @code{make-forkexec-constructor}."
    (sanitizer oci-sanitize-host-environment))
   (environment
-   (list '())
+   (oci-container-environment '())
    "Set environment variables inside the container.  This can be a list of pairs
 or strings, even mixed:
 
@@ -477,15 +634,16 @@ (define-configuration/no-serialization oci-container-configuration
 @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."
+directly to the OCI runtime CLI.  You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#env,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#env-e-env,Podman}
+upstream documentation for semantics."
    (sanitizer oci-sanitize-environment))
   (image
    (string-or-oci-image)
    "The image used to build the container.  It can be a string or an
-@code{oci-image} record.  Strings are resolved by the Docker
-Engine, and follow the usual format
+@code{oci-image} record.  Strings are resolved by the OCI runtime,
+and follow the usual format
 @code{myregistry.local:5000/testing/test-image:tag}.")
   (provision
    (maybe-string)
@@ -508,15 +666,15 @@ (define-configuration/no-serialization oci-container-configuration
    "Whether to restart the service when it stops, for instance when the
 underlying process dies.")
   (shepherd-actions
-   (list '())
+   (oci-container-shepherd-actions '())
    "This is a list of @code{shepherd-action} records defining actions supported
 by the service."
    (sanitizer oci-sanitize-shepherd-actions))
   (network
    (maybe-string)
-   "Set a Docker network for the spawned container.")
+   "Set an OCI network for the spawned container.")
   (ports
-   (list '())
+   (oci-container-ports '())
    "Set the port or port ranges to expose from the spawned container.  This can
 be a list of pairs or strings, even mixed:
 
@@ -526,12 +684,13 @@ (define-configuration/no-serialization oci-container-configuration
 @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."
+directly to the OCI runtime CLI.  You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#publish,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#publish-p-ip-hostport-containerport-protocol,Podman}
+upstream documentation for semantics."
    (sanitizer oci-sanitize-ports))
   (volumes
-   (list '())
+   (oci-container-volumes '())
    "Set volume mappings for the spawned container.  This can be a
 list of pairs or strings, even mixed:
 
@@ -541,71 +700,352 @@ (define-configuration/no-serialization oci-container-configuration
 @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."
+directly to the OCI runtime CLI.  You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#volume,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#volume-v-source-volume-host-dir-container-dir-options,Podman}
+upstream documentation for semantics."
    (sanitizer oci-sanitize-volumes))
   (container-user
    (maybe-string)
    "Set the current user inside the spawned container.  You can refer to the
-@url{https://docs.docker.com/engine/reference/run/#user,upstream}
-documentation for semantics.")
+@url{https://docs.docker.com/engine/reference/run/#user,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#user-u-user-group,Podman}
+upstream documentation for semantics.")
   (workdir
    (maybe-string)
-   "Set the current working for the spawned Shepherd service.
+   "Set the current working directory for the spawned Shepherd service.
 You can refer to the
-@url{https://docs.docker.com/engine/reference/run/#workdir,upstream}
-documentation for semantics.")
+@url{https://docs.docker.com/engine/reference/run/#workdir,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#workdir-w-dir,Podman}
+upstream documentation for semantics.")
   (extra-arguments
-   (list '())
+   (oci-object-extra-arguments '())
    "A list of strings, gexps or file-like objects that will be directly passed
-to the @command{docker run} invokation."
+to the @command{docker run} or @command{podman 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 (list-of-oci-containers? value)
+  (list-of-oci-records? "containers" oci-container-configuration? value))
+
+(define-configuration/no-serialization oci-volume-configuration
+  (name
+   (string)
+   "The name of the OCI volume to provision.")
+  (labels
+   (oci-object-labels '())
+   "The list of labels that will be used to tag the current volume."
+   (sanitizer oci-sanitize-labels))
+  (extra-arguments
+   (oci-object-extra-arguments '())
+   "A list of strings, gexps or file-like objects that will be directly passed
+to the @command{docker volume create} or @command{podman volume create}
+invocation."
+   (sanitizer oci-sanitize-extra-arguments)))
+
+(define (list-of-oci-volumes? value)
+  (list-of-oci-records? "volumes" oci-volume-configuration? value))
+
+(define-configuration/no-serialization oci-network-configuration
+  (name
+   (string)
+   "The name of the OCI network to provision.")
+  (driver
+   (maybe-string)
+   "The driver to manage the network.")
+  (gateway
+   (maybe-string)
+   "IPv4 or IPv6 gateway for the subnet.")
+  (internal?
+   (boolean #f)
+   "Restrict external access to the network")
+  (ip-range
+   (maybe-string)
+   "Allocate container ip from a sub-range in CIDR format.")
+  (ipam-driver
+   (maybe-string)
+   "IP Address Management Driver.")
+  (ipv6?
+   (boolean #f)
+   "Enable IPv6 networking.")
+  (subnet
+   (maybe-string)
+   "Subnet in CIDR format that represents a network segment.")
+  (labels
+   (oci-object-labels '())
+   "The list of labels that will be used to tag the current volume."
+   (sanitizer oci-sanitize-labels))
+  (extra-arguments
+   (oci-object-extra-arguments '())
+   "A list of strings, gexps or file-like objects that will be directly passed
+to the @command{docker network create} or @command{podman network create}
+invocation."
+   (sanitizer oci-sanitize-extra-arguments)))
+
+(define (list-of-oci-networks? value)
+  (list-of-oci-records? "networks" oci-network-configuration? value))
+
+(define (package-or-string? value)
+  (or (package? value) (string? value)))
+
+(define-maybe/no-serialization package-or-string)
+
+(define-configuration/no-serialization oci-configuration
+  (runtime
+   (oci-runtime 'docker)
+   "The OCI runtime to use to run commands.  It can be either @code{'docker} or
+@code{'podman}.")
+  (runtime-cli
+   (maybe-package-or-string)
+   "The OCI runtime command line to be installed in the system profile and used
+to provision OCI resources, it can be either a package or a string representing
+an absolute file name to the runtime binary entrypoint.  When unset it will default
+to @code{docker-cli} package for the @code{'docker} runtime or to @code{podman}
+package for the @code{'podman} runtime.")
+  (runtime-extra-arguments
+   (list '())
+   "A list of strings, gexps or file-like objects that will be placed
+after each @command{docker} or @command{podman} invokation.")
+  (user
+   (string "oci-container")
+   "The user name under whose authority OCI runtime commands will be run.")
+  (group
+   (maybe-string)
+   "The group name under whose authority OCI commands will be run.  When
+using the @code{'podman} OCI runtime, this field will be ignored and the
+default group of the user configured in the @code{user} field will be used.")
+  (subuids-range
+   (maybe-subid-range)
+   "An optional @code{subid-range} record allocating subuids for the user from
+the @code{user} field.  When unset, with the rootless Podman OCI runtime, it
+defaults to @code{(subid-range (name \"oci-container\"))}.")
+  (subgids-range
+   (maybe-subid-range)
+   "An optional @code{subid-range} record allocating subgids for the user from
+the @code{user} field.  When unset, with the rootless Podman OCI runtime, it
+defaults to @code{(subid-range (name \"oci-container\"))}.")
+  (containers
+   (list-of-oci-containers '())
+   "The list of @code{oci-container-configuration} records representing the
+containers to provision.  The use of the @code{oci-extension} record should
+be preferred for most cases.")
+  (networks
+   (list-of-oci-networks '())
+   "The list of @code{oci-network-configuration} records representing the
+networks to provision.  The use of the @code{oci-extension} record should
+be preferred for most cases.")
+  (volumes
+   (list-of-oci-volumes '())
+   "The list of @code{oci-volume-configuration} records representing the
+volumes to provision.  The use of the @code{oci-extension} record should
+be preferred for most cases.")
+  (verbose?
+   (boolean #f)
+   "When true, additional output will be printed, allowing to better follow the
+flow of execution.")
+  (home-service?
+   (boolean for-home?)
+   "This is an internal field denoting whether this configuration is used in a
+Guix Home context, as opposed to the default Guix System context."))
+
+(define (oci-runtime-system-environment runtime user)
+  (if (eq? runtime 'podman)
+      (list
+       #~(string-append
+          "HOME=" (passwd:dir (getpwnam #$user))))
+      #~()))
+
+(define (oci-runtime-cli runtime runtime-cli profile-directory)
+  "Return a gexp that, when lowered, evaluates to the  of the OCI
+runtime command requested by the user."
+  (if (string? runtime-cli)
+      ;; It is a user defined absolute file name.
+      runtime-cli
+      #~(string-append
+         #$(if (maybe-value-set? runtime-cli)
+               runtime-cli
+               profile-directory)
+         #$(if (eq? 'podman runtime)
+               "/bin/podman"
+               "/bin/docker"))))
+
+(define* (oci-runtime-system-cli config #:key (profile-directory "/run/current-system/profile"))
+  (let ((runtime-cli
+         (oci-configuration-runtime-cli config))
+        (runtime
+         (oci-configuration-runtime config)))
+    (oci-runtime-cli runtime runtime-cli profile-directory)))
+
+(define (oci-runtime-home-cli config)
+  (let ((runtime-cli
+         (oci-configuration-runtime-cli config))
+        (runtime
+         (oci-configuration-runtime config)))
+    (oci-runtime-cli runtime runtime-cli
+                     (string-append (getenv "HOME")
+                                    "/.guix-home/profile"))))
+
+(define-configuration/no-serialization oci-extension
+  (containers
+   (list-of-oci-containers '())
+   "The list of @code{oci-container-configuration} records representing the
+containers to add.")
+  (networks
+   (list-of-oci-networks '())
+   "The list of @code{oci-network-configuration} records representing the
+networks to add.")
+  (volumes
+   (list-of-oci-volumes '())
+   "The list of @code{oci-volume-configuration} records representing the
+volumes to add."))
+
+(define (oci-image->container-name image)
+  "Infer the name of an OCI backed Shepherd service from its OCI image."
+  (basename
+   (if (string? image)
+       (first (string-split image #\:))
+       (oci-image-repository image))))
+
+(define (oci-command-line-shepherd-action object-name invocation entrypoint)
+  "Return a Shepherd action printing a given INVOCATION of an OCI command for the
+given OBJECT-NAME."
+  (shepherd-action
+   (name 'command-line)
+   (documentation
+    (format #f "Prints ~a's OCI runtime command line invocation."
+            object-name))
+   (procedure
+    #~(lambda _
+        (format #t "Entrypoint:~%~a~%" #$entrypoint)
+        (format #t "Invocation:~%~a~%" #$invocation)))))
+
+(define (oci-container-shepherd-name runtime config)
+  "Return the name of an OCI backed Shepherd service based on CONFIG.
+The name configured in the configuration record is returned when
+CONFIG's name field has a value, otherwise a name is inferred from CONFIG's
+image field."
+  (define name (oci-container-configuration-provision config))
+  (define image (oci-container-configuration-image config))
+
+  (if (maybe-value-set? name)
+      name
+      (string-append (symbol->string runtime) "-"
+                     (oci-image->container-name image))))
+
+(define (oci-networks-shepherd-name runtime)
+  "Return the name of the OCI networks provisioning Shepherd service based on
+RUNTIME."
+  (string-append (symbol->string runtime) "-networks"))
+
+(define (oci-volumes-shepherd-name runtime)
+  "Return the name of the OCI volumes provisioning Shepherd service based on
+RUNTIME."
+  (string-append (symbol->string runtime) "-volumes"))
+
+(define (oci-networks-home-shepherd-name runtime)
+  "Return the name of the OCI volumes provisioning Home Shepherd service based on
+RUNTIME."
+  (string-append "home-" (oci-networks-shepherd-name runtime)))
+
+(define (oci-volumes-home-shepherd-name runtime)
+  "Return the name of the OCI volumes provisioning Home Shepherd service based on
+RUNTIME."
+  (string-append "home-" (oci-volumes-shepherd-name runtime)))
+
+(define (oci-container-configuration->options config)
+  "Map CONFIG, an oci-container-configuration record, to a gexp that, upon
+lowering, will be evaluated to a list of strings containing command line options
+for the OCI runtime run command."
+  (let ((entrypoint
+         (oci-container-configuration-entrypoint config))
+        (network
+         (oci-container-configuration-network config))
+        (user
+         (oci-container-configuration-container-user config))
+        (workdir
+         (oci-container-configuration-workdir config)))
+    (apply append
+           (filter (compose not unspecified?)
+                   `(,(if (maybe-value-set? entrypoint)
+                          `("--entrypoint" ,entrypoint)
+                          '())
+                     ,(append-map
+                       (lambda (spec)
+                         (list "--env" spec))
+                       (oci-container-configuration-environment config))
+                     ,(if (maybe-value-set? network)
+                          `("--network" ,network)
+                          '())
+                     ,(if (maybe-value-set? user)
+                          `("--user" ,user)
+                          '())
+                     ,(if (maybe-value-set? workdir)
+                          `("--workdir" ,workdir)
+                          '())
+                     ,(append-map
+                       (lambda (spec)
+                         (list "-p" spec))
+                       (oci-container-configuration-ports config))
+                     ,(append-map
+                       (lambda (spec)
+                         (list "-v" spec))
+                       (oci-container-configuration-volumes config)))))))
+
+(define (oci-network-configuration->options config)
+  "Map CONFIG, an oci-network-configuration record, to a gexp that, upon
+lowering, will be evaluated to a list of strings containing command line options
+for the OCI runtime network create command."
+  (let ((driver (oci-network-configuration-driver config))
+        (gateway
+         (oci-network-configuration-gateway config))
+        (internal?
+         (oci-network-configuration-internal? config))
+        (ip-range
+         (oci-network-configuration-ip-range config))
+        (ipam-driver
+         (oci-network-configuration-ipam-driver config))
+        (ipv6?
+         (oci-network-configuration-ipv6? config))
+        (subnet
+         (oci-network-configuration-subnet config)))
+    (apply append
+           (filter (compose not unspecified?)
+                   `(,(if (maybe-value-set? driver)
+                          `("--driver" ,driver)
+                          '())
+                     ,(if (maybe-value-set? gateway)
+                          `("--gateway" ,gateway)
+                          '())
+                     ,(if internal?
+                          `("--internal")
+                          '())
+                     ,(if (maybe-value-set? ip-range)
+                          `("--ip-range" ,ip-range)
+                          '())
+                     ,(if (maybe-value-set? ipam-driver)
+                          `("--ipam-driver" ,ipam-driver)
+                          '())
+                     ,(if ipv6?
+                          `("--ipv6")
+                          '())
+                     ,(if (maybe-value-set? subnet)
+                          `("--subnet" ,subnet)
+                          '())
+                     ,(append-map
+                       (lambda (spec)
+                         (list "--label" spec))
+                       (oci-network-configuration-labels config)))))))
+
+(define (oci-volume-configuration->options config)
+  "Map CONFIG, an oci-volume-configuration record, to a gexp that, upon
+lowering, will be evaluated to a list of strings containing command line options
+for the OCI runtime volume create command."
+  (append-map
+   (lambda (spec)
+     (list "--label" spec))
+   (oci-volume-configuration-labels config)))
 
 (define (lower-operating-system os target system)
+  "Lower OS, an operating-system record, into a tarball containing an OCI image."
   (mlet* %store-monad
       ((tarball
         (lower-object
@@ -614,24 +1054,11 @@ (define (lower-operating-system os target 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)))))
-
+(define (lower-manifest name value options image-reference
+                        target system grafts?)
+  "Lower VALUE, a manifest record, into a tarball containing an OCI image."
   (mlet* %store-monad
-      ((_ (set-grafting
-           (oci-image-grafts? image)))
+      ((_ (set-grafting grafts?))
        (guile (set-guile-for-build (default-guile)))
        (profile
         (profile-derivation value
@@ -642,14 +1069,11 @@ (define (lower-manifest name image target system)
        (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 (lower-oci-image-state name value options reference
+                               image-target image-system grafts?)
   (define target
     (if (maybe-value-set? image-target)
         image-target
@@ -662,7 +1086,8 @@ (define (lower-oci-image name image)
    (run-with-store store
      (match value
        ((? manifest? value)
-        (lower-manifest name image target system))
+        (lower-manifest name value options reference
+                        target system grafts?))
        ((? operating-system? value)
         (lower-operating-system value target system))
        ((or (? gexp? value)
@@ -677,113 +1102,663 @@ (define (lower-oci-image name image)
      #: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)
+(define (lower-oci-image name image)
+  "Lower IMAGE, a oci-image record, into a tarball containing an OCI image."
+  (lower-oci-image-state
+   name
+   (oci-image-value image)
+   (oci-image-pack-options image)
+   (oci-image-reference image)
+   (oci-image-target image)
+   (oci-image-system image)
+   (oci-image-grafts? image)))
+
+(define-record-type* 
+  oci-runtime-state
+  make-oci-runtime-state
+  oci-runtime-state?
+  this-oci-runtime-state
+
+  (runtime                  oci-runtime-state-runtime
+                            (default 'docker))
+  (runtime-cli              oci-runtime-state-runtime-cli)
+  (user                     oci-runtime-state-user)
+  (group                    oci-runtime-state-group)
+  (runtime-environment      oci-runtime-state-runtime-environment
+                            (default #~()))
+  (runtime-requirement      oci-runtime-state-runtime-requirement
+                            (default '()))
+  (runtime-extra-arguments  oci-runtime-state-runtime-extra-arguments
+                            (default '())))
+
+(define-record-type* 
+  oci-state
+  make-oci-state
+  oci-state?
+  this-oci-state
+
+  (networks                 oci-state-networks)
+  (volumes                  oci-state-volumes)
+  (containers               oci-state-containers)
+  (networks-name            oci-state-networks-name
+                            (default #f))
+  (volumes-name             oci-state-volumes-name
+                            (default #f))
+  (networks-requirement     oci-state-networks-requirement
+                            (default '()))
+  (volumes-requirement      oci-state-volumes-requirement
+                            (default '()))
+  (containers-requirement   oci-state-containers-requirement
+                            (default '())))
+
+(define-record-type* 
+  oci-container-invocation
+  make-oci-container-invocation
+  oci-container-invocation?
+  this-oci-container-invocation
+
+  (runtime                  oci-container-invocation-runtime
+                            (default 'docker))
+  (runtime-cli              oci-container-invocation-runtime-cli)
+  (name                     oci-container-invocation-name)
+  (command                  oci-container-invocation-command
+                            (default '()))
+  (image-reference          oci-container-invocation-image-reference)
+  (options                  oci-container-invocation-options
+                            (default '()))
+  (run-extra-arguments      oci-container-invocation-run-extra-arguments
+                            (default '()))
+  (runtime-extra-arguments  oci-container-invocation-runtime-extra-arguments
+                            (default '())))
+
+(define (oci-container-configuration->oci-container-invocation runtime-state
+                                                               config)
+  (oci-container-invocation
+   (runtime (oci-runtime-state-runtime runtime-state))
+   (runtime-cli (oci-runtime-state-runtime-cli runtime-state))
+   (name
+    (oci-container-shepherd-name runtime config))
+   (command
+    (oci-container-configuration-command config))
+   (image-reference
+    (oci-image-reference (oci-container-configuration-image config)))
+   (options
+    (oci-container-configuration->options config))
+   (run-extra-arguments
+    (oci-container-configuration-extra-arguments config))
+   (runtime-extra-arguments
+    (oci-runtime-state-runtime-extra-arguments runtime-state))))
+
+(define* (oci-image-loader runtime-state name image tag #:key verbose?)
+  "Return a file-like object that, once lowered, will evaluate to a program able
+to load IMAGE through RUNTIME-CLI and to tag it with TAG afterwards."
+  (let ((tarball (lower-oci-image name image)))
+    (with-imported-modules (source-module-closure '((gnu build oci-containers)))
+      (program-file
+       (format #f "~a-image-loader" name)
        #~(begin
-           (use-modules (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))
+           (use-modules (gnu build oci-containers))
+           (oci-image-load '#$(oci-runtime-state-runtime runtime-state)
+                           #$(oci-runtime-state-runtime-cli runtime-state)
+                           #$tarball #$name #$tag
+                           #:verbose? #$verbose?))))))
+
+(define (oci-container-run-invocation container-invocation)
+  "Return a list representing the OCI runtime
+invocation for running containers."
+  ;; run [OPTIONS] IMAGE [COMMAND] [ARG...]
+  `(,(oci-container-invocation-runtime-cli container-invocation)
+    ,@(oci-container-invocation-runtime-extra-arguments container-invocation)
+    "run" "--rm"
+    ,@(if (eq? (oci-container-invocation-runtime container-invocation)
+               'podman)
+          ;; This is because podman takes some time to
+          ;; release container names.  --replace seems
+          ;; to be required to be able to restart services.
+          '("--replace")
+          '())
+    "--name" ,(oci-container-invocation-name container-invocation)
+    ,@(oci-container-invocation-options container-invocation)
+    ,@(oci-container-invocation-run-extra-arguments container-invocation)
+    ,(oci-container-invocation-image-reference container-invocation)
+    ,@(oci-container-invocation-command container-invocation)))
+
+(define* (oci-container-entrypoint name invocation
+                                   #:key verbose?
+                                   (pre-script #~()))
+  "Return a file-like object that, once lowered, will evaluate to the entrypoint
+for the Shepherd service that will run INVOCATION."
+  (program-file
+   (string-append "oci-entrypoint-" name)
+   (with-imported-modules (source-module-closure
+                           '((gnu build oci-containers)))
+     #~(begin
+         (use-modules (gnu build oci-containers)
+                      (srfi srfi-1))
+         (oci-container-execlp
+          (list #$@invocation)
+          #:verbose? #$verbose?
+          #:pre-script
+          (lambda _
+            (when (and #$verbose?
+                       (zero? (length '(#$@pre-script))))
+              (format #t "No pre script to run..."))
+            #$@pre-script))))))
+
+(define* (oci-container-shepherd-service state runtime-state config
+                                         #:key verbose?
+                                         networks?
+                                         volumes?)
+  "Return a Shepherd service object that will run the OCI container represented
+by CONFIG through RUNTIME-CLI."
+  (match-record config 
+                (shepherd-actions auto-start? user group host-environment
+                 log-file requirement respawn? image)
+    (define runtime (oci-runtime-state-runtime runtime-state))
+    (define runtime-cli (oci-runtime-state-runtime-cli runtime-state))
+    (define image-reference (oci-image-reference image))
+    (define shepherd-name (oci-container-shepherd-name runtime config))
+    (define oci-container-user
+      (if (maybe-value-set? user)
+          user
+          (oci-runtime-state-user runtime-state)))
+    (define oci-container-group
+      (if (maybe-value-set? group)
+          group
+          (oci-runtime-state-group runtime-state)))
+    (define networks-service
+      (if networks?
+          (list
+           (string->symbol
+            (oci-state-networks-name state)))
+          '()))
+    (define volumes-service
+     (if volumes?
+         (list
+          (string->symbol
+           (oci-state-volumes-name state)))
+         '()))
+    (define oci-container-requirement
+      (append requirement
+              (oci-state-containers-requirement state)
+              (oci-runtime-state-runtime-requirement runtime-state)
+              networks-service
+              volumes-service))
+    (define environment-variables
+      #~(append
+         (list #$@host-environment)
+         (list #$@(oci-runtime-state-runtime-environment runtime-state))))
+    (define invocation
+      (oci-container-run-invocation
+       (oci-container-configuration->oci-container-invocation
+        runtime-state config)))
+    (define* (container-action command)
+      #~(lambda _
+          (fork+exec-command
+           (list #$@command)
+           #$@(if oci-container-user
+                  (list #:user oci-container-user)
+                  '())
+           #$@(if oci-container-group
+                  (list #:group oci-container-group)
+                  '())
+           #$@(if (maybe-value-set? log-file)
+                  (list #:log-file log-file)
+                  '())
+           #$@(if (and oci-container-user (eq? runtime 'podman))
+                  (list #:directory
+                        #~(passwd:dir
+                           (getpwnam #$oci-container-user)))
+                  '())
+           #:environment-variables
+           #$environment-variables)))
+    (define start-entrypoint
+      (oci-container-entrypoint
+       shepherd-name invocation
+       #:verbose? verbose?
+       #:pre-script
+       (if (oci-image? image)
+           #~((system*
+               #$(oci-image-loader
+                  runtime-state shepherd-name image
+                  image-reference
+                  #:verbose? verbose?)))
+           #~())))
+
+    (shepherd-service (provision `(,(string->symbol shepherd-name)))
+                      (requirement oci-container-requirement)
                       (respawn? respawn?)
                       (auto-start? auto-start?)
                       (documentation
                        (string-append
-                        "Docker backed Shepherd service for "
-                        (if (oci-image? image) name image) "."))
+                        (oci-runtime-name runtime)
+                        " backed Shepherd service for "
+                        (if (oci-image? image) shepherd-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))))
+                       (container-action
+                        (list start-entrypoint)))
                       (stop
-                       #~(lambda _
-                           (invoke #$docker "rm" "-f" #$name)))
+                       (container-action
+                        (list
+                         (oci-container-entrypoint
+                          shepherd-name (list runtime-cli "rm" "-f" shepherd-name)
+                          #:verbose? verbose?))))
                       (actions
-                       (if (oci-image? image)
-                           '()
-                           (append
+                       (append
+                        (list
+                         (oci-command-line-shepherd-action
+                          shepherd-name #~(string-join (list #$@invocation) " ")
+                          start-entrypoint))
+                        (if (oci-image? image)
+                            '()
                             (list
                              (shepherd-action
                               (name 'pull)
                               (documentation
                                (format #f "Pull ~a's image (~a)."
-                                       name image))
+                                       shepherd-name image))
                               (procedure
-                               #~(lambda _
-                                   (invoke #$docker "pull" #$image)))))
-                            actions))))))
-
-(define %oci-container-accounts
+                               (container-action
+                                (list
+                                 (oci-container-entrypoint
+                                  shepherd-name (list runtime-cli "pull" image)
+                                  #:verbose? verbose?)))))))
+                        shepherd-actions)))))
+
+(define (oci-object-create-invocation object runtime-cli name options
+                                      runtime-extra-arguments
+                                      create-extra-arguments)
+  "Return a gexp that, upon lowering, will evaluate to the OCI runtime
+invocation for creating networks and volumes."
+  ;; network|volume create [options] [NAME]
+  #~(list #$runtime-cli #$@runtime-extra-arguments #$object "create"
+          #$@options #$@create-extra-arguments #$name))
+
+(define (format-oci-invocations invocations)
+  "Return a gexp that, upon lowering, will evaluate to a formatted message
+containing the INVOCATIONS that the OCI runtime will execute to provision
+networks or volumes."
+  #~(string-join (map (lambda (i) (string-join i " "))
+                      (list #$@invocations))
+                 "\n"))
+
+(define* (oci-object-create-script object runtime runtime-cli invocations
+                                   #:key verbose?)
+  "Return a file-like object that, once lowered, will evaluate to a program able
+to create OCI networks and volumes through RUNTIME-CLI."
+  (define runtime-string (symbol->string runtime))
+  (define runtime-name (oci-runtime-name runtime))
+  (with-imported-modules (source-module-closure
+                          '((gnu build oci-containers)))
+
+    (program-file
+     (string-append runtime-string "-" object "s-create.scm")
+     #~(begin
+         (use-modules (gnu build oci-containers))
+         (oci-object-create '#$runtime #$runtime-cli #$runtime-name
+                            #$object (list #$@invocations)
+                            #:verbose? #$verbose?)))))
+
+(define* (oci-object-shepherd-service object runtime-state name
+                                      oci-state-requirement invocations
+                                      #:key verbose?)
+  "Return a Shepherd service object that will provision the OBJECTs represented
+by INVOCATIONS through RUNTIME-STATE."
+  (match-record runtime-state 
+                (runtime runtime-cli runtime-requirement user group
+                 runtime-environment)
+    (define entrypoint
+      (oci-object-create-script
+       object runtime runtime-cli invocations #:verbose? verbose?))
+    (define requirement
+      (append runtime-requirement oci-state-requirement))
+
+    (shepherd-service (provision (list (string->symbol name)))
+                      (requirement requirement)
+                      (one-shot? #t)
+                      (documentation
+                       (string-append
+                        (oci-runtime-name runtime) " " object
+                        " provisioning service"))
+                      (start
+                       #~(lambda _
+                           (fork+exec-command
+                            (list #$entrypoint)
+                            #$@(if user (list #:user user) '())
+                            #$@(if group (list #:group group) '())
+                            #:environment-variables
+                            (list #$@runtime-environment))))
+                      (actions
+                       (list
+                        (oci-command-line-shepherd-action
+                         name (format-oci-invocations invocations)
+                         entrypoint))))))
+
+(define* (oci-networks-shepherd-service state runtime-state
+                                        #:key verbose?)
+  "Return a Shepherd service object that will create the networks represented
+in STATE."
+  (define runtime-cli
+    (oci-runtime-state-runtime-cli runtime-state))
+  (define invocations
+    (map
+     (lambda (network)
+       (oci-object-create-invocation
+        "network" runtime-cli
+        (oci-network-configuration-name network)
+        (oci-network-configuration->options network)
+        (oci-runtime-state-runtime-extra-arguments runtime-state)
+        (oci-network-configuration-extra-arguments network)))
+     (oci-state-networks state)))
+
+  (oci-object-shepherd-service
+   "network" runtime-state (oci-state-networks-name state)
+   (oci-state-networks-requirement state)
+   invocations #:verbose? verbose?))
+
+(define* (oci-volumes-shepherd-service state runtime-state
+                                       #:key verbose?)
+  "Return a Shepherd service object that will create the volumes represented
+in STATE."
+  (define runtime-cli
+    (oci-runtime-state-runtime-cli runtime-state))
+  (define invocations
+    (map
+     (lambda (volume)
+       (oci-object-create-invocation
+        "volume" runtime-cli
+        (oci-volume-configuration-name volume)
+        (oci-volume-configuration->options volume)
+        (oci-runtime-state-runtime-extra-arguments runtime-state)
+        (oci-volume-configuration-extra-arguments volume)))
+     (oci-state-volumes state)))
+
+  (oci-object-shepherd-service
+   "volume" runtime-state (oci-state-volumes-name state)
+   (oci-state-volumes-requirement state)
+   invocations #:verbose? verbose?))
+
+(define (oci-service-accounts config)
+  (define user (oci-configuration-user config))
+  (define maybe-group (oci-configuration-group config))
+  (define runtime (oci-configuration-runtime config))
   (list (user-account
-         (name "oci-container")
+         (name user)
          (comment "OCI services account")
-         (group "docker")
-         (system? #t)
-         (home-directory "/var/empty")
+         (group "users")
+         (supplementary-groups
+          (list (oci-runtime-group runtime maybe-group)))
+         (system? (eq? 'docker runtime))
+         (home-directory (if (eq? 'podman runtime)
+                             (string-append "/home/" user)
+                             "/var/empty"))
+         (create-home-directory? (eq? 'podman runtime))
          (shell (file-append shadow "/sbin/nologin")))))
+
+(define* (oci-state->shepherd-services state runtime-state #:key verbose?)
+  "Returns a list of Shepherd services based on the input OCI state."
+  (define networks?
+    (> (length (oci-state-networks state)) 0))
+  (define volumes?
+    (> (length (oci-state-volumes state)) 0))
+  (append
+   (map
+    (lambda (c)
+      (oci-container-shepherd-service
+       state runtime-state c
+       #:verbose? verbose?
+       #:volumes? volumes?
+       #:networks? networks?))
+    (oci-state-containers state))
+   (if networks?
+       (list
+        (oci-networks-shepherd-service
+         state runtime-state
+         #:verbose? verbose?))
+       '())
+   (if volumes?
+       (list
+        (oci-volumes-shepherd-service
+         state runtime-state
+         #:verbose? verbose?))
+       '())))
+
+(define* (oci-configuration->oci-runtime-state config #:key verbose?)
+  (define runtime
+    (oci-configuration-runtime config))
+  (define home-service?
+    (oci-configuration-home-service? config))
+  (when verbose?
+    (format #t "Home service: ~a~%" home-service?))
+  (define runtime-cli
+    (if home-service?
+        (oci-runtime-home-cli config)
+        (oci-runtime-system-cli config)))
+  (define user
+    (if home-service?
+        #f
+        (oci-configuration-user config)))
+  (define group
+    (if home-service?
+        #f
+        (if (eq? runtime 'podman)
+            #~(group:name
+               (getgrgid
+                (passwd:gid
+                 (getpwnam #$user))))
+            (oci-runtime-group config (oci-configuration-group config)))))
+  (define runtime-requirement
+    (if home-service?
+        '()
+        (oci-runtime-system-requirement runtime)))
+  (define runtime-environment
+    (if home-service?
+        #~()
+        (oci-runtime-system-environment runtime user)))
+  (oci-runtime-state
+   (runtime runtime)
+   (runtime-cli runtime-cli)
+   (user user)
+   (group group)
+   (runtime-extra-arguments
+    (oci-configuration-runtime-extra-arguments config))
+   (runtime-environment runtime-environment)
+   (runtime-requirement runtime-requirement)))
+
+(define (oci-configuration->oci-state config)
+  (define runtime
+    (oci-configuration-runtime config))
+  (define home-service?
+    (oci-configuration-home-service? config))
+  (define networks-name
+    (if home-service?
+        (oci-networks-home-shepherd-name runtime)
+        (oci-networks-shepherd-name runtime)))
+  (define volumes-name
+    (if home-service?
+        (oci-volumes-home-shepherd-name runtime)
+        (oci-volumes-shepherd-name runtime)))
+  (define networks-requirement
+    (if home-service?
+        '()
+        '(networking)))
+  (oci-state
+   (containers (oci-configuration-containers config))
+   (networks (oci-configuration-networks config))
+   (volumes (oci-configuration-volumes config))
+   (networks-name networks-name)
+   (volumes-name volumes-name)
+   (networks-requirement networks-requirement)))
+
+(define (oci-configuration->shepherd-services config)
+  (let* ((verbose? (oci-configuration-verbose? config))
+         (state (oci-configuration->oci-state config))
+         (runtime-state
+          (oci-configuration->oci-runtime-state config #:verbose? verbose?)))
+    (oci-state->shepherd-services state runtime-state #:verbose? verbose?)))
+
+(define (oci-service-subids config)
+  "Return a subids-extension record representing subuids and subgids required by
+the rootless Podman backend."
+  (define (find-duplicates subids)
+    (let loop ((names '())
+               (subids subids))
+      (if (null? names)
+          names
+          (loop
+           (let ((name (subid-range-name (car subids))))
+             (if (member name names)
+                 (raise
+                  (formatted-message
+                   (G_ "Duplicated subid-range: ~a. subid-ranges names should be
+unique, please remove the duplicate.") name))
+                 (cons name names)))
+           (cdr subids)))))
+
+  (define runtime
+    (oci-configuration-runtime config))
+  (define user
+    (oci-configuration-user config))
+
+  (define subgids (oci-configuration-subgids-range config))
+  (find-duplicates subgids)
+
+  (define subuids (oci-configuration-subuids-range config))
+  (find-duplicates subgids)
+
+  (define container-users
+    (filter (lambda (range)
+              (and (maybe-value-set?
+                    (subid-range-name range))
+                   (not (string=? (subid-range-name range) user))))
+            (map (lambda (container)
+                   (subid-range
+                    (name
+                     (oci-container-configuration-user container))))
+                 (oci-configuration-containers config))))
+  (define subgid-ranges
+    (cons
+     (if (maybe-value-set? subgids)
+         subgids
+         (subid-range (name user)))
+     container-users))
+  (define subuid-ranges
+    (cons
+     (if (maybe-value-set? subuids)
+         subuids
+         (subid-range (name user)))
+     container-users))
+
+  (if (eq? 'podman runtime)
+      (subids-extension
+       (subgids
+        subgid-ranges)
+       (subuids
+        subuid-ranges))
+      (subids-extension)))
+
+(define (oci-objects-merge-lst a b object get-name)
+  (define (contains? value lst)
+    (member value (map get-name lst)))
+  (let loop ((merged '())
+             (lst (append a b)))
+    (if (null? lst)
+        merged
+        (loop
+         (let ((element (car lst)))
+           (when (contains? element merged)
+             (raise
+              (formatted-message
+               (G_ "Duplicated ~a: ~a. Names of ~a should be unique, please
+remove the duplicate.") object (get-name element) object)))
+           (cons element merged))
+         (cdr lst)))))
+
+(define (oci-extension-merge a b)
+  (oci-extension
+   (containers (oci-objects-merge-lst
+                (oci-extension-containers a)
+                (oci-extension-containers b)
+                "container"
+                (lambda (config)
+                  (define maybe-name
+                    (oci-container-configuration-provision config))
+                  (if (maybe-value-set? maybe-name)
+                      maybe-name
+                      (oci-image->container-name
+                       (oci-container-configuration-image config))))))
+   (networks (oci-objects-merge-lst
+              (oci-extension-networks a)
+              (oci-extension-networks b)
+              "network"
+              oci-network-configuration-name))
+   (volumes (oci-objects-merge-lst
+             (oci-extension-volumes a)
+             (oci-extension-volumes b)
+             "volume"
+             oci-volume-configuration-name))))
+
+(define (oci-service-profile runtime runtime-cli)
+  `(,bash-minimal
+    ,@(if (string? runtime-cli)
+          '()
+          (list
+           (cond
+            ((maybe-value-set? runtime-cli)
+             runtime-cli)
+            ((eq? 'podman runtime)
+             podman)
+            (else
+             docker-cli))))))
+
+(define (oci-configuration-extend config extension)
+  (oci-configuration
+   (inherit config)
+   (containers
+    (oci-objects-merge-lst
+     (oci-configuration-containers config)
+     (oci-extension-containers extension)
+     "container"
+     (lambda (oci-config)
+       (define runtime
+         (oci-configuration-runtime config))
+       (oci-container-shepherd-name runtime oci-config))))
+   (networks (oci-objects-merge-lst
+              (oci-configuration-networks config)
+              (oci-extension-networks extension)
+              "network"
+              oci-network-configuration-name))
+   (volumes (oci-objects-merge-lst
+             (oci-configuration-volumes config)
+             (oci-extension-volumes extension)
+             "volume"
+             oci-volume-configuration-name))))
+
+(define oci-service-type
+  (service-type
+   (name 'oci)
+   (extensions
+    (list
+     (service-extension profile-service-type
+                        (lambda (config)
+                          (let ((runtime-cli
+                                 (oci-configuration-runtime-cli config))
+                                (runtime
+                                 (oci-configuration-runtime config)))
+                            (oci-service-profile runtime runtime-cli))))
+     (service-extension subids-service-type
+                        oci-service-subids)
+     (service-extension account-service-type
+                        oci-service-accounts)
+     (service-extension shepherd-root-service-type
+                        oci-configuration->shepherd-services)))
+   ;; Concatenate OCI object lists.
+   (compose (lambda (args)
+              (fold oci-extension-merge
+                    (oci-extension)
+                    args)))
+   (extend oci-configuration-extend)
+   (default-value (oci-configuration))
+   (description
+    "This service implements the provisioning of OCI objects such
+as containers, networks and volumes.")))
diff --git a/gnu/services/docker.scm b/gnu/services/docker.scm
index 828ceea313a..6abfbc49a0b 100644
--- a/gnu/services/docker.scm
+++ b/gnu/services/docker.scm
@@ -31,7 +31,10 @@ (define-module (gnu services docker)
   #:use-module (gnu system shadow)
   #:use-module (gnu packages docker)
   #:use-module (gnu packages linux)               ;singularity
+  #:use-module (guix deprecation)
+  #:use-module (guix diagnostics)
   #:use-module (guix gexp)
+  #:use-module (guix i18n)
   #:use-module (guix records)
   #:use-module (srfi srfi-1)
   #:use-module (ice-9 format)
@@ -67,16 +70,18 @@ (define-module (gnu services docker)
                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)
+               oci-container-configuration-extra-arguments)
 
   #:export (containerd-configuration
             containerd-service-type
             docker-configuration
             docker-service-type
             singularity-service-type
-            oci-container-service-type))
+            ;; For backwards compatibility, until the
+            ;; oci-container-service-type is fully deprecated.
+            oci-container-shepherd-service
+            oci-container-service-type
+            %oci-container-accounts))
 
 (define-maybe file-like)
 
@@ -297,17 +302,26 @@ (define singularity-service-type
 ;;; OCI container.
 ;;;
 
-(define (configs->shepherd-services configs)
-  (map oci-container-shepherd-service configs))
+;; For backwards compatibility, until the
+;; oci-container-service-type is fully deprecated.
+(define-deprecated (oci-container-shepherd-service config)
+  oci-service-type
+  ((@ (gnu services containers) oci-container-shepherd-service)
+   'docker config))
+(define %oci-container-accounts
+  (filter user-account? (oci-service-accounts (oci-configuration))))
 
 (define oci-container-service-type
   (service-type (name 'oci-container)
-                (extensions (list (service-extension profile-service-type
-                                                     (lambda _ (list docker-cli)))
-                                  (service-extension account-service-type
-                                                     (const %oci-container-accounts))
-                                  (service-extension shepherd-root-service-type
-                                                     configs->shepherd-services)))
+                (extensions
+                 (list (service-extension oci-service-type
+                                          (lambda (containers)
+                                            (warning
+                                             (G_
+                                              "'oci-container-service-type' is\
+ deprecated, use 'oci-service-type' instead~%"))
+                                            (oci-extension
+                                             (containers containers))))))
                 (default-value '())
                 (extend append)
                 (compose concatenate)
diff --git a/gnu/tests/containers.scm b/gnu/tests/containers.scm
index 0ecc8ddb126..051a4c740bf 100644
--- a/gnu/tests/containers.scm
+++ b/gnu/tests/containers.scm
@@ -27,6 +27,9 @@ (define-module (gnu tests containers)
   #: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 @@ (define-module (gnu tests containers)
   #: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 @@ (define (run-rootless-podman-test oci-tarball)
                                (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 @@ (define %test-rootless-podman
    (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 dhcp-client-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 utils)
+                          (gnu services herd)
+                          (guix combinators))))
+
+  (define vm
+    (virtual-machine
+     (operating-system os)
+     (volatile? #f)
+     (memory-size 1024)
+     (disk-image-size (* 3000 (expt 2 20)))
+     (port-forwardings '())))
+
+  (define test
+    (with-imported-modules '((gnu build oci-containers)
+                             (gnu build utils)
+                             (gnu build marionette))
+      #~(begin
+          (use-modules (srfi srfi-1) (srfi srfi-11) (srfi srfi-64)
+                       (gnu build utils)
+                       (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 dhcp-client-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 utils)
+                          (gnu services herd)
+                          (guix combinators))))
+
+  (define vm
+    (virtual-machine
+     (operating-system os)
+     (volatile? #f)
+     (memory-size 1024)
+     (disk-image-size (* 3000 (expt 2 20)))
+     (port-forwardings '())))
+
+  (define test
+    (with-imported-modules '((gnu build oci-containers)
+                             (gnu build utils)
+                             (gnu build marionette))
+      #~(begin
+          (use-modules (srfi srfi-1) (srfi srfi-11) (srfi srfi-64)
+                       (gnu build utils)
+                       (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))))
-- 
2.49.0





From unknown Fri Jun 13 11:55:10 2025
X-Loop: help-debbugs@gnu.org
Subject: [bug#76081] [PATCH v11 4/5] tests: Use lower-oci-image-state in container tests.
Resent-From: Giacomo Leidi 
Original-Sender: "Debbugs-submit" 
Resent-CC: guix-patches@gnu.org
Resent-Date: Sun, 01 Jun 2025 02:53:06 +0000
Resent-Message-ID: 
Resent-Sender: help-debbugs@gnu.org
X-GNU-PR-Message: followup 76081
X-GNU-PR-Package: guix-patches
X-GNU-PR-Keywords: moreinfo
To: 76081@debbugs.gnu.org
Cc: Giacomo Leidi 
Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.174874634322312
          (code B ref 76081); Sun, 01 Jun 2025 02:53:06 +0000
Received: (at 76081) by debbugs.gnu.org; 1 Jun 2025 02:52:23 +0000
Received: from localhost ([127.0.0.1]:34557 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from )
	id 1uLYo3-0005nD-So
	for submit@debbugs.gnu.org; Sat, 31 May 2025 22:52:22 -0400
Received: from confino.investici.org ([93.190.126.19]:46501)
 by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
 (Exim 4.84_2) (envelope-from )
 id 1uLYnO-0005iB-Ig
 for 76081@debbugs.gnu.org; Sat, 31 May 2025 22:51:47 -0400
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org;
 s=stigmate; t=1748746293;
 bh=HxTYqulnshs6Kv1MTBcz9pDRspS9WxFXQx7igpkMtZY=;
 h=From:To:Cc:Subject:Date:In-Reply-To:References:From;
 b=YT5JtSL9hQNfHSKru5kHtOIq7eNI3Fz8qAVr6i4pVhlf9UYzxJa8mZegusu/NoHK3
 rGTGQlL6eGUPpbVtUKEXQ/u3EJczvBWvoSc68rXECbPcT/scKJoTU10Ec9alkGfsmD
 bzwMq6dD15JwZxAoGSiXHvK4p+kd+pZ3Vt0a253M=
Received: from mx1.investici.org (unknown [127.0.0.1])
 by confino.investici.org (Postfix) with ESMTP id 4b91hP3pDDz118l;
 Sun,  1 Jun 2025 02:51:33 +0000 (UTC)
Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19])
 (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with
 ESMTPSA id 4b91hP2n7lz1181; Sun,  1 Jun 2025 02:51:33 +0000 (UTC)
From: Giacomo Leidi 
Date: Sun,  1 Jun 2025 04:51:17 +0200
Message-ID: <32e4957092890faccffd06b9161c50583179523d.1748746278.git.goodoldpaul@autistici.org>
X-Mailer: git-send-email 2.49.0
In-Reply-To: <8ac2edf51988af974ed0b4cd4ac63da23ce17118.1748746278.git.goodoldpaul@autistici.org>
References: <8ac2edf51988af974ed0b4cd4ac63da23ce17118.1748746278.git.goodoldpaul@autistici.org>
MIME-Version: 1.0
Content-Transfer-Encoding: 8bit
X-Spam-Score: -0.7 (/)
X-BeenThere: debbugs-submit@debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: 
List-Unsubscribe: , 
 
List-Archive: 
List-Post: 
List-Help: 
List-Subscribe: , 
 
Errors-To: debbugs-submit-bounces@debbugs.gnu.org
Sender: "Debbugs-submit" 
X-Spam-Score: -1.7 (-)

This patch replaces boilerplate in container related tests with
oci-image plumbing from (gnu services containers).

* gnu/tests/containers.scm (%oci-tarball): New variable;
(run-rootless-podman-test): use %oci-tarball;
(build-tarball&run-rootless-podman-test): drop procedure.
* gnu/tests/docker.scm (%docker-tarball): New variable;
(build-tarball&run-docker-test): use %docker-tarball;
(%docker-system-tarball): New variable;
(build-tarball&run-docker-system-test): new procedure.

Change-Id: Iad6f0704aee188d89464c83722dea0bb7adb084a
Signed-off-by: Giacomo Leidi 
---
 gnu/tests/containers.scm |  84 +++++++++++++++----------------
 gnu/tests/docker.scm     | 104 ++++++++++++++++++++++-----------------
 2 files changed, 101 insertions(+), 87 deletions(-)

diff --git a/gnu/tests/containers.scm b/gnu/tests/containers.scm
index 051a4c740bf..0db22e3a07f 100644
--- a/gnu/tests/containers.scm
+++ b/gnu/tests/containers.scm
@@ -46,6 +46,9 @@ (define-module (gnu tests containers)
             %test-oci-service-rootless-podman
             %test-oci-service-docker))
 
+(define lower-oci-image-state
+  (@@ (gnu services containers) lower-oci-image-state))
+
 
 (define %rootless-podman-os
   (simple-operating-system
@@ -69,13 +72,48 @@ (define %rootless-podman-os
                           (supplementary-groups '("wheel" "netdev" "cgroup"
                                                   "audio" "video")))))))
 
-(define (run-rootless-podman-test oci-tarball)
+(define %oci-tarball
+  (lower-oci-image-state
+   "guile-guest"
+   (packages->manifest
+    (list
+     guile-3.0 guile-json-3
+     (package
+       (name "guest-script")
+       (version "0")
+       (source #f)
+       (build-system trivial-build-system)
+       (arguments
+        (list
+         #:guile guile-3.0
+         #:builder
+         #~(let ((out #$output))
+             (mkdir out)
+             (call-with-output-file (string-append out "/a.scm")
+               (lambda (port)
+                 (display "(display \"hello world\n\")" port))))))
+       (synopsis "Display hello world using Guile")
+       (description "This package displays the text \"hello world\" on the
+standard output device and then enters a new line.")
+       (home-page #f)
+       (license license:public-domain))))
+   '(#:entry-point "bin/guile"
+     #:localstatedir? #t
+     #:extra-options (#:image-tag "guile-guest")
+     #:symlinks (("/bin/Guile" -> "bin/guile")
+                 ("aa.scm" -> "a.scm")))
+   "guile-guest"
+   (%current-target-system)
+   (%current-system)
+   #f))
+
+(define (run-rootless-podman-test)
 
   (define os
     (marionette-operating-system
      (operating-system-with-gc-roots
       %rootless-podman-os
-      (list oci-tarball))
+      (list %oci-tarball))
      #:imported-modules '((gnu services herd)
                           (guix combinators))))
 
@@ -254,7 +292,7 @@ (define (run-rootless-podman-test oci-tarball)
                        (let* ((loaded (slurp ,(string-append #$podman
                                                              "/bin/podman")
                                              "load" "-i"
-                                             ,#$oci-tarball))
+                                             ,#$%oci-tarball))
                               (repository&tag "localhost/guile-guest:latest")
                               (response1 (slurp
                                           ,(string-append #$podman "/bin/podman")
@@ -307,49 +345,11 @@ (define (run-rootless-podman-test oci-tarball)
 
   (gexp->derivation "rootless-podman-test" test))
 
-(define (build-tarball&run-rootless-podman-test)
-  (mlet* %store-monad
-      ((_ (set-grafting #f))
-       (guile (set-guile-for-build (default-guile)))
-       (guest-script-package ->
-        (package
-          (name "guest-script")
-          (version "0")
-          (source #f)
-          (build-system trivial-build-system)
-          (arguments `(#:guile ,guile-3.0
-                       #:builder
-                       (let ((out (assoc-ref %outputs "out")))
-                         (mkdir out)
-                         (call-with-output-file (string-append out "/a.scm")
-                           (lambda (port)
-                             (display "(display \"hello world\n\")" port)))
-                         #t)))
-          (synopsis "Display hello world using Guile")
-          (description "This package displays the text \"hello world\" on the
-standard output device and then enters a new line.")
-          (home-page #f)
-          (license license:public-domain)))
-       (profile (profile-derivation (packages->manifest
-                                     (list guile-3.0 guile-json-3
-                                           guest-script-package))
-                                    #:hooks '()
-                                    #:locales? #f))
-       (tarball (pack:docker-image
-                 "docker-pack" profile
-                 #:symlinks '(("/bin/Guile" -> "bin/guile")
-                              ("aa.scm" -> "a.scm"))
-                 #:extra-options
-                 '(#:image-tag "guile-guest")
-                 #:entry-point "bin/guile"
-                 #:localstatedir? #t)))
-    (run-rootless-podman-test tarball)))
-
 (define %test-rootless-podman
   (system-test
    (name "rootless-podman")
    (description "Test rootless Podman service.")
-   (value (build-tarball&run-rootless-podman-test))))
+   (value (run-rootless-podman-test))))
 
 
 (define %oci-network
diff --git a/gnu/tests/docker.scm b/gnu/tests/docker.scm
index 5dcf05a17e3..1f264d52486 100644
--- a/gnu/tests/docker.scm
+++ b/gnu/tests/docker.scm
@@ -26,6 +26,7 @@ (define-module (gnu tests docker)
   #:use-module (gnu system image)
   #:use-module (gnu system vm)
   #:use-module (gnu services)
+  #:use-module (gnu services containers)
   #:use-module (gnu services dbus)
   #:use-module (gnu services networking)
   #:use-module (gnu services docker)
@@ -48,6 +49,9 @@ (define-module (gnu tests docker)
             %test-docker-system
             %test-oci-container))
 
+(define lower-oci-image-state
+  (@@ (gnu services containers) lower-oci-image-state))
+
 (define %docker-os
   (simple-operating-system
    (service dhcp-client-service-type)
@@ -57,6 +61,41 @@ (define %docker-os
    (service containerd-service-type)
    (service docker-service-type)))
 
+(define %docker-tarball
+  (lower-oci-image-state
+   "guile-guest"
+   (packages->manifest
+    (list
+     guile-3.0 guile-json-3
+     (package
+       (name "guest-script")
+       (version "0")
+       (source #f)
+       (build-system trivial-build-system)
+       (arguments
+        (list
+         #:guile guile-3.0
+         #:builder
+         #~(let ((out #$output))
+             (mkdir out)
+             (call-with-output-file (string-append out "/a.scm")
+               (lambda (port)
+                 (display "(display \"hello world\n\")" port))))))
+       (synopsis "Display hello world using Guile")
+       (description "This package displays the text \"hello world\" on the
+standard output device and then enters a new line.")
+       (home-page #f)
+       (license license:public-domain))))
+   '(#:entry-point "bin/guile"
+     #:localstatedir? #t
+     #:extra-options (#:image-tag "guile-guest")
+     #:symlinks (("/bin/Guile" -> "bin/guile")
+                 ("aa.scm" -> "a.scm")))
+   "guile-guest"
+   (%current-target-system)
+   (%current-system)
+   #f))
+
 (define (run-docker-test docker-tarball)
   "Load DOCKER-TARBALL as Docker image and run it in a Docker container,
 inside %DOCKER-OS."
@@ -173,40 +212,7 @@ (define (run-docker-test docker-tarball)
   (gexp->derivation "docker-test" test))
 
 (define (build-tarball&run-docker-test)
-  (mlet* %store-monad
-      ((_ (set-grafting #f))
-       (guile (set-guile-for-build (default-guile)))
-       (guest-script-package ->
-        (package
-          (name "guest-script")
-          (version "0")
-          (source #f)
-          (build-system trivial-build-system)
-          (arguments `(#:guile ,guile-3.0
-                       #:builder
-                       (let ((out (assoc-ref %outputs "out")))
-                         (mkdir out)
-                         (call-with-output-file (string-append out "/a.scm")
-                           (lambda (port)
-                             (display "(display \"hello world\n\")" port)))
-                         #t)))
-          (synopsis "Display hello world using Guile")
-          (description "This package displays the text \"hello world\" on the
-standard output device and then enters a new line.")
-          (home-page #f)
-          (license license:public-domain)))
-       (profile (profile-derivation (packages->manifest
-                                     (list guile-3.0 guile-json-3
-                                           guest-script-package))
-                                    #:hooks '()
-                                    #:locales? #f))
-       (tarball (pack:docker-image
-                 "docker-pack" profile
-                 #:symlinks '(("/bin/Guile" -> "bin/guile")
-                              ("aa.scm" -> "a.scm"))
-                 #:entry-point "bin/guile"
-                 #:localstatedir? #t)))
-    (run-docker-test tarball)))
+  (run-docker-test %docker-tarball))
 
 (define %test-docker
   (system-test
@@ -215,8 +221,22 @@ (define %test-docker
    (value (build-tarball&run-docker-test))))
 
 
+(define %docker-system-tarball
+  (lower-oci-image-state
+   "guix-system-guest"
+   (operating-system
+     (inherit (simple-operating-system))
+     ;; Use locales for a single libc to
+     ;; reduce space requirements.
+     (locale-libcs (list glibc)))
+   '()
+   "guix-system-guest"
+   (%current-target-system)
+   (%current-system)
+   #f))
+
 (define (run-docker-system-test tarball)
-  "Load DOCKER-TARBALL as Docker image and run it in a Docker container,
+  "Load TARBALL as Docker image and run it in a Docker container,
 inside %DOCKER-OS."
   (define os
     (marionette-operating-system
@@ -333,21 +353,15 @@ (define (run-docker-system-test tarball)
 
   (gexp->derivation "docker-system-test" test))
 
+(define (build-tarball&run-docker-system-test)
+  (run-docker-system-test %docker-system-tarball))
+
 (define %test-docker-system
   (system-test
    (name "docker-system")
    (description "Run a system image as produced by @command{guix system
 docker-image} inside Docker.")
-   (value (with-monad %store-monad
-            (>>= (lower-object
-                  (system-image (os->image
-                                 (operating-system
-                                   (inherit (simple-operating-system))
-                                   ;; Use locales for a single libc to
-                                   ;; reduce space requirements.
-                                   (locale-libcs (list glibc)))
-                                 #:type docker-image-type)))
-                 run-docker-system-test)))))
+   (value (build-tarball&run-docker-system-test))))
 
 
 (define %oci-os
-- 
2.49.0





From unknown Fri Jun 13 11:55:10 2025
X-Loop: help-debbugs@gnu.org
Subject: [bug#76081] [PATCH v11 1/5] tests: oci-container: Set explicit timeouts.
References: <2f43e635-508c-407a-8309-06e75d492d89@autistici.org>
In-Reply-To: <2f43e635-508c-407a-8309-06e75d492d89@autistici.org>
Resent-From: Giacomo Leidi 
Original-Sender: "Debbugs-submit" 
Resent-CC: guix-patches@gnu.org
Resent-Date: Sun, 01 Jun 2025 02:53:09 +0000
Resent-Message-ID: 
Resent-Sender: help-debbugs@gnu.org
X-GNU-PR-Message: followup 76081
X-GNU-PR-Package: guix-patches
X-GNU-PR-Keywords: moreinfo
To: 76081@debbugs.gnu.org
Cc: Giacomo Leidi 
Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.174874634922353
          (code B ref 76081); Sun, 01 Jun 2025 02:53:09 +0000
Received: (at 76081) by debbugs.gnu.org; 1 Jun 2025 02:52:29 +0000
Received: from localhost ([127.0.0.1]:34559 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from )
	id 1uLYoA-0005nn-9R
	for submit@debbugs.gnu.org; Sat, 31 May 2025 22:52:28 -0400
Received: from confino.investici.org ([93.190.126.19]:33221)
 by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
 (Exim 4.84_2) (envelope-from )
 id 1uLYnN-0005hw-HI
 for 76081@debbugs.gnu.org; Sat, 31 May 2025 22:51:38 -0400
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org;
 s=stigmate; t=1748746292;
 bh=ipBhomgLT0seJxYDQ3100CFNP2CVacjvVePtnZQnB4c=;
 h=From:To:Cc:Subject:Date:From;
 b=D0MszdBqGEF5iP2aM9Z9J+J4HJvHNF4498dRA1gZo1d5ChT80XNDFui/RtydMTitL
 +/Ud/u0utkqzcQTXCaMFs96oW/4mw0WWLlVneCXegaajxoXJ2i3M4z80VZPECIBBWX
 xEgq3Cd2ZJiYNSwnYGq+SOzvDt7m2cCWV9eIseG4=
Received: from mx1.investici.org (unknown [127.0.0.1])
 by confino.investici.org (Postfix) with ESMTP id 4b91hN1d8Rz118Z;
 Sun,  1 Jun 2025 02:51:32 +0000 (UTC)
Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19])
 (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with
 ESMTPSA id 4b91hN0X1dz1181; Sun,  1 Jun 2025 02:51:32 +0000 (UTC)
From: Giacomo Leidi 
Date: Sun,  1 Jun 2025 04:51:14 +0200
Message-ID: <8ac2edf51988af974ed0b4cd4ac63da23ce17118.1748746278.git.goodoldpaul@autistici.org>
X-Mailer: git-send-email 2.49.0
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
X-Spam-Score: -0.7 (/)
X-BeenThere: debbugs-submit@debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: 
List-Unsubscribe: , 
 
List-Archive: 
List-Post: 
List-Help: 
List-Subscribe: , 
 
Errors-To: debbugs-submit-bounces@debbugs.gnu.org
Sender: "Debbugs-submit" 
X-Spam-Score: -1.7 (-)

* gnu/tests/docker.scm: Simplify %test-oci-container test case and add
explicit timeouts to tests outcomes.

Signed-off-by: Giacomo Leidi 
---
 gnu/tests/docker.scm | 99 ++++++++++++++++++--------------------------
 1 file changed, 41 insertions(+), 58 deletions(-)

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 
 ;;; Copyright © 2019-2023 Ludovic Courtès 
-;;; Copyright © 2024 Giacomo Leidi 
+;;; Copyright © 2024, 2025 Giacomo Leidi 
 ;;;
 ;;; 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))))
 

base-commit: e29c57ab81517424b03579147910553d92246212
-- 
2.49.0





From unknown Fri Jun 13 11:55:10 2025
X-Loop: help-debbugs@gnu.org
Subject: [bug#76081] [PATCH v11 2/5] gnu: Move with-retries outside dbus-service.
Resent-From: Giacomo Leidi 
Original-Sender: "Debbugs-submit" 
Resent-CC: maxim.cournoyer@gmail.com, guix-patches@gnu.org
Resent-Date: Sun, 01 Jun 2025 02:53:12 +0000
Resent-Message-ID: 
Resent-Sender: help-debbugs@gnu.org
X-GNU-PR-Message: followup 76081
X-GNU-PR-Package: guix-patches
X-GNU-PR-Keywords: moreinfo
To: 76081@debbugs.gnu.org
Cc: Giacomo Leidi , Maxim Cournoyer 
X-Debbugs-Original-Xcc: Maxim Cournoyer 
Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.174874635422369
          (code B ref 76081); Sun, 01 Jun 2025 02:53:12 +0000
Received: (at 76081) by debbugs.gnu.org; 1 Jun 2025 02:52:34 +0000
Received: from localhost ([127.0.0.1]:34561 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from )
	id 1uLYoG-0005oU-Dp
	for submit@debbugs.gnu.org; Sat, 31 May 2025 22:52:33 -0400
Received: from confino.investici.org ([2a11:7980:1::2:0]:49859)
 by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
 (Exim 4.84_2) (envelope-from )
 id 1uLYnN-0005i2-IJ
 for 76081@debbugs.gnu.org; Sat, 31 May 2025 22:51:44 -0400
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org;
 s=stigmate; t=1748746292;
 bh=c0mrrjGimQg3m608YSHrWpX7CdedaBO05E2EM3xayG0=;
 h=From:To:Cc:Subject:Date:In-Reply-To:References:From;
 b=Y0TRl5mG9aX0EJ3Trtk+jqyIclfLDbfRZQIdMK+VrVu4YqFpowOeI/mgwYxPy+1jd
 +G1I5+mgN0Lo+pQO9YevESgh0gGMNrL5QzZjEEWnGm/XDLyLFHP3e9Nt88viKxmMt9
 +lpyVwujFPeZFu7p7bssc0AUVeAZjN8ESGWH2sG4=
Received: from mx1.investici.org (unknown [127.0.0.1])
 by confino.investici.org (Postfix) with ESMTP id 4b91hN4RVgz118h;
 Sun,  1 Jun 2025 02:51:32 +0000 (UTC)
Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19])
 (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with
 ESMTPSA id 4b91hN3PCNz1181; Sun,  1 Jun 2025 02:51:32 +0000 (UTC)
From: Giacomo Leidi 
Date: Sun,  1 Jun 2025 04:51:15 +0200
Message-ID: <21078384fabb96961c84bebee6b05a0ce85ee9b4.1748746278.git.goodoldpaul@autistici.org>
X-Mailer: git-send-email 2.49.0
In-Reply-To: <8ac2edf51988af974ed0b4cd4ac63da23ce17118.1748746278.git.goodoldpaul@autistici.org>
References: <8ac2edf51988af974ed0b4cd4ac63da23ce17118.1748746278.git.goodoldpaul@autistici.org>
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
X-Spam-Score: -0.0 (/)
X-BeenThere: debbugs-submit@debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: 
List-Unsubscribe: , 
 
List-Archive: 
List-Post: 
List-Help: 
List-Subscribe: , 
 
Errors-To: debbugs-submit-bounces@debbugs.gnu.org
Sender: "Debbugs-submit" 
X-Spam-Score: -1.0 (-)

This patch moves with-retries outside of (gnu build dbus-service) into a
more general (gnu build utils) which can be imported without
unnecessarily importing dbus related symbols.

* gnu/build/dbus-service.scm (sleep,with-retries): Move to...
* gnu/build/utils.scm: ...here.
* gnu/local.mk: Add gnu/build/utils.scm.
* gnu/build/jami-service.scm: Import (gnu build utils).
* gnu/services/telephony.scm (jami-account->alist): Format.
(jami-shepherd-services): Import (gnu build utils).
* gnu/test/messaging.scm (run-ngircd-test): Import (gnu build utils).
(run-pounce-test): Import (gnu build utils).
* gnu/test/telephony.scm (run-jami-test): Import (gnu build utils) and
format.

Change-Id: I3c1768f884ca46d0820a801bd0310c2ec8f3da54
---
 gnu/build/dbus-service.scm | 39 +++------------------------
 gnu/build/jami-service.scm |  1 +
 gnu/build/utils.scm        | 55 ++++++++++++++++++++++++++++++++++++++
 gnu/local.mk               |  1 +
 gnu/services/telephony.scm |  9 ++++---
 gnu/tests/messaging.scm    |  8 +++---
 gnu/tests/telephony.scm    | 11 ++++----
 7 files changed, 76 insertions(+), 48 deletions(-)
 create mode 100644 gnu/build/utils.scm

diff --git a/gnu/build/dbus-service.scm b/gnu/build/dbus-service.scm
index 688afe44c3d..9bbcd457512 100644
--- a/gnu/build/dbus-service.scm
+++ b/gnu/build/dbus-service.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2021, 2022 Maxim Cournoyer 
+;;; Copyright © 2025 Giacomo Leidi 
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -24,6 +25,7 @@
 ;;; Code:
 
 (define-module (gnu build dbus-service)
+  #:use-module (gnu build utils)
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-19)
@@ -54,45 +56,10 @@ (define-module (gnu build dbus-service)
             call-dbus-method
 
             dbus-available-services
-            dbus-service-available?
-
-            with-retries))
+            dbus-service-available?))
 
 (define %dbus-query-timeout 2)          ;in seconds
 
-;;; Use Fibers' sleep to enable cooperative scheduling in Shepherd >= 0.9.0,
-;;; which is required at least for the Jami service.
-(define sleep*
-  (lambda ()                            ;delay execution
-    (if (resolve-module '(fibers) #f #:ensure #f)
-        (module-ref (resolve-interface '(fibers)) 'sleep)
-        (begin
-          (format #t "Fibers not available -- blocking 'sleep' in use~%")
-          sleep))))
-
-;;;
-;;; Utilities.
-;;;
-
-(define-syntax-rule (with-retries n delay body ...)
-  "Retry the code in BODY up to N times until it doesn't raise an exception nor
-return #f, else raise an error.  A delay of DELAY seconds is inserted before
-each retry."
-  (let loop ((attempts 0))
-    (catch #t
-      (lambda ()
-        (let ((result (begin body ...)))
-          (if (not result)
-              (error "failed attempt" attempts)
-              result)))
-      (lambda args
-        (if (< attempts n)
-            (begin
-              ((sleep*) delay)            ;else wait and retry
-              (loop (+ 1 attempts)))
-            (error "maximum number of retry attempts reached"
-                   (quote body ...) args))))))
-
 
 ;;;
 ;;; Low level wrappers above AC/D-Bus.
diff --git a/gnu/build/jami-service.scm b/gnu/build/jami-service.scm
index a00785f699b..7c2c48d821a 100644
--- a/gnu/build/jami-service.scm
+++ b/gnu/build/jami-service.scm
@@ -25,6 +25,7 @@
 
 (define-module (gnu build jami-service)
   #:use-module (gnu build dbus-service)
+  #:use-module (gnu build utils)
   #:use-module (ice-9 format)
   #:use-module (ice-9 match)
   #:use-module (ice-9 rdelim)
diff --git a/gnu/build/utils.scm b/gnu/build/utils.scm
new file mode 100644
index 00000000000..1aa72358bd8
--- /dev/null
+++ b/gnu/build/utils.scm
@@ -0,0 +1,55 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2025 Giacomo Leidi 
+;;;
+;;; 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 .
+
+;;; Commentary:
+;;;
+;;; This module contains helpers that could useful to any service.
+;;;
+;;; Code:
+
+(define-module (gnu build utils)
+  #:export (with-retries))
+
+;;; Use Fibers' sleep to enable cooperative scheduling in Shepherd >= 0.9.0,
+;;; which is required at least for the Jami service.
+(define sleep*
+  (lambda ()                            ;delay execution
+    (if (resolve-module '(fibers) #f #:ensure #f)
+        (module-ref (resolve-interface '(fibers)) 'sleep)
+        (begin
+          (format #t "Fibers not available -- blocking 'sleep' in use~%")
+          sleep))))
+
+(define-syntax-rule (with-retries n delay body ...)
+  "Retry the code in BODY up to N times until it doesn't raise an exception nor
+return #f, else raise an error.  A delay of DELAY seconds is inserted before
+each retry."
+  (let loop ((attempts 0))
+    (catch #t
+      (lambda ()
+        (let ((result (begin body ...)))
+          (if (not result)
+              (error "failed attempt" attempts)
+              result)))
+      (lambda args
+        (if (< attempts n)
+            (begin
+              ((sleep*) delay)            ;else wait and retry
+              (loop (+ 1 attempts)))
+            (error "maximum number of retry attempts reached"
+                   (quote body ...) args))))))
diff --git a/gnu/local.mk b/gnu/local.mk
index 2948bfb1bff..4500bfc6d33 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -841,6 +841,7 @@ GNU_SYSTEM_MODULES =				\
   %D%/build/linux-modules.scm			\
   %D%/build/marionette.scm			\
   %D%/build/secret-service.scm			\
+  %D%/build/utils.scm   			\
 						\
   %D%/tests.scm					\
   %D%/tests/audio.scm				\
diff --git a/gnu/services/telephony.scm b/gnu/services/telephony.scm
index 9926f4107de..ad6959e161b 100644
--- a/gnu/services/telephony.scm
+++ b/gnu/services/telephony.scm
@@ -210,7 +210,7 @@ (define (jami-account->alist jami-account-object)
              (tfilter-maybe-value jami-account-object)
              (tmap (lambda (field)
                      (let* ((name (field-name->account-detail
-                                  (configuration-field-name field)))
+                                   (configuration-field-name field)))
                             (value ((configuration-field-serializer field)
                                     name ((configuration-field-getter field)
                                           jami-account-object))))
@@ -360,7 +360,8 @@ (define (jami-shepherd-services config)
                            ;; variant of the 'sleep' procedure.
                            guile-fibers)
       (with-imported-modules (source-module-closure
-                              '((gnu build dbus-service)
+                              '((gnu build utils)
+                                (gnu build dbus-service)
                                 (gnu build jami-service)
                                 (gnu system file-systems)))
 
@@ -541,7 +542,8 @@ (define (jami-shepherd-services config)
         (list (shepherd-service
                (documentation "Run a D-Bus session for the Jami daemon.")
                (provision '(jami-dbus-session))
-               (modules `((gnu build dbus-service)
+               (modules `((gnu build utils)
+                          (gnu build dbus-service)
                           (gnu build jami-service)
                           (gnu system file-systems)
                           ,@%default-modules))
@@ -587,6 +589,7 @@ (define (jami-shepherd-services config)
                           (ice-9 receive)
                           (srfi srfi-1)
                           (srfi srfi-26)
+                          (gnu build utils)
                           (gnu build dbus-service)
                           (gnu build jami-service)
                           (gnu system file-systems)
diff --git a/gnu/tests/messaging.scm b/gnu/tests/messaging.scm
index 8df67433a7f..2eb99331b52 100644
--- a/gnu/tests/messaging.scm
+++ b/gnu/tests/messaging.scm
@@ -269,7 +269,7 @@ (define (run-ngircd-test)
        (marionette-operating-system
         %ngircd-os
         #:imported-modules (source-module-closure
-                            '((gnu build dbus-service)
+                            '((gnu build utils)
                               (guix build utils)
                               (gnu services herd)))))))
 
@@ -298,7 +298,7 @@ (define (run-ngircd-test)
           (test-assert "basic irc operations function as expected"
             (marionette-eval
              '(begin
-                (use-modules ((gnu build dbus-service) #:select (with-retries))
+                (use-modules (gnu build utils)
                              (ice-9 textual-ports))
 
                 (define (write-command command)
@@ -437,7 +437,7 @@ (define (run-pounce-test)
        (marionette-operating-system
         %pounce-os
         #:imported-modules (source-module-closure
-                            '((gnu build dbus-service)
+                            '((gnu build utils)
                               (guix build utils)
                               (gnu services herd)))))
      (memory-size 1024)))
@@ -470,7 +470,7 @@ (define (run-pounce-test)
           (test-assert "pounce functions as an irc bouncer"
             (marionette-eval
              '(begin
-                (use-modules ((gnu build dbus-service) #:select (with-retries))
+                (use-modules (gnu build utils)
                              (guix build utils)
                              (ice-9 textual-ports))
 
diff --git a/gnu/tests/telephony.scm b/gnu/tests/telephony.scm
index f03ea963f7e..3a085762323 100644
--- a/gnu/tests/telephony.scm
+++ b/gnu/tests/telephony.scm
@@ -143,7 +143,8 @@ (define* (run-jami-test #:key provisioning? partial?)
               #:imported-modules '((gnu services herd)
                                    (guix combinators)
                                    (gnu build jami-service)
-                                   (gnu build dbus-service))))
+                                   (gnu build dbus-service)
+                                   (gnu build utils))))
   (define vm (virtual-machine
               (operating-system os)
               (memory-size 512)))
@@ -209,7 +210,7 @@ (define* (run-jami-test #:key provisioning? partial?)
           (test-assert "service can be stopped"
             (marionette-eval
              '(begin
-                (use-modules (gnu build dbus-service)
+                (use-modules (gnu build utils)
                              (gnu build jami-service)
                              (gnu services herd)
                              (rnrs base))
@@ -223,10 +224,10 @@ (define* (run-jami-test #:key provisioning? partial?)
           (test-assert "service can be restarted"
             (marionette-eval
              '(begin
-                (use-modules (gnu build dbus-service)
+                (use-modules (gnu build utils)
                              (gnu build jami-service)
                              (gnu services herd)
-                             (rnrs base)                               )
+                             (rnrs base))
                 ;; Start the service.
                 (start-service 'jami)
                 (with-retries 40 1 (jami-service-available?))
@@ -239,7 +240,7 @@ (define* (run-jami-test #:key provisioning? partial?)
           (test-assert "jami accounts provisioning, account present"
             (marionette-eval
              '(begin
-                (use-modules (gnu build dbus-service)
+                (use-modules (gnu build utils)
                              (gnu services herd)
                              (rnrs base))
                 ;; Accounts take some time to appear after being added.
-- 
2.49.0





From unknown Fri Jun 13 11:55:10 2025
X-Loop: help-debbugs@gnu.org
Subject: [bug#76081] [PATCH v11 5/5] home: Add home-oci-service-type.
Resent-From: Giacomo Leidi 
Original-Sender: "Debbugs-submit" 
Resent-CC: andrew@trop.in, gabriel@erlikon.ch, hako@ultrarare.space, janneke@gnu.org, ludo@gnu.org, maxim.cournoyer@gmail.com, tanguy@bioneland.org, guix-patches@gnu.org
Resent-Date: Sun, 01 Jun 2025 02:53:16 +0000
Resent-Message-ID: 
Resent-Sender: help-debbugs@gnu.org
X-GNU-PR-Message: followup 76081
X-GNU-PR-Package: guix-patches
X-GNU-PR-Keywords: moreinfo
To: 76081@debbugs.gnu.org
Cc: Giacomo Leidi , Andrew Tropin , Gabriel Wicki , Hilton Chain , Janneke Nieuwenhuizen , Ludovic =?UTF-8?Q?Court=C3=A8s?= , Maxim Cournoyer , Tanguy Le Carrour 
X-Debbugs-Original-Xcc: Andrew Tropin , Gabriel Wicki , Hilton Chain , Janneke Nieuwenhuizen , Ludovic =?UTF-8?Q?Court=C3=A8s?= , Maxim Cournoyer , Tanguy Le Carrour 
Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.174874635722390
          (code B ref 76081); Sun, 01 Jun 2025 02:53:16 +0000
Received: (at 76081) by debbugs.gnu.org; 1 Jun 2025 02:52:37 +0000
Received: from localhost ([127.0.0.1]:34563 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from )
	id 1uLYoL-0005ok-Eq
	for submit@debbugs.gnu.org; Sat, 31 May 2025 22:52:36 -0400
Received: from confino.investici.org ([93.190.126.19]:35461)
 by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
 (Exim 4.84_2) (envelope-from )
 id 1uLYnO-0005iD-Vx
 for 76081@debbugs.gnu.org; Sat, 31 May 2025 22:51:49 -0400
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org;
 s=stigmate; t=1748746293;
 bh=2qABf6sNZqBZLGINotJsfcFOkpx8oaYirflqE+y8og4=;
 h=From:To:Cc:Subject:Date:In-Reply-To:References:From;
 b=U8/T2jls1YsfrduDzLrjg5mLdcgvvHrkCjnUUZaax+AwsHYmsXy2j5rUtM2XsQXUI
 IOPdyDprl7nY6y9jclGbgAB79AVAVmvBPsKmgmcpRVIpsSV0UZASBxCNs8tgSvA5GP
 VB2q1oURLyAMqZocfHvD6AW+szr4mbFy7YOrWoXg=
Received: from mx1.investici.org (unknown [127.0.0.1])
 by confino.investici.org (Postfix) with ESMTP id 4b91hP6rFtz118n;
 Sun,  1 Jun 2025 02:51:33 +0000 (UTC)
Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19])
 (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with
 ESMTPSA id 4b91hP5qC3z1181; Sun,  1 Jun 2025 02:51:33 +0000 (UTC)
From: Giacomo Leidi 
Date: Sun,  1 Jun 2025 04:51:18 +0200
Message-ID: 
X-Mailer: git-send-email 2.49.0
In-Reply-To: <8ac2edf51988af974ed0b4cd4ac63da23ce17118.1748746278.git.goodoldpaul@autistici.org>
References: <8ac2edf51988af974ed0b4cd4ac63da23ce17118.1748746278.git.goodoldpaul@autistici.org>
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
X-Spam-Score: -0.7 (/)
X-BeenThere: debbugs-submit@debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: 
List-Unsubscribe: , 
 
List-Archive: 
List-Post: 
List-Help: 
List-Subscribe: , 
 
Errors-To: debbugs-submit-bounces@debbugs.gnu.org
Sender: "Debbugs-submit" 
X-Spam-Score: -1.7 (-)

* gnu/home/service/containers.scm: New file;
* gnu/local.mk (GNU_SYSTEM_MODULES): Add it.
* doc/guix.texi (OCI backed services): Document it.

Change-Id: I8ce5b301e8032d0a7b2a9ca46752738cdee1f030
Signed-off-by: Giacomo Leidi 
---
 doc/guix.texi                    | 114 +++++++++++++++++++++++++++++++
 gnu/home/services/containers.scm |  49 +++++++++++++
 gnu/local.mk                     |   1 +
 3 files changed, 164 insertions(+)
 create mode 100644 gnu/home/services/containers.scm

diff --git a/doc/guix.texi b/doc/guix.texi
index ae49d0c547b..2821712e8b4 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -52192,6 +52192,120 @@ Miscellaneous Home Services
 documentation of the system service (@pxref{Miscellaneous Services,
 @code{readymedia-service-type}}).
 
+@subsubheading OCI backed services
+
+@cindex OCI-backed, for Home
+The @code{(gnu home services containers)} module provides the following service:
+
+@defvar home-oci-service-type
+This is the type of the service that allows to manage your OCI containers with
+the same consistent interface you use for your other Home Shepherd services.
+@end defvar
+
+This service is a direct mapping of the @code{oci-service-type} system
+service (@pxref{Miscellaneous Services, OCI backed services}).  You can
+use it like this:
+
+@lisp
+(use-modules (gnu services containers)
+             (gnu home services containers))
+
+(simple-service 'home-oci-provisioning
+                home-oci-service-type
+                (oci-extension
+                  (volumes
+                    (list
+                      (oci-volume-configuration (name "prometheus"))
+                      (oci-volume-configuration (name "grafana"))))
+                  (networks
+                    (list
+                      (oci-network-configuration (name "monitoring"))))
+                  (containers
+                   (list
+                    (oci-container-configuration
+                     (network "monitoring")
+                     (image
+                      (oci-image
+                        (repository "guile")
+                        (tag "3")
+                        (value (specifications->manifest '("guile")))
+                        (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile"))
+                                        #:max-layers 2))))
+                     (entrypoint "/bin/guile")
+                     (command
+                      '("-c" "(display \"hello!\n\")")))
+                    (oci-container-configuration
+                      (image "prom/prometheus")
+                      (network "monitoring")
+                      (ports
+                       '(("9000" . "9000")
+                         ("9090" . "9090")))
+                      (volumes
+                       (list
+                        '(("prometheus" . "/var/lib/prometheus")))))
+                    (oci-container-configuration
+                      (image "grafana/grafana:10.0.1")
+                      (network "monitoring")
+                      (volumes
+                       '(("grafana:/var/lib/grafana"))))))))
+
+@end lisp
+
+You may specify a custom configuration by providing a
+@code{oci-configuration} record, exactly like for
+@code{oci-service-type}, but wrapping it in @code{for-home}:
+
+@lisp
+(use-modules (gnu services)
+             (gnu services containers)
+             (gnu home services containers))
+
+(service home-oci-service-type
+         (for-home
+          (oci-configuration
+           (runtime 'podman)
+           (verbose? #t))))
+
+(simple-service 'home-oci-provisioning
+                home-oci-service-type
+                (oci-extension
+                  (volumes
+                    (list
+                      (oci-volume-configuration (name "prometheus"))
+                      (oci-volume-configuration (name "grafana"))))
+                  (networks
+                    (list
+                      (oci-network-configuration (name "monitoring"))))
+                  (containers
+                   (list
+                    (oci-container-configuration
+                     (network "monitoring")
+                     (image
+                      (oci-image
+                        (repository "guile")
+                        (tag "3")
+                        (value (specifications->manifest '("guile")))
+                        (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile"))
+                                        #:max-layers 2))))
+                     (entrypoint "/bin/guile")
+                     (command
+                      '("-c" "(display \"hello!\n\")")))
+                    (oci-container-configuration
+                      (image "prom/prometheus")
+                      (network "monitoring")
+                      (ports
+                       '(("9000" . "9000")
+                         ("9090" . "9090")))
+                      (volumes
+                       (list
+                        '(("prometheus" . "/var/lib/prometheus")))))
+                    (oci-container-configuration
+                      (image "grafana/grafana:10.0.1")
+                      (network "monitoring")
+                      (volumes
+                       '(("grafana:/var/lib/grafana"))))))))
+@end lisp
+
 @node Invoking guix home
 @section Invoking @command{guix home}
 
diff --git a/gnu/home/services/containers.scm b/gnu/home/services/containers.scm
new file mode 100644
index 00000000000..1ccdb3b2464
--- /dev/null
+++ b/gnu/home/services/containers.scm
@@ -0,0 +1,49 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2025 Giacomo Leidi 
+;;;
+;;; 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 .
+
+(define-module (gnu home services containers)
+  #:use-module (gnu home services)
+  #:use-module (gnu home services shepherd)
+  #:use-module (gnu services)
+  #:use-module (gnu services configuration)
+  #:use-module (gnu services containers)
+  #:use-module (guix gexp)
+  #:use-module (guix packages)
+  #:use-module (srfi srfi-1)
+  #:export (home-oci-service-type))
+
+(define home-oci-service-type
+  (service-type
+   (inherit (system->home-service-type oci-service-type))
+   (extensions
+    (list
+     (service-extension home-profile-service-type
+                        (lambda (config)
+                          (let ((runtime-cli
+                                 (oci-configuration-runtime-cli config))
+                                (runtime
+                                 (oci-configuration-runtime config)))
+                            (oci-service-profile runtime runtime-cli))))
+     (service-extension home-shepherd-service-type
+                        oci-configuration->shepherd-services)))
+   (extend
+    (lambda (config extension)
+      (for-home
+       (oci-configuration
+        (inherit (oci-configuration-extend config extension))))))
+   (default-value (for-home (oci-configuration)))))
diff --git a/gnu/local.mk b/gnu/local.mk
index 09ccd64b40a..5dfc20da9ca 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -104,6 +104,7 @@ GNU_SYSTEM_MODULES =				\
   %D%/home/services.scm			\
   %D%/home/services/admin.scm			\
   %D%/home/services/backup.scm			\
+  %D%/home/services/containers.scm		\
   %D%/home/services/desktop.scm			\
   %D%/home/services/dict.scm			\
   %D%/home/services/dotfiles.scm		\
-- 
2.49.0





From unknown Fri Jun 13 11:55:10 2025
X-Loop: help-debbugs@gnu.org
Subject: [bug#76081] [PATCH v10 7/7] home: Add home-oci-service-type.
Resent-From: paul 
Original-Sender: "Debbugs-submit" 
Resent-CC: guix-patches@gnu.org
Resent-Date: Fri, 13 Jun 2025 18:10:04 +0000
Resent-Message-ID: 
Resent-Sender: help-debbugs@gnu.org
X-GNU-PR-Message: followup 76081
X-GNU-PR-Package: guix-patches
X-GNU-PR-Keywords: moreinfo
To: Maxim Cournoyer 
Cc: Tanguy Le Carrour , Ludovic =?UTF-8?Q?Court=C3=A8s?= , Gabriel Wicki , Andrew Tropin , Hilton Chain , 76081@debbugs.gnu.org, Janneke Nieuwenhuizen 
Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.174983818312220
          (code B ref 76081); Fri, 13 Jun 2025 18:10:04 +0000
Received: (at 76081) by debbugs.gnu.org; 13 Jun 2025 18:09:43 +0000
Received: from localhost ([127.0.0.1]:49834 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from )
	id 1uQ8qU-0003B0-Vz
	for submit@debbugs.gnu.org; Fri, 13 Jun 2025 14:09:43 -0400
Received: from confino.investici.org ([93.190.126.19]:36565)
 by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
 (Exim 4.84_2) (envelope-from )
 id 1uQ8qR-0003Ak-Jj
 for 76081@debbugs.gnu.org; Fri, 13 Jun 2025 14:09:41 -0400
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org;
 s=stigmate; t=1749838177;
 bh=b0IWIA/WS3VUa4PxwVaBVxUZXLFoYhGZ8hw8jyPLy2E=;
 h=Date:Subject:From:To:Cc:References:In-Reply-To:From;
 b=JvIK/wamBCsR6hm4zD3nIuJniABbmAtkmTtJKBFy6U7XBxSRNpPvUMsKZT9wnm6P/
 OE4SaPaa8MPo7tdHwadojLEsKmKUvvoKBczyC5YAa0VCEiHHjS3oc7gSllu0d+HATc
 H2bxtnWpN0iX9IdeuzoyG9M8PEcwydbqwcDeqelE=
Received: from mx1.investici.org (unknown [127.0.0.1])
 by confino.investici.org (Postfix) with ESMTP id 4bJnV94dkkz10t3;
 Fri, 13 Jun 2025 18:09:37 +0000 (UTC)
Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19])
 (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with
 ESMTPSA id 4bJnV91l7Pz10sd; Fri, 13 Jun 2025 18:09:37 +0000 (UTC)
Message-ID: <0ac0cdfc-7997-4b97-ab13-906c41eacc09@autistici.org>
Date: Fri, 13 Jun 2025 20:09:36 +0200
MIME-Version: 1.0
User-Agent: Icedove Daily
From: paul 
References: <2b78b4ce9b0a3a6c0bdbdec5bb16702a5b5083a3.1746431874.git.goodoldpaul@autistici.org>
 <91c9920430684861541c86a01c28bd46423102c8.1746431874.git.goodoldpaul@autistici.org>
 <877c2hi9zh.fsf@gmail.com>
 <772c4c9b-ae5b-4073-9029-fbfa34c2ae6d@autistici.org>
Content-Language: en-US
In-Reply-To: <772c4c9b-ae5b-4073-9029-fbfa34c2ae6d@autistici.org>
Content-Type: text/plain; charset=UTF-8; format=flowed
Content-Transfer-Encoding: 7bit
X-Spam-Score: -0.7 (/)
X-BeenThere: debbugs-submit@debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: 
List-Unsubscribe: , 
 
List-Archive: 
List-Post: 
List-Help: 
List-Subscribe: , 
 
Errors-To: debbugs-submit-bounces@debbugs.gnu.org
Sender: "Debbugs-submit" 
X-Spam-Score: -1.7 (-)

Hi I'm sending a v12 dropping the annoying verbose log printing whether 
the evaluation was happening in Guix Home context or not. It brings no 
additional informations.

The new revision is also rebased on top of 
b7fc28345c8eae2fe68d0c2c740a809926c69b87 .

thank you for your work,

cheers

giacomo





From unknown Fri Jun 13 11:55:10 2025
X-Loop: help-debbugs@gnu.org
Subject: [bug#76081] [PATCH v12 3/5] services: Add oci-service-type.
Resent-From: Giacomo Leidi 
Original-Sender: "Debbugs-submit" 
Resent-CC: gabriel@erlikon.ch, ludo@gnu.org, maxim.cournoyer@gmail.com, guix-patches@gnu.org
Resent-Date: Fri, 13 Jun 2025 18:11:04 +0000
Resent-Message-ID: 
Resent-Sender: help-debbugs@gnu.org
X-GNU-PR-Message: followup 76081
X-GNU-PR-Package: guix-patches
X-GNU-PR-Keywords: moreinfo
To: 76081@debbugs.gnu.org
Cc: Giacomo Leidi , Gabriel Wicki , Ludovic =?UTF-8?Q?Court=C3=A8s?= , Maxim Cournoyer 
X-Debbugs-Original-Xcc: Gabriel Wicki , Ludovic =?UTF-8?Q?Court=C3=A8s?= , Maxim Cournoyer 
Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.174983824512919
          (code B ref 76081); Fri, 13 Jun 2025 18:11:04 +0000
Received: (at 76081) by debbugs.gnu.org; 13 Jun 2025 18:10:45 +0000
Received: from localhost ([127.0.0.1]:49869 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from )
	id 1uQ8rU-0003MJ-KF
	for submit@debbugs.gnu.org; Fri, 13 Jun 2025 14:10:44 -0400
Received: from confino.investici.org ([93.190.126.19]:27413)
 by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
 (Exim 4.84_2) (envelope-from )
 id 1uQ8rS-0003M4-9Y
 for 76081@debbugs.gnu.org; Fri, 13 Jun 2025 14:10:42 -0400
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org;
 s=stigmate; t=1749838240;
 bh=NIhuI+FKjXeGiLTkV33xiBJpJE1EBgG/V6McxjWzXvA=;
 h=From:To:Cc:Subject:Date:In-Reply-To:References:From;
 b=Ly2xO/vy7Spar/UQ1Geo23y3GoQ34rjgrF9Qa9rfsbZQN4vOH8C4QqYJ4QQPyN+T1
 uS/98RfY5tmu3rpY8hVNDMjLjhTRe3bzjNwERX+IW1bMPX9cFoHnH8E8Ly9/ug1RoN
 f1lbnX5Ts7KhB1sswOp29+8NhS2fgxc66mrPJPbY=
Received: from mx1.investici.org (unknown [127.0.0.1])
 by confino.investici.org (Postfix) with ESMTP id 4bJnWN1mLwz112m;
 Fri, 13 Jun 2025 18:10:40 +0000 (UTC)
Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19])
 (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with
 ESMTPSA id 4bJnWN04hDz10tj; Fri, 13 Jun 2025 18:10:39 +0000 (UTC)
From: Giacomo Leidi 
Date: Fri, 13 Jun 2025 20:10:06 +0200
Message-ID: 
X-Mailer: git-send-email 2.49.0
In-Reply-To: 
References: 
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
X-BeenThere: debbugs-submit@debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: 
List-Unsubscribe: , 
 
List-Archive: 
List-Post: 
List-Help: 
List-Subscribe: , 
 
Errors-To: debbugs-submit-bounces@debbugs.gnu.org
Sender: "Debbugs-submit" 

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
Signed-off-by: Giacomo Leidi 
---
 doc/guix.texi                |  306 ++++++--
 gnu/build/oci-containers.scm |  210 ++++++
 gnu/local.mk                 |    1 +
 gnu/services/containers.scm  | 1363 +++++++++++++++++++++++++++++-----
 gnu/services/docker.scm      |   38 +-
 gnu/tests/containers.scm     |  561 +++++++++++++-
 6 files changed, 2206 insertions(+), 273 deletions(-)
 create mode 100644 gnu/build/oci-containers.scm

diff --git a/doc/guix.texi b/doc/guix.texi
index eb55d337f57..fbffead4f9f 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -44108,59 +44108,162 @@ Miscellaneous Services
 @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: given an
-@acronym{Open Container Initiative, OCI} container image, it will run it in a
+Should you wish to manage your @acronym{Open Container Initiative, OCI} containers
+with the same consistent interface you use for your other Shepherd services,
+@var{oci-service-type} is the tool to use: given an
+OCI container image, it will run it in a
 Shepherd service.  One example where this is useful: it lets you run services
-that are available as Docker/OCI images but not yet packaged for Guix.
+that are available as OCI images but not yet packaged for Guix.
 
-@defvar oci-container-service-type
+@defvar oci-service-type
 
-This is a thin wrapper around Docker's CLI that executes OCI images backed
+This is a thin wrapper around Docker's or Podman's CLI that executes OCI images backed
 processes as Shepherd Services.
 
 @lisp
-(service oci-container-service-type
-         (list
-          (oci-container-configuration
-           (network "host")
-           (image
-            (oci-image
-             (repository "guile")
-             (tag "3")
-             (value (specifications->manifest '("guile")))
-             (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile"))
-                             #:max-layers 2))))
-           (entrypoint "/bin/guile")
-           (command
-            '("-c" "(display \"hello!\n\")")))
-          (oci-container-configuration
-           (image "prom/prometheus")
-           (ports
-             '(("9000" . "9000")
-               ("9090" . "9090"))))
-          (oci-container-configuration
-           (image "grafana/grafana:10.0.1")
-           (network "host")
-           (volumes
-             '("/var/lib/grafana:/var/lib/grafana")))))
+(simple-service 'oci-provisioning
+                oci-service-type
+                (oci-extension
+                  (networks
+                    (list
+                      (oci-network-configuration (name "monitoring"))))
+                  (containers
+                   (list
+                    (oci-container-configuration
+                     (network "monitoring")
+                     (image
+                      (oci-image
+                        (repository "guile")
+                        (tag "3")
+                        (value (specifications->manifest '("guile")))
+                        (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile"))
+                                        #:max-layers 2))))
+                     (entrypoint "/bin/guile")
+                     (command
+                      '("-c" "(display \"hello!\n\")")))
+                    (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
 
 In this example three different Shepherd services are going to be added to the
 system.  Each @code{oci-container-configuration} record translates to a
-@code{docker run} invocation and its fields directly map to options.  You can
-refer to the
-@url{https://docs.docker.com/engine/reference/commandline/run,upstream}
-documentation for the semantics of each value.  If the images are not found,
-they will be
-@url{https://docs.docker.com/engine/reference/commandline/pull/,pulled}.  The
+@samp{docker run} or @samp{podman run} invocation and its fields directly
+map to options.  You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html,Podman}
+upstream documentation for semantics of each value.  If the images are not found,
+they will be pulled.  You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/pull/,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-pull.1.html,Podman}
+upstream documentation for semantics.  The
 services with @code{(network "host")} are going to be attached to the
 host network and are supposed to behave like native processes with regard to
 networking.
 
 @end defvar
 
+@c %start of fragment
+
+@deftp {Data Type} oci-configuration
+Available @code{oci-configuration} fields are:
+
+@table @asis
+@item @code{runtime} (default: @code{'docker}) (type: symbol)
+The OCI runtime to use to run commands.  It can be either @code{'docker} or
+@code{'podman}.
+
+@item @code{runtime-cli} (type: maybe-package-or-string)
+The OCI runtime command line to be installed in the system profile and used
+to provision OCI resources, it can be either a package or a string representing
+an absolute file name to the runtime binary entrypoint.  When unset it will default
+to @code{docker-cli} package for the @code{'docker} runtime or to @code{podman}
+package for the @code{'podman} runtime.
+
+@item @code{runtime-extra-arguments} (default: @code{'()}) (type: list)
+A list of strings, gexps or file-like objects that will be placed
+after each @command{docker} or @command{podman} invokation.
+
+@item @code{user} (type: maybe-string)
+The user name under whose authority OCI commands will be run.  This field will
+override the @code{user} field of @code{oci-configuration}.
+
+@item @code{group} (type: maybe-string)
+The group name under whose authority OCI commands will be run.  When
+using the @code{'podman} OCI runtime, this field will be ignored and the
+default group of the user configured in the @code{user} field will be used.
+This field will override the @code{group} field of @code{oci-configuration}.
+
+@item @code{subuids-range} (type: maybe-subid-range)
+An optional @code{subid-range} record allocating subuids for the user from
+the @code{user} field.  When unset, with the rootless Podman OCI runtime, it
+defaults to @code{(subid-range (name "oci-container"))}.
+
+@item @code{subgids-range} (type: maybe-subid-range)
+An optional @code{subid-range} record allocating subgids for the user from
+the @code{user} field.  When unset, with the rootless Podman OCI runtime, it
+defaults to @code{(subid-range (name "oci-container"))}.
+
+@item @code{containers} (default: @code{'()}) (type: list-of-oci-containers)
+The list of @code{oci-container-configuration} records representing the
+containers to provision.  The use of the @code{oci-extension} record should
+be preferred for most cases.
+
+@item @code{networks} (default: @code{'()}) (type: list-of-oci-networks)
+The list of @code{oci-network-configuration} records representing the
+containers to provision.  The use of the @code{oci-extension} record should
+be preferred for most cases.
+
+@item @code{volumes} (default: @code{'()}) (type: list-of-oci-volumes)
+The list of @code{oci-volumes-configuration} records representing the
+containers to provision.  The use of the @code{oci-extension} record should
+be preferred for most cases.
+
+@item @code{verbose?} (default: @code{#f}) (type: boolean)
+When true, additional output will be printed, allowing to better follow the
+flow of execution.
+
+@end table
+
+@end deftp
+
+
+@c %end of fragment
+
+@c %start of fragment
+
+@deftp {Data Type} oci-extension
+Available @code{oci-extension} fields are:
+
+@table @asis
+@item @code{containers} (default: @code{'()}) (type: list-of-oci-containers)
+The list of @code{oci-container-configuration} records representing the
+containers to provision.
+
+@item @code{networks} (default: @code{'()}) (type: list-of-oci-networks)
+The list of @code{oci-network-configuration} records representing the
+containers to provision.
+
+@item @code{volumes} (default: @code{'()}) (type: list-of-oci-volumes)
+The list of @code{oci-volumes-configuration} records representing the
+containers to provision.
+
+@end table
+
+@end deftp
+
+
+@c %end of fragment
+
+
 @c %start of fragment
 
 @deftp {Data Type} oci-container-configuration
@@ -44180,16 +44283,16 @@ Miscellaneous Services
 Overwrite the default entrypoint (@code{ENTRYPOINT}) of the image.
 
 @item @code{host-environment} (default: @code{'()}) (type: 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
+Set environment variables in the host environment where @samp{docker run}
+or @samp{podman run} are invoked.  This is especially useful to pass secrets
+from the host to the container without having them on the OCI runtime command line,
+for example: by setting the @code{MYSQL_PASSWORD} on the host and by passing
 @code{--env MYSQL_PASSWORD} through the @code{extra-arguments} field, it is
 possible to securely set values in the container environment.  This field's
 value can be a list of pairs or strings, even mixed:
 
 @lisp
-(list '("LANGUAGE\" . "eo:ca:eu")
+(list '("LANGUAGE" . "eo:ca:eu")
       "JAVA_HOME=/opt/java")
 @end lisp
 
@@ -44197,22 +44300,24 @@ Miscellaneous Services
 directly to @code{make-forkexec-constructor}.
 
 @item @code{environment} (default: @code{'()}) (type: list)
-Set environment variables. This can be a list of pairs or strings, even mixed:
+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
-@uref{https://docs.docker.com/engine/reference/commandline/run/#env,upstream}
-documentation for semantics.
+Pair members can be strings, gexps or file-like objects. Strings are passed
+directly to the OCI runtime CLI.  You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#env,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#env-e-env,Podman}
+upstream documentation for semantics.
 
 @item @code{image} (type: 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{oci-image} record.  Strings are resolved by the OCI runtime,
+and follow the usual format
 @code{myregistry.local:5000/testing/test-image:tag}.
 
 @item @code{provision} (default: @code{""}) (type: string)
@@ -44240,7 +44345,7 @@ Miscellaneous Services
 by the service.
 
 @item @code{network} (default: @code{""}) (type: string)
-Set a Docker network for the spawned container.
+Set an OCI 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
@@ -44251,10 +44356,11 @@ Miscellaneous Services
       "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
-@uref{https://docs.docker.com/engine/reference/commandline/run/#publish,upstream}
-documentation for semantics.
+Pair members can be strings, gexps or file-like objects. Strings are passed
+directly to the OCI runtime CLI.  You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#publish,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#publish-p-ip-hostport-containerport-protocol,Podman}
+upstream documentation for semantics.
 
 @item @code{volumes} (default: @code{'()}) (type: list)
 Set volume mappings for the spawned container.  This can be a
@@ -44265,25 +44371,97 @@ Miscellaneous Services
       "/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
-@uref{https://docs.docker.com/engine/reference/commandline/run/#volume,upstream}
-documentation for semantics.
+Pair members can be strings, gexps or file-like objects. Strings are passed
+directly to the OCI runtime CLI.  You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#volume,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#volume-v-source-volume-host-dir-container-dir-options,Podman}
+upstream documentation for semantics.
 
 @item @code{container-user} (default: @code{""}) (type: 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.
+@url{https://docs.docker.com/engine/reference/run/#user,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#user-u-user-group,Podman}
+upstream documentation for semantics.
 
 @item @code{workdir} (default: @code{""}) (type: string)
 Set the current working directory for the spawned Shepherd service.
 You can refer to the
-@url{https://docs.docker.com/engine/reference/run/#workdir,upstream}
-documentation for semantics.
+@url{https://docs.docker.com/engine/reference/run/#workdir,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#workdir-w-dir,Podman}
+upstream documentation for semantics.
+
+@item @code{extra-arguments} (default: @code{'()}) (type: list)
+A list of strings, gexps or file-like objects that will be directly passed
+to the @samp{docker run} or @samp{podman run} invokation.
+
+@end table
+
+@end deftp
+
+
+@c %end of fragment
+
+@c %start of fragment
+
+@deftp {Data Type} oci-network-configuration
+Available @code{oci-network-configuration} fields are:
+
+@table @asis
+@item @code{name} (type: string)
+The name of the OCI network to provision.
+
+@item @code{driver} (type: maybe-string)
+The driver to manage the network.
+
+@item @code{gateway} (type: maybe-string)
+IPv4 or IPv6 gateway for the subnet.
+
+@item @code{internal?} (default: @code{#f}) (type: boolean)
+Restrict external access to the network
+
+@item @code{ip-range} (type: maybe-string)
+Allocate container ip from a sub-range in CIDR format.
+
+@item @code{ipam-driver} (type: maybe-string)
+IP Address Management Driver.
+
+@item @code{ipv6?} (default: @code{#f}) (type: boolean)
+Enable IPv6 networking.
+
+@item @code{subnet} (type: maybe-string)
+Subnet in CIDR format that represents a network segment.
+
+@item @code{labels} (default: @code{'()}) (type: list)
+The list of labels that will be used to tag the current volume.
+
+@item @code{extra-arguments} (default: @code{'()}) (type: list)
+A list of strings, gexps or file-like objects that will be directly passed
+to the @samp{docker network create} or @samp{podman network create}
+invokation.
+
+@end table
+
+@end deftp
+
+
+@c %end of fragment
+
+@c %start of fragment
+
+@deftp {Data Type} oci-volume-configuration
+Available @code{oci-volume-configuration} fields are:
+
+@table @asis
+@item @code{name} (type: string)
+The name of the OCI volume to provision.
+
+@item @code{labels} (default: @code{'()}) (type: list)
+The list of labels that will be used to tag the current volume.
 
 @item @code{extra-arguments} (default: @code{'()}) (type: list)
-A list of strings, gexps or file-like objects that will be directly
-passed to the @command{docker run} invocation.
+A list of strings, gexps or file-like objects that will be directly passed
+to the @samp{docker volume create} or @samp{podman volume create}
+invokation.
 
 @end table
 
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 
+;;;
+;;; 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 .
+
+;;; 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))
diff --git a/gnu/local.mk b/gnu/local.mk
index da902d07df2..ec557633708 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -841,6 +841,7 @@ GNU_SYSTEM_MODULES =				\
   %D%/build/linux-initrd.scm			\
   %D%/build/linux-modules.scm			\
   %D%/build/marionette.scm			\
+  %D%/build/oci-containers.scm			\
   %D%/build/secret-service.scm			\
   %D%/build/utils.scm   			\
 						\
diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm
index 24f31c756b8..7c1164df2f8 100644
--- a/gnu/services/containers.scm
+++ b/gnu/services/containers.scm
@@ -35,12 +35,15 @@ (define-module (gnu services containers)
   #:use-module (guix diagnostics)
   #:use-module (guix gexp)
   #:use-module (guix i18n)
+  #:use-module (guix modules)
   #:use-module (guix monads)
   #:use-module (guix packages)
   #:use-module (guix profiles)
   #:use-module ((guix scripts pack) #:prefix pack:)
+  #:use-module (guix records)
   #:use-module (guix store)
   #:use-module (srfi srfi-1)
+  #:use-module (ice-9 format)
   #:use-module (ice-9 match)
   #:export (rootless-podman-configuration
             rootless-podman-configuration?
@@ -96,8 +99,82 @@ (define-module (gnu services containers)
             oci-container-configuration-workdir
             oci-container-configuration-extra-arguments
 
+            list-of-oci-containers?
+            list-of-oci-networks?
+            list-of-oci-volumes?
+
+            %oci-supported-runtimes
+            oci-runtime?
+            oci-runtime-system-environment
+            oci-runtime-system-extra-arguments
+            oci-runtime-system-requirement
+            oci-runtime-cli
+            oci-runtime-system-cli
+            oci-runtime-home-cli
+            oci-runtime-name
+            oci-runtime-group
+
+            oci-network-configuration
+            oci-network-configuration?
+            oci-network-configuration-fields
+            oci-network-configuration-name
+            oci-network-configuration-driver
+            oci-network-configuration-gateway
+            oci-network-configuration-internal?
+            oci-network-configuration-ip-range
+            oci-network-configuration-ipam-driver
+            oci-network-configuration-ipv6?
+            oci-network-configuration-subnet
+            oci-network-configuration-labels
+            oci-network-configuration-extra-arguments
+
+            oci-volume-configuration
+            oci-volume-configuration?
+            oci-volume-configuration-fields
+            oci-volume-configuration-name
+            oci-volume-configuration-labels
+            oci-volume-configuration-extra-arguments
+
+            oci-configuration
+            oci-configuration?
+            oci-configuration-fields
+            oci-configuration-runtime
+            oci-configuration-runtime-cli
+            oci-configuration-runtime-extra-arguments
+            oci-configuration-user
+            oci-configuration-group
+            oci-configuration-containers
+            oci-configuration-networks
+            oci-configuration-volumes
+            oci-configuration-verbose?
+            oci-configuration-valid?
+
+            oci-extension
+            oci-extension?
+            oci-extension-fields
+            oci-extension-containers
+            oci-extension-networks
+            oci-extension-volumes
+
+            oci-container-shepherd-name
+            oci-networks-shepherd-name
+            oci-networks-home-shepherd-name
+            oci-volumes-shepherd-name
+            oci-volumes-home-shepherd-name
+
+            oci-container-configuration->options
+            oci-network-configuration->options
+            oci-volume-configuration->options
+
             oci-container-shepherd-service
-            %oci-container-accounts))
+            oci-objects-merge-lst
+            oci-extension-merge
+            oci-service-type
+            oci-service-accounts
+            oci-service-profile
+            oci-service-subids
+            oci-configuration->shepherd-services
+            oci-configuration-extend))
 
 (define (gexp-or-string? value)
   (or (gexp? value)
@@ -296,9 +373,42 @@ (define rootless-podman-service-type
 
 
 ;;;
-;;; OCI container.
+;;; OCI provisioning service.
 ;;;
 
+(define %oci-supported-runtimes
+  '(docker podman))
+
+(define (oci-runtime-system-requirement runtime)
+  "Return a list of Shepherd service names required by a given OCI runtime,
+before it is able to run containers."
+  (if (eq? 'podman runtime)
+      '(cgroups2-fs-owner cgroups2-limits
+        rootless-podman-shared-root-fs user-processes)
+      '(dockerd user-processes)))
+
+(define (oci-runtime-name runtime)
+  "Return a human readable name for a given OCI runtime."
+  (if (eq? 'podman runtime)
+      "Podman" "Docker"))
+
+(define (oci-runtime-group runtime maybe-group)
+  "Implement the logic behind selection of the group that is to be used by
+Shepherd to execute OCI commands."
+  (if (maybe-value-set? maybe-group)
+      maybe-group
+      (if (eq? 'podman runtime)
+          "cgroup"
+          "docker")))
+
+(define (oci-runtime? value)
+  (unless (member value %oci-supported-runtimes)
+    (raise
+     (formatted-message
+      (G_ "OCI runtime must be a symbol and one of ~a,
+but ~a was found") %oci-supported-runtimes value)))
+  (symbol? value))
+
 (define (oci-sanitize-pair pair delimiter)
   (define (valid? member)
     (or (string? member)
@@ -332,21 +442,41 @@ (define (oci-sanitize-host-environment value)
   ;; '(("HOME" . "/home/nobody") "JAVA_HOME=/java")
   (oci-sanitize-mixed-list "host-environment" value "="))
 
+(define (oci-container-host-environment? value)
+  (list? (oci-sanitize-host-environment value)))
+
 (define (oci-sanitize-environment value)
   ;; Expected spec format:
   ;; '(("HOME" . "/home/nobody") "JAVA_HOME=/java")
   (oci-sanitize-mixed-list "environment" value "="))
 
+(define (oci-container-environment? value)
+  (list? (oci-sanitize-environment value)))
+
 (define (oci-sanitize-ports value)
   ;; Expected spec format:
   ;; '(("8088" . "80") "2022:22")
   (oci-sanitize-mixed-list "ports" value ":"))
 
+(define (oci-container-ports? value)
+  (list? (oci-sanitize-ports value)))
+
 (define (oci-sanitize-volumes value)
   ;; Expected spec format:
   ;; '(("/mnt/dir" . "/dir") "/run/current-system/profile:/java")
   (oci-sanitize-mixed-list "volumes" value ":"))
 
+(define (oci-container-volumes? value)
+  (list? (oci-sanitize-volumes value)))
+
+(define (oci-sanitize-labels value)
+  ;; Expected spec format:
+  ;; '(("foo" . "bar") "foo=bar")
+  (oci-sanitize-mixed-list "labels" value "="))
+
+(define (oci-object-labels? value)
+  (list? (oci-sanitize-labels value)))
+
 (define (oci-sanitize-shepherd-actions value)
   (map
    (lambda (el)
@@ -358,6 +488,9 @@ (define (oci-sanitize-shepherd-actions value)
 but ~a was found") el))))
    value))
 
+(define (oci-container-shepherd-actions? value)
+  (list? (oci-sanitize-shepherd-actions value)))
+
 (define (oci-sanitize-extra-arguments value)
   (define (valid? member)
     (or (string? member)
@@ -373,11 +506,19 @@ (define (oci-sanitize-extra-arguments value)
 but ~a was found") el))))
    value))
 
+(define (oci-object-extra-arguments? value)
+  (list? (oci-sanitize-extra-arguments value)))
+
 (define (oci-image-reference image)
-  (if (string? image)
-      image
-      (string-append (oci-image-repository image)
-                     ":" (oci-image-tag image))))
+  "Return a string OCI image reference representing IMAGE."
+  (define reference
+    (if (string? image)
+        image
+        (string-append (oci-image-repository image)
+                       ":" (oci-image-tag image))))
+  (if (> (length (string-split reference #\/)) 1)
+        reference
+        (string-append "localhost/" reference)))
 
 (define (oci-lowerable-image? image)
   (or (manifest? image)
@@ -392,7 +533,19 @@ (define (string-or-oci-image? image)
 (define list-of-symbols?
   (list-of symbol?))
 
+(define (list-of-oci-records? name predicate value)
+  (map
+   (lambda (el)
+     (if (predicate el)
+         el
+         (raise
+          (formatted-message
+           (G_ "~a contains an illegal value: ~a") name el))))
+   value))
+
 (define-maybe/no-serialization string)
+(define-maybe/no-serialization package)
+(define-maybe/no-serialization subid-range)
 
 (define-configuration/no-serialization oci-image
   (repository
@@ -437,11 +590,15 @@ (define-configuration/no-serialization oci-image
 
 (define-configuration/no-serialization oci-container-configuration
   (user
-   (string "oci-container")
-   "The user under whose authority docker commands will be run.")
+   (maybe-string)
+   "The user name under whose authority OCI commands will be run.  This field will
+override the @code{user} field of @code{oci-configuration}.")
   (group
-   (string "docker")
-   "The group under whose authority docker commands will be run.")
+   (maybe-string)
+   "The group name under whose authority OCI commands will be run.  When
+using the @code{'podman} OCI runtime, this field will be ignored and the
+default group of the user configured in the @code{user} field will be used.
+This field will override the @code{group} field of @code{oci-configuration}.")
   (command
    (list-of-strings '())
    "Overwrite the default command (@code{CMD}) of the image.")
@@ -449,11 +606,11 @@ (define-configuration/no-serialization oci-container-configuration
    (maybe-string)
    "Overwrite the default entrypoint (@code{ENTRYPOINT}) of the image.")
   (host-environment
-   (list '())
+   (oci-container-host-environment '())
    "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
+or @command{podman run} are invoked.  This is especially useful to pass secrets
+from the host to the container without having them on the OCI runtime command line,
+for example: by setting the @code{MYSQL_PASSWORD} on the host and by passing
 @code{--env MYSQL_PASSWORD} through the @code{extra-arguments} field, it is
 possible to securely set values in the container environment.  This field's
 value can be a list of pairs or strings, even mixed:
@@ -467,7 +624,7 @@ (define-configuration/no-serialization oci-container-configuration
 directly to @code{make-forkexec-constructor}."
    (sanitizer oci-sanitize-host-environment))
   (environment
-   (list '())
+   (oci-container-environment '())
    "Set environment variables inside the container.  This can be a list of pairs
 or strings, even mixed:
 
@@ -477,15 +634,16 @@ (define-configuration/no-serialization oci-container-configuration
 @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."
+directly to the OCI runtime CLI.  You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#env,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#env-e-env,Podman}
+upstream documentation for semantics."
    (sanitizer oci-sanitize-environment))
   (image
    (string-or-oci-image)
    "The image used to build the container.  It can be a string or an
-@code{oci-image} record.  Strings are resolved by the Docker
-Engine, and follow the usual format
+@code{oci-image} record.  Strings are resolved by the OCI runtime,
+and follow the usual format
 @code{myregistry.local:5000/testing/test-image:tag}.")
   (provision
    (maybe-string)
@@ -508,15 +666,15 @@ (define-configuration/no-serialization oci-container-configuration
    "Whether to restart the service when it stops, for instance when the
 underlying process dies.")
   (shepherd-actions
-   (list '())
+   (oci-container-shepherd-actions '())
    "This is a list of @code{shepherd-action} records defining actions supported
 by the service."
    (sanitizer oci-sanitize-shepherd-actions))
   (network
    (maybe-string)
-   "Set a Docker network for the spawned container.")
+   "Set an OCI network for the spawned container.")
   (ports
-   (list '())
+   (oci-container-ports '())
    "Set the port or port ranges to expose from the spawned container.  This can
 be a list of pairs or strings, even mixed:
 
@@ -526,12 +684,13 @@ (define-configuration/no-serialization oci-container-configuration
 @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."
+directly to the OCI runtime CLI.  You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#publish,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#publish-p-ip-hostport-containerport-protocol,Podman}
+upstream documentation for semantics."
    (sanitizer oci-sanitize-ports))
   (volumes
-   (list '())
+   (oci-container-volumes '())
    "Set volume mappings for the spawned container.  This can be a
 list of pairs or strings, even mixed:
 
@@ -541,71 +700,352 @@ (define-configuration/no-serialization oci-container-configuration
 @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."
+directly to the OCI runtime CLI.  You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#volume,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#volume-v-source-volume-host-dir-container-dir-options,Podman}
+upstream documentation for semantics."
    (sanitizer oci-sanitize-volumes))
   (container-user
    (maybe-string)
    "Set the current user inside the spawned container.  You can refer to the
-@url{https://docs.docker.com/engine/reference/run/#user,upstream}
-documentation for semantics.")
+@url{https://docs.docker.com/engine/reference/run/#user,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#user-u-user-group,Podman}
+upstream documentation for semantics.")
   (workdir
    (maybe-string)
-   "Set the current working for the spawned Shepherd service.
+   "Set the current working directory for the spawned Shepherd service.
 You can refer to the
-@url{https://docs.docker.com/engine/reference/run/#workdir,upstream}
-documentation for semantics.")
+@url{https://docs.docker.com/engine/reference/run/#workdir,Docker}
+or @url{https://docs.podman.io/en/stable/markdown/podman-run.1.html#workdir-w-dir,Podman}
+upstream documentation for semantics.")
   (extra-arguments
-   (list '())
+   (oci-object-extra-arguments '())
    "A list of strings, gexps or file-like objects that will be directly passed
-to the @command{docker run} invokation."
+to the @command{docker run} or @command{podman 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 (list-of-oci-containers? value)
+  (list-of-oci-records? "containers" oci-container-configuration? value))
+
+(define-configuration/no-serialization oci-volume-configuration
+  (name
+   (string)
+   "The name of the OCI volume to provision.")
+  (labels
+   (oci-object-labels '())
+   "The list of labels that will be used to tag the current volume."
+   (sanitizer oci-sanitize-labels))
+  (extra-arguments
+   (oci-object-extra-arguments '())
+   "A list of strings, gexps or file-like objects that will be directly passed
+to the @command{docker volume create} or @command{podman volume create}
+invocation."
+   (sanitizer oci-sanitize-extra-arguments)))
+
+(define (list-of-oci-volumes? value)
+  (list-of-oci-records? "volumes" oci-volume-configuration? value))
+
+(define-configuration/no-serialization oci-network-configuration
+  (name
+   (string)
+   "The name of the OCI network to provision.")
+  (driver
+   (maybe-string)
+   "The driver to manage the network.")
+  (gateway
+   (maybe-string)
+   "IPv4 or IPv6 gateway for the subnet.")
+  (internal?
+   (boolean #f)
+   "Restrict external access to the network")
+  (ip-range
+   (maybe-string)
+   "Allocate container ip from a sub-range in CIDR format.")
+  (ipam-driver
+   (maybe-string)
+   "IP Address Management Driver.")
+  (ipv6?
+   (boolean #f)
+   "Enable IPv6 networking.")
+  (subnet
+   (maybe-string)
+   "Subnet in CIDR format that represents a network segment.")
+  (labels
+   (oci-object-labels '())
+   "The list of labels that will be used to tag the current volume."
+   (sanitizer oci-sanitize-labels))
+  (extra-arguments
+   (oci-object-extra-arguments '())
+   "A list of strings, gexps or file-like objects that will be directly passed
+to the @command{docker network create} or @command{podman network create}
+invocation."
+   (sanitizer oci-sanitize-extra-arguments)))
+
+(define (list-of-oci-networks? value)
+  (list-of-oci-records? "networks" oci-network-configuration? value))
+
+(define (package-or-string? value)
+  (or (package? value) (string? value)))
+
+(define-maybe/no-serialization package-or-string)
+
+(define-configuration/no-serialization oci-configuration
+  (runtime
+   (oci-runtime 'docker)
+   "The OCI runtime to use to run commands.  It can be either @code{'docker} or
+@code{'podman}.")
+  (runtime-cli
+   (maybe-package-or-string)
+   "The OCI runtime command line to be installed in the system profile and used
+to provision OCI resources, it can be either a package or a string representing
+an absolute file name to the runtime binary entrypoint.  When unset it will default
+to @code{docker-cli} package for the @code{'docker} runtime or to @code{podman}
+package for the @code{'podman} runtime.")
+  (runtime-extra-arguments
+   (list '())
+   "A list of strings, gexps or file-like objects that will be placed
+after each @command{docker} or @command{podman} invokation.")
+  (user
+   (string "oci-container")
+   "The user name under whose authority OCI runtime commands will be run.")
+  (group
+   (maybe-string)
+   "The group name under whose authority OCI commands will be run.  When
+using the @code{'podman} OCI runtime, this field will be ignored and the
+default group of the user configured in the @code{user} field will be used.")
+  (subuids-range
+   (maybe-subid-range)
+   "An optional @code{subid-range} record allocating subuids for the user from
+the @code{user} field.  When unset, with the rootless Podman OCI runtime, it
+defaults to @code{(subid-range (name \"oci-container\"))}.")
+  (subgids-range
+   (maybe-subid-range)
+   "An optional @code{subid-range} record allocating subgids for the user from
+the @code{user} field.  When unset, with the rootless Podman OCI runtime, it
+defaults to @code{(subid-range (name \"oci-container\"))}.")
+  (containers
+   (list-of-oci-containers '())
+   "The list of @code{oci-container-configuration} records representing the
+containers to provision.  The use of the @code{oci-extension} record should
+be preferred for most cases.")
+  (networks
+   (list-of-oci-networks '())
+   "The list of @code{oci-network-configuration} records representing the
+networks to provision.  The use of the @code{oci-extension} record should
+be preferred for most cases.")
+  (volumes
+   (list-of-oci-volumes '())
+   "The list of @code{oci-volume-configuration} records representing the
+volumes to provision.  The use of the @code{oci-extension} record should
+be preferred for most cases.")
+  (verbose?
+   (boolean #f)
+   "When true, additional output will be printed, allowing to better follow the
+flow of execution.")
+  (home-service?
+   (boolean for-home?)
+   "This is an internal field denoting whether this configuration is used in a
+Guix Home context, as opposed to the default Guix System context."))
+
+(define (oci-runtime-system-environment runtime user)
+  (if (eq? runtime 'podman)
+      (list
+       #~(string-append
+          "HOME=" (passwd:dir (getpwnam #$user))))
+      #~()))
+
+(define (oci-runtime-cli runtime runtime-cli profile-directory)
+  "Return a gexp that, when lowered, evaluates to the  of the OCI
+runtime command requested by the user."
+  (if (string? runtime-cli)
+      ;; It is a user defined absolute file name.
+      runtime-cli
+      #~(string-append
+         #$(if (maybe-value-set? runtime-cli)
+               runtime-cli
+               profile-directory)
+         #$(if (eq? 'podman runtime)
+               "/bin/podman"
+               "/bin/docker"))))
+
+(define* (oci-runtime-system-cli config #:key (profile-directory "/run/current-system/profile"))
+  (let ((runtime-cli
+         (oci-configuration-runtime-cli config))
+        (runtime
+         (oci-configuration-runtime config)))
+    (oci-runtime-cli runtime runtime-cli profile-directory)))
+
+(define (oci-runtime-home-cli config)
+  (let ((runtime-cli
+         (oci-configuration-runtime-cli config))
+        (runtime
+         (oci-configuration-runtime config)))
+    (oci-runtime-cli runtime runtime-cli
+                     (string-append (getenv "HOME")
+                                    "/.guix-home/profile"))))
+
+(define-configuration/no-serialization oci-extension
+  (containers
+   (list-of-oci-containers '())
+   "The list of @code{oci-container-configuration} records representing the
+containers to add.")
+  (networks
+   (list-of-oci-networks '())
+   "The list of @code{oci-network-configuration} records representing the
+networks to add.")
+  (volumes
+   (list-of-oci-volumes '())
+   "The list of @code{oci-volume-configuration} records representing the
+volumes to add."))
+
+(define (oci-image->container-name image)
+  "Infer the name of an OCI backed Shepherd service from its OCI image."
+  (basename
+   (if (string? image)
+       (first (string-split image #\:))
+       (oci-image-repository image))))
+
+(define (oci-command-line-shepherd-action object-name invocation entrypoint)
+  "Return a Shepherd action printing a given INVOCATION of an OCI command for the
+given OBJECT-NAME."
+  (shepherd-action
+   (name 'command-line)
+   (documentation
+    (format #f "Prints ~a's OCI runtime command line invocation."
+            object-name))
+   (procedure
+    #~(lambda _
+        (format #t "Entrypoint:~%~a~%" #$entrypoint)
+        (format #t "Invocation:~%~a~%" #$invocation)))))
+
+(define (oci-container-shepherd-name runtime config)
+  "Return the name of an OCI backed Shepherd service based on CONFIG.
+The name configured in the configuration record is returned when
+CONFIG's name field has a value, otherwise a name is inferred from CONFIG's
+image field."
+  (define name (oci-container-configuration-provision config))
+  (define image (oci-container-configuration-image config))
+
+  (if (maybe-value-set? name)
+      name
+      (string-append (symbol->string runtime) "-"
+                     (oci-image->container-name image))))
+
+(define (oci-networks-shepherd-name runtime)
+  "Return the name of the OCI networks provisioning Shepherd service based on
+RUNTIME."
+  (string-append (symbol->string runtime) "-networks"))
+
+(define (oci-volumes-shepherd-name runtime)
+  "Return the name of the OCI volumes provisioning Shepherd service based on
+RUNTIME."
+  (string-append (symbol->string runtime) "-volumes"))
+
+(define (oci-networks-home-shepherd-name runtime)
+  "Return the name of the OCI volumes provisioning Home Shepherd service based on
+RUNTIME."
+  (string-append "home-" (oci-networks-shepherd-name runtime)))
+
+(define (oci-volumes-home-shepherd-name runtime)
+  "Return the name of the OCI volumes provisioning Home Shepherd service based on
+RUNTIME."
+  (string-append "home-" (oci-volumes-shepherd-name runtime)))
+
+(define (oci-container-configuration->options config)
+  "Map CONFIG, an oci-container-configuration record, to a gexp that, upon
+lowering, will be evaluated to a list of strings containing command line options
+for the OCI runtime run command."
+  (let ((entrypoint
+         (oci-container-configuration-entrypoint config))
+        (network
+         (oci-container-configuration-network config))
+        (user
+         (oci-container-configuration-container-user config))
+        (workdir
+         (oci-container-configuration-workdir config)))
+    (apply append
+           (filter (compose not unspecified?)
+                   `(,(if (maybe-value-set? entrypoint)
+                          `("--entrypoint" ,entrypoint)
+                          '())
+                     ,(append-map
+                       (lambda (spec)
+                         (list "--env" spec))
+                       (oci-container-configuration-environment config))
+                     ,(if (maybe-value-set? network)
+                          `("--network" ,network)
+                          '())
+                     ,(if (maybe-value-set? user)
+                          `("--user" ,user)
+                          '())
+                     ,(if (maybe-value-set? workdir)
+                          `("--workdir" ,workdir)
+                          '())
+                     ,(append-map
+                       (lambda (spec)
+                         (list "-p" spec))
+                       (oci-container-configuration-ports config))
+                     ,(append-map
+                       (lambda (spec)
+                         (list "-v" spec))
+                       (oci-container-configuration-volumes config)))))))
+
+(define (oci-network-configuration->options config)
+  "Map CONFIG, an oci-network-configuration record, to a gexp that, upon
+lowering, will be evaluated to a list of strings containing command line options
+for the OCI runtime network create command."
+  (let ((driver (oci-network-configuration-driver config))
+        (gateway
+         (oci-network-configuration-gateway config))
+        (internal?
+         (oci-network-configuration-internal? config))
+        (ip-range
+         (oci-network-configuration-ip-range config))
+        (ipam-driver
+         (oci-network-configuration-ipam-driver config))
+        (ipv6?
+         (oci-network-configuration-ipv6? config))
+        (subnet
+         (oci-network-configuration-subnet config)))
+    (apply append
+           (filter (compose not unspecified?)
+                   `(,(if (maybe-value-set? driver)
+                          `("--driver" ,driver)
+                          '())
+                     ,(if (maybe-value-set? gateway)
+                          `("--gateway" ,gateway)
+                          '())
+                     ,(if internal?
+                          `("--internal")
+                          '())
+                     ,(if (maybe-value-set? ip-range)
+                          `("--ip-range" ,ip-range)
+                          '())
+                     ,(if (maybe-value-set? ipam-driver)
+                          `("--ipam-driver" ,ipam-driver)
+                          '())
+                     ,(if ipv6?
+                          `("--ipv6")
+                          '())
+                     ,(if (maybe-value-set? subnet)
+                          `("--subnet" ,subnet)
+                          '())
+                     ,(append-map
+                       (lambda (spec)
+                         (list "--label" spec))
+                       (oci-network-configuration-labels config)))))))
+
+(define (oci-volume-configuration->options config)
+  "Map CONFIG, an oci-volume-configuration record, to a gexp that, upon
+lowering, will be evaluated to a list of strings containing command line options
+for the OCI runtime volume create command."
+  (append-map
+   (lambda (spec)
+     (list "--label" spec))
+   (oci-volume-configuration-labels config)))
 
 (define (lower-operating-system os target system)
+  "Lower OS, an operating-system record, into a tarball containing an OCI image."
   (mlet* %store-monad
       ((tarball
         (lower-object
@@ -614,24 +1054,11 @@ (define (lower-operating-system os target 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)))))
-
+(define (lower-manifest name value options image-reference
+                        target system grafts?)
+  "Lower VALUE, a manifest record, into a tarball containing an OCI image."
   (mlet* %store-monad
-      ((_ (set-grafting
-           (oci-image-grafts? image)))
+      ((_ (set-grafting grafts?))
        (guile (set-guile-for-build (default-guile)))
        (profile
         (profile-derivation value
@@ -642,14 +1069,11 @@ (define (lower-manifest name image target system)
        (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 (lower-oci-image-state name value options reference
+                               image-target image-system grafts?)
   (define target
     (if (maybe-value-set? image-target)
         image-target
@@ -662,7 +1086,8 @@ (define (lower-oci-image name image)
    (run-with-store store
      (match value
        ((? manifest? value)
-        (lower-manifest name image target system))
+        (lower-manifest name value options reference
+                        target system grafts?))
        ((? operating-system? value)
         (lower-operating-system value target system))
        ((or (? gexp? value)
@@ -677,113 +1102,661 @@ (define (lower-oci-image name image)
      #: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)
+(define (lower-oci-image name image)
+  "Lower IMAGE, a oci-image record, into a tarball containing an OCI image."
+  (lower-oci-image-state
+   name
+   (oci-image-value image)
+   (oci-image-pack-options image)
+   (oci-image-reference image)
+   (oci-image-target image)
+   (oci-image-system image)
+   (oci-image-grafts? image)))
+
+(define-record-type* 
+  oci-runtime-state
+  make-oci-runtime-state
+  oci-runtime-state?
+  this-oci-runtime-state
+
+  (runtime                  oci-runtime-state-runtime
+                            (default 'docker))
+  (runtime-cli              oci-runtime-state-runtime-cli)
+  (user                     oci-runtime-state-user)
+  (group                    oci-runtime-state-group)
+  (runtime-environment      oci-runtime-state-runtime-environment
+                            (default #~()))
+  (runtime-requirement      oci-runtime-state-runtime-requirement
+                            (default '()))
+  (runtime-extra-arguments  oci-runtime-state-runtime-extra-arguments
+                            (default '())))
+
+(define-record-type* 
+  oci-state
+  make-oci-state
+  oci-state?
+  this-oci-state
+
+  (networks                 oci-state-networks)
+  (volumes                  oci-state-volumes)
+  (containers               oci-state-containers)
+  (networks-name            oci-state-networks-name
+                            (default #f))
+  (volumes-name             oci-state-volumes-name
+                            (default #f))
+  (networks-requirement     oci-state-networks-requirement
+                            (default '()))
+  (volumes-requirement      oci-state-volumes-requirement
+                            (default '()))
+  (containers-requirement   oci-state-containers-requirement
+                            (default '())))
+
+(define-record-type* 
+  oci-container-invocation
+  make-oci-container-invocation
+  oci-container-invocation?
+  this-oci-container-invocation
+
+  (runtime                  oci-container-invocation-runtime
+                            (default 'docker))
+  (runtime-cli              oci-container-invocation-runtime-cli)
+  (name                     oci-container-invocation-name)
+  (command                  oci-container-invocation-command
+                            (default '()))
+  (image-reference          oci-container-invocation-image-reference)
+  (options                  oci-container-invocation-options
+                            (default '()))
+  (run-extra-arguments      oci-container-invocation-run-extra-arguments
+                            (default '()))
+  (runtime-extra-arguments  oci-container-invocation-runtime-extra-arguments
+                            (default '())))
+
+(define (oci-container-configuration->oci-container-invocation runtime-state
+                                                               config)
+  (oci-container-invocation
+   (runtime (oci-runtime-state-runtime runtime-state))
+   (runtime-cli (oci-runtime-state-runtime-cli runtime-state))
+   (name
+    (oci-container-shepherd-name runtime config))
+   (command
+    (oci-container-configuration-command config))
+   (image-reference
+    (oci-image-reference (oci-container-configuration-image config)))
+   (options
+    (oci-container-configuration->options config))
+   (run-extra-arguments
+    (oci-container-configuration-extra-arguments config))
+   (runtime-extra-arguments
+    (oci-runtime-state-runtime-extra-arguments runtime-state))))
+
+(define* (oci-image-loader runtime-state name image tag #:key verbose?)
+  "Return a file-like object that, once lowered, will evaluate to a program able
+to load IMAGE through RUNTIME-CLI and to tag it with TAG afterwards."
+  (let ((tarball (lower-oci-image name image)))
+    (with-imported-modules (source-module-closure '((gnu build oci-containers)))
+      (program-file
+       (format #f "~a-image-loader" name)
        #~(begin
-           (use-modules (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))
+           (use-modules (gnu build oci-containers))
+           (oci-image-load '#$(oci-runtime-state-runtime runtime-state)
+                           #$(oci-runtime-state-runtime-cli runtime-state)
+                           #$tarball #$name #$tag
+                           #:verbose? #$verbose?))))))
+
+(define (oci-container-run-invocation container-invocation)
+  "Return a list representing the OCI runtime
+invocation for running containers."
+  ;; run [OPTIONS] IMAGE [COMMAND] [ARG...]
+  `(,(oci-container-invocation-runtime-cli container-invocation)
+    ,@(oci-container-invocation-runtime-extra-arguments container-invocation)
+    "run" "--rm"
+    ,@(if (eq? (oci-container-invocation-runtime container-invocation)
+               'podman)
+          ;; This is because podman takes some time to
+          ;; release container names.  --replace seems
+          ;; to be required to be able to restart services.
+          '("--replace")
+          '())
+    "--name" ,(oci-container-invocation-name container-invocation)
+    ,@(oci-container-invocation-options container-invocation)
+    ,@(oci-container-invocation-run-extra-arguments container-invocation)
+    ,(oci-container-invocation-image-reference container-invocation)
+    ,@(oci-container-invocation-command container-invocation)))
+
+(define* (oci-container-entrypoint name invocation
+                                   #:key verbose?
+                                   (pre-script #~()))
+  "Return a file-like object that, once lowered, will evaluate to the entrypoint
+for the Shepherd service that will run INVOCATION."
+  (program-file
+   (string-append "oci-entrypoint-" name)
+   (with-imported-modules (source-module-closure
+                           '((gnu build oci-containers)))
+     #~(begin
+         (use-modules (gnu build oci-containers)
+                      (srfi srfi-1))
+         (oci-container-execlp
+          (list #$@invocation)
+          #:verbose? #$verbose?
+          #:pre-script
+          (lambda _
+            (when (and #$verbose?
+                       (zero? (length '(#$@pre-script))))
+              (format #t "No pre script to run..."))
+            #$@pre-script))))))
+
+(define* (oci-container-shepherd-service state runtime-state config
+                                         #:key verbose?
+                                         networks?
+                                         volumes?)
+  "Return a Shepherd service object that will run the OCI container represented
+by CONFIG through RUNTIME-CLI."
+  (match-record config 
+                (shepherd-actions auto-start? user group host-environment
+                 log-file requirement respawn? image)
+    (define runtime (oci-runtime-state-runtime runtime-state))
+    (define runtime-cli (oci-runtime-state-runtime-cli runtime-state))
+    (define image-reference (oci-image-reference image))
+    (define shepherd-name (oci-container-shepherd-name runtime config))
+    (define oci-container-user
+      (if (maybe-value-set? user)
+          user
+          (oci-runtime-state-user runtime-state)))
+    (define oci-container-group
+      (if (maybe-value-set? group)
+          group
+          (oci-runtime-state-group runtime-state)))
+    (define networks-service
+      (if networks?
+          (list
+           (string->symbol
+            (oci-state-networks-name state)))
+          '()))
+    (define volumes-service
+     (if volumes?
+         (list
+          (string->symbol
+           (oci-state-volumes-name state)))
+         '()))
+    (define oci-container-requirement
+      (append requirement
+              (oci-state-containers-requirement state)
+              (oci-runtime-state-runtime-requirement runtime-state)
+              networks-service
+              volumes-service))
+    (define environment-variables
+      #~(append
+         (list #$@host-environment)
+         (list #$@(oci-runtime-state-runtime-environment runtime-state))))
+    (define invocation
+      (oci-container-run-invocation
+       (oci-container-configuration->oci-container-invocation
+        runtime-state config)))
+    (define* (container-action command)
+      #~(lambda _
+          (fork+exec-command
+           (list #$@command)
+           #$@(if oci-container-user
+                  (list #:user oci-container-user)
+                  '())
+           #$@(if oci-container-group
+                  (list #:group oci-container-group)
+                  '())
+           #$@(if (maybe-value-set? log-file)
+                  (list #:log-file log-file)
+                  '())
+           #$@(if (and oci-container-user (eq? runtime 'podman))
+                  (list #:directory
+                        #~(passwd:dir
+                           (getpwnam #$oci-container-user)))
+                  '())
+           #:environment-variables
+           #$environment-variables)))
+    (define start-entrypoint
+      (oci-container-entrypoint
+       shepherd-name invocation
+       #:verbose? verbose?
+       #:pre-script
+       (if (oci-image? image)
+           #~((system*
+               #$(oci-image-loader
+                  runtime-state shepherd-name image
+                  image-reference
+                  #:verbose? verbose?)))
+           #~())))
+
+    (shepherd-service (provision `(,(string->symbol shepherd-name)))
+                      (requirement oci-container-requirement)
                       (respawn? respawn?)
                       (auto-start? auto-start?)
                       (documentation
                        (string-append
-                        "Docker backed Shepherd service for "
-                        (if (oci-image? image) name image) "."))
+                        (oci-runtime-name runtime)
+                        " backed Shepherd service for "
+                        (if (oci-image? image) shepherd-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))))
+                       (container-action
+                        (list start-entrypoint)))
                       (stop
-                       #~(lambda _
-                           (invoke #$docker "rm" "-f" #$name)))
+                       (container-action
+                        (list
+                         (oci-container-entrypoint
+                          shepherd-name (list runtime-cli "rm" "-f" shepherd-name)
+                          #:verbose? verbose?))))
                       (actions
-                       (if (oci-image? image)
-                           '()
-                           (append
+                       (append
+                        (list
+                         (oci-command-line-shepherd-action
+                          shepherd-name #~(string-join (list #$@invocation) " ")
+                          start-entrypoint))
+                        (if (oci-image? image)
+                            '()
                             (list
                              (shepherd-action
                               (name 'pull)
                               (documentation
                                (format #f "Pull ~a's image (~a)."
-                                       name image))
+                                       shepherd-name image))
                               (procedure
-                               #~(lambda _
-                                   (invoke #$docker "pull" #$image)))))
-                            actions))))))
-
-(define %oci-container-accounts
+                               (container-action
+                                (list
+                                 (oci-container-entrypoint
+                                  shepherd-name (list runtime-cli "pull" image)
+                                  #:verbose? verbose?)))))))
+                        shepherd-actions)))))
+
+(define (oci-object-create-invocation object runtime-cli name options
+                                      runtime-extra-arguments
+                                      create-extra-arguments)
+  "Return a gexp that, upon lowering, will evaluate to the OCI runtime
+invocation for creating networks and volumes."
+  ;; network|volume create [options] [NAME]
+  #~(list #$runtime-cli #$@runtime-extra-arguments #$object "create"
+          #$@options #$@create-extra-arguments #$name))
+
+(define (format-oci-invocations invocations)
+  "Return a gexp that, upon lowering, will evaluate to a formatted message
+containing the INVOCATIONS that the OCI runtime will execute to provision
+networks or volumes."
+  #~(string-join (map (lambda (i) (string-join i " "))
+                      (list #$@invocations))
+                 "\n"))
+
+(define* (oci-object-create-script object runtime runtime-cli invocations
+                                   #:key verbose?)
+  "Return a file-like object that, once lowered, will evaluate to a program able
+to create OCI networks and volumes through RUNTIME-CLI."
+  (define runtime-string (symbol->string runtime))
+  (define runtime-name (oci-runtime-name runtime))
+  (with-imported-modules (source-module-closure
+                          '((gnu build oci-containers)))
+
+    (program-file
+     (string-append runtime-string "-" object "s-create.scm")
+     #~(begin
+         (use-modules (gnu build oci-containers))
+         (oci-object-create '#$runtime #$runtime-cli #$runtime-name
+                            #$object (list #$@invocations)
+                            #:verbose? #$verbose?)))))
+
+(define* (oci-object-shepherd-service object runtime-state name
+                                      oci-state-requirement invocations
+                                      #:key verbose?)
+  "Return a Shepherd service object that will provision the OBJECTs represented
+by INVOCATIONS through RUNTIME-STATE."
+  (match-record runtime-state 
+                (runtime runtime-cli runtime-requirement user group
+                 runtime-environment)
+    (define entrypoint
+      (oci-object-create-script
+       object runtime runtime-cli invocations #:verbose? verbose?))
+    (define requirement
+      (append runtime-requirement oci-state-requirement))
+
+    (shepherd-service (provision (list (string->symbol name)))
+                      (requirement requirement)
+                      (one-shot? #t)
+                      (documentation
+                       (string-append
+                        (oci-runtime-name runtime) " " object
+                        " provisioning service"))
+                      (start
+                       #~(lambda _
+                           (fork+exec-command
+                            (list #$entrypoint)
+                            #$@(if user (list #:user user) '())
+                            #$@(if group (list #:group group) '())
+                            #:environment-variables
+                            (list #$@runtime-environment))))
+                      (actions
+                       (list
+                        (oci-command-line-shepherd-action
+                         name (format-oci-invocations invocations)
+                         entrypoint))))))
+
+(define* (oci-networks-shepherd-service state runtime-state
+                                        #:key verbose?)
+  "Return a Shepherd service object that will create the networks represented
+in STATE."
+  (define runtime-cli
+    (oci-runtime-state-runtime-cli runtime-state))
+  (define invocations
+    (map
+     (lambda (network)
+       (oci-object-create-invocation
+        "network" runtime-cli
+        (oci-network-configuration-name network)
+        (oci-network-configuration->options network)
+        (oci-runtime-state-runtime-extra-arguments runtime-state)
+        (oci-network-configuration-extra-arguments network)))
+     (oci-state-networks state)))
+
+  (oci-object-shepherd-service
+   "network" runtime-state (oci-state-networks-name state)
+   (oci-state-networks-requirement state)
+   invocations #:verbose? verbose?))
+
+(define* (oci-volumes-shepherd-service state runtime-state
+                                       #:key verbose?)
+  "Return a Shepherd service object that will create the volumes represented
+in STATE."
+  (define runtime-cli
+    (oci-runtime-state-runtime-cli runtime-state))
+  (define invocations
+    (map
+     (lambda (volume)
+       (oci-object-create-invocation
+        "volume" runtime-cli
+        (oci-volume-configuration-name volume)
+        (oci-volume-configuration->options volume)
+        (oci-runtime-state-runtime-extra-arguments runtime-state)
+        (oci-volume-configuration-extra-arguments volume)))
+     (oci-state-volumes state)))
+
+  (oci-object-shepherd-service
+   "volume" runtime-state (oci-state-volumes-name state)
+   (oci-state-volumes-requirement state)
+   invocations #:verbose? verbose?))
+
+(define (oci-service-accounts config)
+  (define user (oci-configuration-user config))
+  (define maybe-group (oci-configuration-group config))
+  (define runtime (oci-configuration-runtime config))
   (list (user-account
-         (name "oci-container")
+         (name user)
          (comment "OCI services account")
-         (group "docker")
-         (system? #t)
-         (home-directory "/var/empty")
+         (group "users")
+         (supplementary-groups
+          (list (oci-runtime-group runtime maybe-group)))
+         (system? (eq? 'docker runtime))
+         (home-directory (if (eq? 'podman runtime)
+                             (string-append "/home/" user)
+                             "/var/empty"))
+         (create-home-directory? (eq? 'podman runtime))
          (shell (file-append shadow "/sbin/nologin")))))
+
+(define* (oci-state->shepherd-services state runtime-state #:key verbose?)
+  "Returns a list of Shepherd services based on the input OCI state."
+  (define networks?
+    (> (length (oci-state-networks state)) 0))
+  (define volumes?
+    (> (length (oci-state-volumes state)) 0))
+  (append
+   (map
+    (lambda (c)
+      (oci-container-shepherd-service
+       state runtime-state c
+       #:verbose? verbose?
+       #:volumes? volumes?
+       #:networks? networks?))
+    (oci-state-containers state))
+   (if networks?
+       (list
+        (oci-networks-shepherd-service
+         state runtime-state
+         #:verbose? verbose?))
+       '())
+   (if volumes?
+       (list
+        (oci-volumes-shepherd-service
+         state runtime-state
+         #:verbose? verbose?))
+       '())))
+
+(define* (oci-configuration->oci-runtime-state config #:key verbose?)
+  (define runtime
+    (oci-configuration-runtime config))
+  (define home-service?
+    (oci-configuration-home-service? config))
+  (define runtime-cli
+    (if home-service?
+        (oci-runtime-home-cli config)
+        (oci-runtime-system-cli config)))
+  (define user
+    (if home-service?
+        #f
+        (oci-configuration-user config)))
+  (define group
+    (if home-service?
+        #f
+        (if (eq? runtime 'podman)
+            #~(group:name
+               (getgrgid
+                (passwd:gid
+                 (getpwnam #$user))))
+            (oci-runtime-group config (oci-configuration-group config)))))
+  (define runtime-requirement
+    (if home-service?
+        '()
+        (oci-runtime-system-requirement runtime)))
+  (define runtime-environment
+    (if home-service?
+        #~()
+        (oci-runtime-system-environment runtime user)))
+  (oci-runtime-state
+   (runtime runtime)
+   (runtime-cli runtime-cli)
+   (user user)
+   (group group)
+   (runtime-extra-arguments
+    (oci-configuration-runtime-extra-arguments config))
+   (runtime-environment runtime-environment)
+   (runtime-requirement runtime-requirement)))
+
+(define (oci-configuration->oci-state config)
+  (define runtime
+    (oci-configuration-runtime config))
+  (define home-service?
+    (oci-configuration-home-service? config))
+  (define networks-name
+    (if home-service?
+        (oci-networks-home-shepherd-name runtime)
+        (oci-networks-shepherd-name runtime)))
+  (define volumes-name
+    (if home-service?
+        (oci-volumes-home-shepherd-name runtime)
+        (oci-volumes-shepherd-name runtime)))
+  (define networks-requirement
+    (if home-service?
+        '()
+        '(networking)))
+  (oci-state
+   (containers (oci-configuration-containers config))
+   (networks (oci-configuration-networks config))
+   (volumes (oci-configuration-volumes config))
+   (networks-name networks-name)
+   (volumes-name volumes-name)
+   (networks-requirement networks-requirement)))
+
+(define (oci-configuration->shepherd-services config)
+  (let* ((verbose? (oci-configuration-verbose? config))
+         (state (oci-configuration->oci-state config))
+         (runtime-state
+          (oci-configuration->oci-runtime-state config #:verbose? verbose?)))
+    (oci-state->shepherd-services state runtime-state #:verbose? verbose?)))
+
+(define (oci-service-subids config)
+  "Return a subids-extension record representing subuids and subgids required by
+the rootless Podman backend."
+  (define (find-duplicates subids)
+    (let loop ((names '())
+               (subids subids))
+      (if (null? names)
+          names
+          (loop
+           (let ((name (subid-range-name (car subids))))
+             (if (member name names)
+                 (raise
+                  (formatted-message
+                   (G_ "Duplicated subid-range: ~a. subid-ranges names should be
+unique, please remove the duplicate.") name))
+                 (cons name names)))
+           (cdr subids)))))
+
+  (define runtime
+    (oci-configuration-runtime config))
+  (define user
+    (oci-configuration-user config))
+
+  (define subgids (oci-configuration-subgids-range config))
+  (find-duplicates subgids)
+
+  (define subuids (oci-configuration-subuids-range config))
+  (find-duplicates subgids)
+
+  (define container-users
+    (filter (lambda (range)
+              (and (maybe-value-set?
+                    (subid-range-name range))
+                   (not (string=? (subid-range-name range) user))))
+            (map (lambda (container)
+                   (subid-range
+                    (name
+                     (oci-container-configuration-user container))))
+                 (oci-configuration-containers config))))
+  (define subgid-ranges
+    (cons
+     (if (maybe-value-set? subgids)
+         subgids
+         (subid-range (name user)))
+     container-users))
+  (define subuid-ranges
+    (cons
+     (if (maybe-value-set? subuids)
+         subuids
+         (subid-range (name user)))
+     container-users))
+
+  (if (eq? 'podman runtime)
+      (subids-extension
+       (subgids
+        subgid-ranges)
+       (subuids
+        subuid-ranges))
+      (subids-extension)))
+
+(define (oci-objects-merge-lst a b object get-name)
+  (define (contains? value lst)
+    (member value (map get-name lst)))
+  (let loop ((merged '())
+             (lst (append a b)))
+    (if (null? lst)
+        merged
+        (loop
+         (let ((element (car lst)))
+           (when (contains? element merged)
+             (raise
+              (formatted-message
+               (G_ "Duplicated ~a: ~a. Names of ~a should be unique, please
+remove the duplicate.") object (get-name element) object)))
+           (cons element merged))
+         (cdr lst)))))
+
+(define (oci-extension-merge a b)
+  (oci-extension
+   (containers (oci-objects-merge-lst
+                (oci-extension-containers a)
+                (oci-extension-containers b)
+                "container"
+                (lambda (config)
+                  (define maybe-name
+                    (oci-container-configuration-provision config))
+                  (if (maybe-value-set? maybe-name)
+                      maybe-name
+                      (oci-image->container-name
+                       (oci-container-configuration-image config))))))
+   (networks (oci-objects-merge-lst
+              (oci-extension-networks a)
+              (oci-extension-networks b)
+              "network"
+              oci-network-configuration-name))
+   (volumes (oci-objects-merge-lst
+             (oci-extension-volumes a)
+             (oci-extension-volumes b)
+             "volume"
+             oci-volume-configuration-name))))
+
+(define (oci-service-profile runtime runtime-cli)
+  `(,bash-minimal
+    ,@(if (string? runtime-cli)
+          '()
+          (list
+           (cond
+            ((maybe-value-set? runtime-cli)
+             runtime-cli)
+            ((eq? 'podman runtime)
+             podman)
+            (else
+             docker-cli))))))
+
+(define (oci-configuration-extend config extension)
+  (oci-configuration
+   (inherit config)
+   (containers
+    (oci-objects-merge-lst
+     (oci-configuration-containers config)
+     (oci-extension-containers extension)
+     "container"
+     (lambda (oci-config)
+       (define runtime
+         (oci-configuration-runtime config))
+       (oci-container-shepherd-name runtime oci-config))))
+   (networks (oci-objects-merge-lst
+              (oci-configuration-networks config)
+              (oci-extension-networks extension)
+              "network"
+              oci-network-configuration-name))
+   (volumes (oci-objects-merge-lst
+             (oci-configuration-volumes config)
+             (oci-extension-volumes extension)
+             "volume"
+             oci-volume-configuration-name))))
+
+(define oci-service-type
+  (service-type
+   (name 'oci)
+   (extensions
+    (list
+     (service-extension profile-service-type
+                        (lambda (config)
+                          (let ((runtime-cli
+                                 (oci-configuration-runtime-cli config))
+                                (runtime
+                                 (oci-configuration-runtime config)))
+                            (oci-service-profile runtime runtime-cli))))
+     (service-extension subids-service-type
+                        oci-service-subids)
+     (service-extension account-service-type
+                        oci-service-accounts)
+     (service-extension shepherd-root-service-type
+                        oci-configuration->shepherd-services)))
+   ;; Concatenate OCI object lists.
+   (compose (lambda (args)
+              (fold oci-extension-merge
+                    (oci-extension)
+                    args)))
+   (extend oci-configuration-extend)
+   (default-value (oci-configuration))
+   (description
+    "This service implements the provisioning of OCI objects such
+as containers, networks and volumes.")))
diff --git a/gnu/services/docker.scm b/gnu/services/docker.scm
index 828ceea313a..6abfbc49a0b 100644
--- a/gnu/services/docker.scm
+++ b/gnu/services/docker.scm
@@ -31,7 +31,10 @@ (define-module (gnu services docker)
   #:use-module (gnu system shadow)
   #:use-module (gnu packages docker)
   #:use-module (gnu packages linux)               ;singularity
+  #:use-module (guix deprecation)
+  #:use-module (guix diagnostics)
   #:use-module (guix gexp)
+  #:use-module (guix i18n)
   #:use-module (guix records)
   #:use-module (srfi srfi-1)
   #:use-module (ice-9 format)
@@ -67,16 +70,18 @@ (define-module (gnu services docker)
                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)
+               oci-container-configuration-extra-arguments)
 
   #:export (containerd-configuration
             containerd-service-type
             docker-configuration
             docker-service-type
             singularity-service-type
-            oci-container-service-type))
+            ;; For backwards compatibility, until the
+            ;; oci-container-service-type is fully deprecated.
+            oci-container-shepherd-service
+            oci-container-service-type
+            %oci-container-accounts))
 
 (define-maybe file-like)
 
@@ -297,17 +302,26 @@ (define singularity-service-type
 ;;; OCI container.
 ;;;
 
-(define (configs->shepherd-services configs)
-  (map oci-container-shepherd-service configs))
+;; For backwards compatibility, until the
+;; oci-container-service-type is fully deprecated.
+(define-deprecated (oci-container-shepherd-service config)
+  oci-service-type
+  ((@ (gnu services containers) oci-container-shepherd-service)
+   'docker config))
+(define %oci-container-accounts
+  (filter user-account? (oci-service-accounts (oci-configuration))))
 
 (define oci-container-service-type
   (service-type (name 'oci-container)
-                (extensions (list (service-extension profile-service-type
-                                                     (lambda _ (list docker-cli)))
-                                  (service-extension account-service-type
-                                                     (const %oci-container-accounts))
-                                  (service-extension shepherd-root-service-type
-                                                     configs->shepherd-services)))
+                (extensions
+                 (list (service-extension oci-service-type
+                                          (lambda (containers)
+                                            (warning
+                                             (G_
+                                              "'oci-container-service-type' is\
+ deprecated, use 'oci-service-type' instead~%"))
+                                            (oci-extension
+                                             (containers containers))))))
                 (default-value '())
                 (extend append)
                 (compose concatenate)
diff --git a/gnu/tests/containers.scm b/gnu/tests/containers.scm
index 0ecc8ddb126..051a4c740bf 100644
--- a/gnu/tests/containers.scm
+++ b/gnu/tests/containers.scm
@@ -27,6 +27,9 @@ (define-module (gnu tests containers)
   #: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 @@ (define-module (gnu tests containers)
   #: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 @@ (define (run-rootless-podman-test oci-tarball)
                                (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 @@ (define %test-rootless-podman
    (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 dhcp-client-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 utils)
+                          (gnu services herd)
+                          (guix combinators))))
+
+  (define vm
+    (virtual-machine
+     (operating-system os)
+     (volatile? #f)
+     (memory-size 1024)
+     (disk-image-size (* 3000 (expt 2 20)))
+     (port-forwardings '())))
+
+  (define test
+    (with-imported-modules '((gnu build oci-containers)
+                             (gnu build utils)
+                             (gnu build marionette))
+      #~(begin
+          (use-modules (srfi srfi-1) (srfi srfi-11) (srfi srfi-64)
+                       (gnu build utils)
+                       (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 dhcp-client-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 utils)
+                          (gnu services herd)
+                          (guix combinators))))
+
+  (define vm
+    (virtual-machine
+     (operating-system os)
+     (volatile? #f)
+     (memory-size 1024)
+     (disk-image-size (* 3000 (expt 2 20)))
+     (port-forwardings '())))
+
+  (define test
+    (with-imported-modules '((gnu build oci-containers)
+                             (gnu build utils)
+                             (gnu build marionette))
+      #~(begin
+          (use-modules (srfi srfi-1) (srfi srfi-11) (srfi srfi-64)
+                       (gnu build utils)
+                       (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))))
-- 
2.49.0





From unknown Fri Jun 13 11:55:10 2025
X-Loop: help-debbugs@gnu.org
Subject: [bug#76081] [PATCH v12 2/5] gnu: Move with-retries outside dbus-service.
Resent-From: Giacomo Leidi 
Original-Sender: "Debbugs-submit" 
Resent-CC: maxim.cournoyer@gmail.com, guix-patches@gnu.org
Resent-Date: Fri, 13 Jun 2025 18:11:06 +0000
Resent-Message-ID: 
Resent-Sender: help-debbugs@gnu.org
X-GNU-PR-Message: followup 76081
X-GNU-PR-Package: guix-patches
X-GNU-PR-Keywords: moreinfo
To: 76081@debbugs.gnu.org
Cc: Giacomo Leidi , Maxim Cournoyer 
X-Debbugs-Original-Xcc: Maxim Cournoyer 
Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.174983825112959
          (code B ref 76081); Fri, 13 Jun 2025 18:11:06 +0000
Received: (at 76081) by debbugs.gnu.org; 13 Jun 2025 18:10:51 +0000
Received: from localhost ([127.0.0.1]:49874 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from )
	id 1uQ8ra-0003Mv-2V
	for submit@debbugs.gnu.org; Fri, 13 Jun 2025 14:10:50 -0400
Received: from confino.investici.org ([93.190.126.19]:53613)
 by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
 (Exim 4.84_2) (envelope-from )
 id 1uQ8rQ-0003M2-PS
 for 76081@debbugs.gnu.org; Fri, 13 Jun 2025 14:10:45 -0400
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org;
 s=stigmate; t=1749838239;
 bh=NFNxiYtye2msRctneKUxg6yjQUjbQtqD5sGE2u7OfR4=;
 h=From:To:Cc:Subject:Date:In-Reply-To:References:From;
 b=qe7CbnJxLSoqMDwHIAN+mStF5F8Bdl7YaPdlWu2ncBDF6WE+hJmcl6TjYRBNYlhaI
 v1AN7NJFIJAtjt12915dxVGgQqFwFNJKj8Ri3qvJ2Jvsbaylt8Frl9lnfam1JokX3N
 P/MYf1OZncNrpxnXA7gFSUVkVZ0T+O/MeJk5RK3Q=
Received: from mx1.investici.org (unknown [127.0.0.1])
 by confino.investici.org (Postfix) with ESMTP id 4bJnWM4njRz110w;
 Fri, 13 Jun 2025 18:10:39 +0000 (UTC)
Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19])
 (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with
 ESMTPSA id 4bJnWM3Z71z10tj; Fri, 13 Jun 2025 18:10:39 +0000 (UTC)
From: Giacomo Leidi 
Date: Fri, 13 Jun 2025 20:10:05 +0200
Message-ID: <051132a771d9e1277891eeb3dcac57440fd059dc.1749838208.git.goodoldpaul@autistici.org>
X-Mailer: git-send-email 2.49.0
In-Reply-To: 
References: 
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
X-Spam-Score: -0.7 (/)
X-BeenThere: debbugs-submit@debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: 
List-Unsubscribe: , 
 
List-Archive: 
List-Post: 
List-Help: 
List-Subscribe: , 
 
Errors-To: debbugs-submit-bounces@debbugs.gnu.org
Sender: "Debbugs-submit" 
X-Spam-Score: -1.7 (-)

This patch moves with-retries outside of (gnu build dbus-service) into a
more general (gnu build utils) which can be imported without
unnecessarily importing dbus related symbols.

* gnu/build/dbus-service.scm (sleep,with-retries): Move to...
* gnu/build/utils.scm: ...here.
* gnu/local.mk: Add gnu/build/utils.scm.
* gnu/build/jami-service.scm: Import (gnu build utils).
* gnu/services/telephony.scm (jami-account->alist): Format.
(jami-shepherd-services): Import (gnu build utils).
* gnu/test/messaging.scm (run-ngircd-test): Import (gnu build utils).
(run-pounce-test): Import (gnu build utils).
* gnu/test/telephony.scm (run-jami-test): Import (gnu build utils) and
format.

Change-Id: I3c1768f884ca46d0820a801bd0310c2ec8f3da54
---
 gnu/build/dbus-service.scm | 39 +++------------------------
 gnu/build/jami-service.scm |  1 +
 gnu/build/utils.scm        | 55 ++++++++++++++++++++++++++++++++++++++
 gnu/local.mk               |  1 +
 gnu/services/telephony.scm |  9 ++++---
 gnu/tests/messaging.scm    |  8 +++---
 gnu/tests/telephony.scm    | 11 ++++----
 7 files changed, 76 insertions(+), 48 deletions(-)
 create mode 100644 gnu/build/utils.scm

diff --git a/gnu/build/dbus-service.scm b/gnu/build/dbus-service.scm
index 688afe44c3d..9bbcd457512 100644
--- a/gnu/build/dbus-service.scm
+++ b/gnu/build/dbus-service.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2021, 2022 Maxim Cournoyer 
+;;; Copyright © 2025 Giacomo Leidi 
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -24,6 +25,7 @@
 ;;; Code:
 
 (define-module (gnu build dbus-service)
+  #:use-module (gnu build utils)
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-19)
@@ -54,45 +56,10 @@ (define-module (gnu build dbus-service)
             call-dbus-method
 
             dbus-available-services
-            dbus-service-available?
-
-            with-retries))
+            dbus-service-available?))
 
 (define %dbus-query-timeout 2)          ;in seconds
 
-;;; Use Fibers' sleep to enable cooperative scheduling in Shepherd >= 0.9.0,
-;;; which is required at least for the Jami service.
-(define sleep*
-  (lambda ()                            ;delay execution
-    (if (resolve-module '(fibers) #f #:ensure #f)
-        (module-ref (resolve-interface '(fibers)) 'sleep)
-        (begin
-          (format #t "Fibers not available -- blocking 'sleep' in use~%")
-          sleep))))
-
-;;;
-;;; Utilities.
-;;;
-
-(define-syntax-rule (with-retries n delay body ...)
-  "Retry the code in BODY up to N times until it doesn't raise an exception nor
-return #f, else raise an error.  A delay of DELAY seconds is inserted before
-each retry."
-  (let loop ((attempts 0))
-    (catch #t
-      (lambda ()
-        (let ((result (begin body ...)))
-          (if (not result)
-              (error "failed attempt" attempts)
-              result)))
-      (lambda args
-        (if (< attempts n)
-            (begin
-              ((sleep*) delay)            ;else wait and retry
-              (loop (+ 1 attempts)))
-            (error "maximum number of retry attempts reached"
-                   (quote body ...) args))))))
-
 
 ;;;
 ;;; Low level wrappers above AC/D-Bus.
diff --git a/gnu/build/jami-service.scm b/gnu/build/jami-service.scm
index a00785f699b..7c2c48d821a 100644
--- a/gnu/build/jami-service.scm
+++ b/gnu/build/jami-service.scm
@@ -25,6 +25,7 @@
 
 (define-module (gnu build jami-service)
   #:use-module (gnu build dbus-service)
+  #:use-module (gnu build utils)
   #:use-module (ice-9 format)
   #:use-module (ice-9 match)
   #:use-module (ice-9 rdelim)
diff --git a/gnu/build/utils.scm b/gnu/build/utils.scm
new file mode 100644
index 00000000000..1aa72358bd8
--- /dev/null
+++ b/gnu/build/utils.scm
@@ -0,0 +1,55 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2025 Giacomo Leidi 
+;;;
+;;; 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 .
+
+;;; Commentary:
+;;;
+;;; This module contains helpers that could useful to any service.
+;;;
+;;; Code:
+
+(define-module (gnu build utils)
+  #:export (with-retries))
+
+;;; Use Fibers' sleep to enable cooperative scheduling in Shepherd >= 0.9.0,
+;;; which is required at least for the Jami service.
+(define sleep*
+  (lambda ()                            ;delay execution
+    (if (resolve-module '(fibers) #f #:ensure #f)
+        (module-ref (resolve-interface '(fibers)) 'sleep)
+        (begin
+          (format #t "Fibers not available -- blocking 'sleep' in use~%")
+          sleep))))
+
+(define-syntax-rule (with-retries n delay body ...)
+  "Retry the code in BODY up to N times until it doesn't raise an exception nor
+return #f, else raise an error.  A delay of DELAY seconds is inserted before
+each retry."
+  (let loop ((attempts 0))
+    (catch #t
+      (lambda ()
+        (let ((result (begin body ...)))
+          (if (not result)
+              (error "failed attempt" attempts)
+              result)))
+      (lambda args
+        (if (< attempts n)
+            (begin
+              ((sleep*) delay)            ;else wait and retry
+              (loop (+ 1 attempts)))
+            (error "maximum number of retry attempts reached"
+                   (quote body ...) args))))))
diff --git a/gnu/local.mk b/gnu/local.mk
index ee861f51ee2..da902d07df2 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -842,6 +842,7 @@ GNU_SYSTEM_MODULES =				\
   %D%/build/linux-modules.scm			\
   %D%/build/marionette.scm			\
   %D%/build/secret-service.scm			\
+  %D%/build/utils.scm   			\
 						\
   %D%/tests.scm					\
   %D%/tests/audio.scm				\
diff --git a/gnu/services/telephony.scm b/gnu/services/telephony.scm
index 9926f4107de..ad6959e161b 100644
--- a/gnu/services/telephony.scm
+++ b/gnu/services/telephony.scm
@@ -210,7 +210,7 @@ (define (jami-account->alist jami-account-object)
              (tfilter-maybe-value jami-account-object)
              (tmap (lambda (field)
                      (let* ((name (field-name->account-detail
-                                  (configuration-field-name field)))
+                                   (configuration-field-name field)))
                             (value ((configuration-field-serializer field)
                                     name ((configuration-field-getter field)
                                           jami-account-object))))
@@ -360,7 +360,8 @@ (define (jami-shepherd-services config)
                            ;; variant of the 'sleep' procedure.
                            guile-fibers)
       (with-imported-modules (source-module-closure
-                              '((gnu build dbus-service)
+                              '((gnu build utils)
+                                (gnu build dbus-service)
                                 (gnu build jami-service)
                                 (gnu system file-systems)))
 
@@ -541,7 +542,8 @@ (define (jami-shepherd-services config)
         (list (shepherd-service
                (documentation "Run a D-Bus session for the Jami daemon.")
                (provision '(jami-dbus-session))
-               (modules `((gnu build dbus-service)
+               (modules `((gnu build utils)
+                          (gnu build dbus-service)
                           (gnu build jami-service)
                           (gnu system file-systems)
                           ,@%default-modules))
@@ -587,6 +589,7 @@ (define (jami-shepherd-services config)
                           (ice-9 receive)
                           (srfi srfi-1)
                           (srfi srfi-26)
+                          (gnu build utils)
                           (gnu build dbus-service)
                           (gnu build jami-service)
                           (gnu system file-systems)
diff --git a/gnu/tests/messaging.scm b/gnu/tests/messaging.scm
index 8df67433a7f..2eb99331b52 100644
--- a/gnu/tests/messaging.scm
+++ b/gnu/tests/messaging.scm
@@ -269,7 +269,7 @@ (define (run-ngircd-test)
        (marionette-operating-system
         %ngircd-os
         #:imported-modules (source-module-closure
-                            '((gnu build dbus-service)
+                            '((gnu build utils)
                               (guix build utils)
                               (gnu services herd)))))))
 
@@ -298,7 +298,7 @@ (define (run-ngircd-test)
           (test-assert "basic irc operations function as expected"
             (marionette-eval
              '(begin
-                (use-modules ((gnu build dbus-service) #:select (with-retries))
+                (use-modules (gnu build utils)
                              (ice-9 textual-ports))
 
                 (define (write-command command)
@@ -437,7 +437,7 @@ (define (run-pounce-test)
        (marionette-operating-system
         %pounce-os
         #:imported-modules (source-module-closure
-                            '((gnu build dbus-service)
+                            '((gnu build utils)
                               (guix build utils)
                               (gnu services herd)))))
      (memory-size 1024)))
@@ -470,7 +470,7 @@ (define (run-pounce-test)
           (test-assert "pounce functions as an irc bouncer"
             (marionette-eval
              '(begin
-                (use-modules ((gnu build dbus-service) #:select (with-retries))
+                (use-modules (gnu build utils)
                              (guix build utils)
                              (ice-9 textual-ports))
 
diff --git a/gnu/tests/telephony.scm b/gnu/tests/telephony.scm
index f03ea963f7e..3a085762323 100644
--- a/gnu/tests/telephony.scm
+++ b/gnu/tests/telephony.scm
@@ -143,7 +143,8 @@ (define* (run-jami-test #:key provisioning? partial?)
               #:imported-modules '((gnu services herd)
                                    (guix combinators)
                                    (gnu build jami-service)
-                                   (gnu build dbus-service))))
+                                   (gnu build dbus-service)
+                                   (gnu build utils))))
   (define vm (virtual-machine
               (operating-system os)
               (memory-size 512)))
@@ -209,7 +210,7 @@ (define* (run-jami-test #:key provisioning? partial?)
           (test-assert "service can be stopped"
             (marionette-eval
              '(begin
-                (use-modules (gnu build dbus-service)
+                (use-modules (gnu build utils)
                              (gnu build jami-service)
                              (gnu services herd)
                              (rnrs base))
@@ -223,10 +224,10 @@ (define* (run-jami-test #:key provisioning? partial?)
           (test-assert "service can be restarted"
             (marionette-eval
              '(begin
-                (use-modules (gnu build dbus-service)
+                (use-modules (gnu build utils)
                              (gnu build jami-service)
                              (gnu services herd)
-                             (rnrs base)                               )
+                             (rnrs base))
                 ;; Start the service.
                 (start-service 'jami)
                 (with-retries 40 1 (jami-service-available?))
@@ -239,7 +240,7 @@ (define* (run-jami-test #:key provisioning? partial?)
           (test-assert "jami accounts provisioning, account present"
             (marionette-eval
              '(begin
-                (use-modules (gnu build dbus-service)
+                (use-modules (gnu build utils)
                              (gnu services herd)
                              (rnrs base))
                 ;; Accounts take some time to appear after being added.
-- 
2.49.0





From unknown Fri Jun 13 11:55:10 2025
X-Loop: help-debbugs@gnu.org
Subject: [bug#76081] [PATCH v12 4/5] tests: Use lower-oci-image-state in container tests.
Resent-From: Giacomo Leidi 
Original-Sender: "Debbugs-submit" 
Resent-CC: guix-patches@gnu.org
Resent-Date: Fri, 13 Jun 2025 18:11:07 +0000
Resent-Message-ID: 
Resent-Sender: help-debbugs@gnu.org
X-GNU-PR-Message: followup 76081
X-GNU-PR-Package: guix-patches
X-GNU-PR-Keywords: moreinfo
To: 76081@debbugs.gnu.org
Cc: Giacomo Leidi 
Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.174983825212967
          (code B ref 76081); Fri, 13 Jun 2025 18:11:07 +0000
Received: (at 76081) by debbugs.gnu.org; 13 Jun 2025 18:10:52 +0000
Received: from localhost ([127.0.0.1]:49877 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from )
	id 1uQ8rb-0003My-1A
	for submit@debbugs.gnu.org; Fri, 13 Jun 2025 14:10:51 -0400
Received: from confino.investici.org ([2a11:7980:1::2:0]:51605)
 by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
 (Exim 4.84_2) (envelope-from )
 id 1uQ8rS-0003M6-76
 for 76081@debbugs.gnu.org; Fri, 13 Jun 2025 14:10:47 -0400
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org;
 s=stigmate; t=1749838240;
 bh=HxTYqulnshs6Kv1MTBcz9pDRspS9WxFXQx7igpkMtZY=;
 h=From:To:Cc:Subject:Date:In-Reply-To:References:From;
 b=TcfGeiGPgc4i1hulZltZyrJqQwTj4y4qiPdoBcYcc7RsPsCfy4rSK/FRsKuflaMJ1
 2EZJUy3X81u1PleQzleusNVmubo1d3CLIhsO9h0b5YuhbM2zQwxmo+VD2cxZR/Pr64
 XgFT1pOm6zalHwuwzEC0cxxcfKqj+Vfo1rnKjJeY=
Received: from mx1.investici.org (unknown [127.0.0.1])
 by confino.investici.org (Postfix) with ESMTP id 4bJnWN4lm1z113g;
 Fri, 13 Jun 2025 18:10:40 +0000 (UTC)
Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19])
 (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with
 ESMTPSA id 4bJnWN3gHkz10tj; Fri, 13 Jun 2025 18:10:40 +0000 (UTC)
From: Giacomo Leidi 
Date: Fri, 13 Jun 2025 20:10:07 +0200
Message-ID: 
X-Mailer: git-send-email 2.49.0
In-Reply-To: 
References: 
MIME-Version: 1.0
Content-Transfer-Encoding: 8bit
X-Spam-Score: -0.0 (/)
X-BeenThere: debbugs-submit@debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: 
List-Unsubscribe: , 
 
List-Archive: 
List-Post: 
List-Help: 
List-Subscribe: , 
 
Errors-To: debbugs-submit-bounces@debbugs.gnu.org
Sender: "Debbugs-submit" 
X-Spam-Score: -1.0 (-)

This patch replaces boilerplate in container related tests with
oci-image plumbing from (gnu services containers).

* gnu/tests/containers.scm (%oci-tarball): New variable;
(run-rootless-podman-test): use %oci-tarball;
(build-tarball&run-rootless-podman-test): drop procedure.
* gnu/tests/docker.scm (%docker-tarball): New variable;
(build-tarball&run-docker-test): use %docker-tarball;
(%docker-system-tarball): New variable;
(build-tarball&run-docker-system-test): new procedure.

Change-Id: Iad6f0704aee188d89464c83722dea0bb7adb084a
Signed-off-by: Giacomo Leidi 
---
 gnu/tests/containers.scm |  84 +++++++++++++++----------------
 gnu/tests/docker.scm     | 104 ++++++++++++++++++++++-----------------
 2 files changed, 101 insertions(+), 87 deletions(-)

diff --git a/gnu/tests/containers.scm b/gnu/tests/containers.scm
index 051a4c740bf..0db22e3a07f 100644
--- a/gnu/tests/containers.scm
+++ b/gnu/tests/containers.scm
@@ -46,6 +46,9 @@ (define-module (gnu tests containers)
             %test-oci-service-rootless-podman
             %test-oci-service-docker))
 
+(define lower-oci-image-state
+  (@@ (gnu services containers) lower-oci-image-state))
+
 
 (define %rootless-podman-os
   (simple-operating-system
@@ -69,13 +72,48 @@ (define %rootless-podman-os
                           (supplementary-groups '("wheel" "netdev" "cgroup"
                                                   "audio" "video")))))))
 
-(define (run-rootless-podman-test oci-tarball)
+(define %oci-tarball
+  (lower-oci-image-state
+   "guile-guest"
+   (packages->manifest
+    (list
+     guile-3.0 guile-json-3
+     (package
+       (name "guest-script")
+       (version "0")
+       (source #f)
+       (build-system trivial-build-system)
+       (arguments
+        (list
+         #:guile guile-3.0
+         #:builder
+         #~(let ((out #$output))
+             (mkdir out)
+             (call-with-output-file (string-append out "/a.scm")
+               (lambda (port)
+                 (display "(display \"hello world\n\")" port))))))
+       (synopsis "Display hello world using Guile")
+       (description "This package displays the text \"hello world\" on the
+standard output device and then enters a new line.")
+       (home-page #f)
+       (license license:public-domain))))
+   '(#:entry-point "bin/guile"
+     #:localstatedir? #t
+     #:extra-options (#:image-tag "guile-guest")
+     #:symlinks (("/bin/Guile" -> "bin/guile")
+                 ("aa.scm" -> "a.scm")))
+   "guile-guest"
+   (%current-target-system)
+   (%current-system)
+   #f))
+
+(define (run-rootless-podman-test)
 
   (define os
     (marionette-operating-system
      (operating-system-with-gc-roots
       %rootless-podman-os
-      (list oci-tarball))
+      (list %oci-tarball))
      #:imported-modules '((gnu services herd)
                           (guix combinators))))
 
@@ -254,7 +292,7 @@ (define (run-rootless-podman-test oci-tarball)
                        (let* ((loaded (slurp ,(string-append #$podman
                                                              "/bin/podman")
                                              "load" "-i"
-                                             ,#$oci-tarball))
+                                             ,#$%oci-tarball))
                               (repository&tag "localhost/guile-guest:latest")
                               (response1 (slurp
                                           ,(string-append #$podman "/bin/podman")
@@ -307,49 +345,11 @@ (define (run-rootless-podman-test oci-tarball)
 
   (gexp->derivation "rootless-podman-test" test))
 
-(define (build-tarball&run-rootless-podman-test)
-  (mlet* %store-monad
-      ((_ (set-grafting #f))
-       (guile (set-guile-for-build (default-guile)))
-       (guest-script-package ->
-        (package
-          (name "guest-script")
-          (version "0")
-          (source #f)
-          (build-system trivial-build-system)
-          (arguments `(#:guile ,guile-3.0
-                       #:builder
-                       (let ((out (assoc-ref %outputs "out")))
-                         (mkdir out)
-                         (call-with-output-file (string-append out "/a.scm")
-                           (lambda (port)
-                             (display "(display \"hello world\n\")" port)))
-                         #t)))
-          (synopsis "Display hello world using Guile")
-          (description "This package displays the text \"hello world\" on the
-standard output device and then enters a new line.")
-          (home-page #f)
-          (license license:public-domain)))
-       (profile (profile-derivation (packages->manifest
-                                     (list guile-3.0 guile-json-3
-                                           guest-script-package))
-                                    #:hooks '()
-                                    #:locales? #f))
-       (tarball (pack:docker-image
-                 "docker-pack" profile
-                 #:symlinks '(("/bin/Guile" -> "bin/guile")
-                              ("aa.scm" -> "a.scm"))
-                 #:extra-options
-                 '(#:image-tag "guile-guest")
-                 #:entry-point "bin/guile"
-                 #:localstatedir? #t)))
-    (run-rootless-podman-test tarball)))
-
 (define %test-rootless-podman
   (system-test
    (name "rootless-podman")
    (description "Test rootless Podman service.")
-   (value (build-tarball&run-rootless-podman-test))))
+   (value (run-rootless-podman-test))))
 
 
 (define %oci-network
diff --git a/gnu/tests/docker.scm b/gnu/tests/docker.scm
index 5dcf05a17e3..1f264d52486 100644
--- a/gnu/tests/docker.scm
+++ b/gnu/tests/docker.scm
@@ -26,6 +26,7 @@ (define-module (gnu tests docker)
   #:use-module (gnu system image)
   #:use-module (gnu system vm)
   #:use-module (gnu services)
+  #:use-module (gnu services containers)
   #:use-module (gnu services dbus)
   #:use-module (gnu services networking)
   #:use-module (gnu services docker)
@@ -48,6 +49,9 @@ (define-module (gnu tests docker)
             %test-docker-system
             %test-oci-container))
 
+(define lower-oci-image-state
+  (@@ (gnu services containers) lower-oci-image-state))
+
 (define %docker-os
   (simple-operating-system
    (service dhcp-client-service-type)
@@ -57,6 +61,41 @@ (define %docker-os
    (service containerd-service-type)
    (service docker-service-type)))
 
+(define %docker-tarball
+  (lower-oci-image-state
+   "guile-guest"
+   (packages->manifest
+    (list
+     guile-3.0 guile-json-3
+     (package
+       (name "guest-script")
+       (version "0")
+       (source #f)
+       (build-system trivial-build-system)
+       (arguments
+        (list
+         #:guile guile-3.0
+         #:builder
+         #~(let ((out #$output))
+             (mkdir out)
+             (call-with-output-file (string-append out "/a.scm")
+               (lambda (port)
+                 (display "(display \"hello world\n\")" port))))))
+       (synopsis "Display hello world using Guile")
+       (description "This package displays the text \"hello world\" on the
+standard output device and then enters a new line.")
+       (home-page #f)
+       (license license:public-domain))))
+   '(#:entry-point "bin/guile"
+     #:localstatedir? #t
+     #:extra-options (#:image-tag "guile-guest")
+     #:symlinks (("/bin/Guile" -> "bin/guile")
+                 ("aa.scm" -> "a.scm")))
+   "guile-guest"
+   (%current-target-system)
+   (%current-system)
+   #f))
+
 (define (run-docker-test docker-tarball)
   "Load DOCKER-TARBALL as Docker image and run it in a Docker container,
 inside %DOCKER-OS."
@@ -173,40 +212,7 @@ (define (run-docker-test docker-tarball)
   (gexp->derivation "docker-test" test))
 
 (define (build-tarball&run-docker-test)
-  (mlet* %store-monad
-      ((_ (set-grafting #f))
-       (guile (set-guile-for-build (default-guile)))
-       (guest-script-package ->
-        (package
-          (name "guest-script")
-          (version "0")
-          (source #f)
-          (build-system trivial-build-system)
-          (arguments `(#:guile ,guile-3.0
-                       #:builder
-                       (let ((out (assoc-ref %outputs "out")))
-                         (mkdir out)
-                         (call-with-output-file (string-append out "/a.scm")
-                           (lambda (port)
-                             (display "(display \"hello world\n\")" port)))
-                         #t)))
-          (synopsis "Display hello world using Guile")
-          (description "This package displays the text \"hello world\" on the
-standard output device and then enters a new line.")
-          (home-page #f)
-          (license license:public-domain)))
-       (profile (profile-derivation (packages->manifest
-                                     (list guile-3.0 guile-json-3
-                                           guest-script-package))
-                                    #:hooks '()
-                                    #:locales? #f))
-       (tarball (pack:docker-image
-                 "docker-pack" profile
-                 #:symlinks '(("/bin/Guile" -> "bin/guile")
-                              ("aa.scm" -> "a.scm"))
-                 #:entry-point "bin/guile"
-                 #:localstatedir? #t)))
-    (run-docker-test tarball)))
+  (run-docker-test %docker-tarball))
 
 (define %test-docker
   (system-test
@@ -215,8 +221,22 @@ (define %test-docker
    (value (build-tarball&run-docker-test))))
 
 
+(define %docker-system-tarball
+  (lower-oci-image-state
+   "guix-system-guest"
+   (operating-system
+     (inherit (simple-operating-system))
+     ;; Use locales for a single libc to
+     ;; reduce space requirements.
+     (locale-libcs (list glibc)))
+   '()
+   "guix-system-guest"
+   (%current-target-system)
+   (%current-system)
+   #f))
+
 (define (run-docker-system-test tarball)
-  "Load DOCKER-TARBALL as Docker image and run it in a Docker container,
+  "Load TARBALL as Docker image and run it in a Docker container,
 inside %DOCKER-OS."
   (define os
     (marionette-operating-system
@@ -333,21 +353,15 @@ (define (run-docker-system-test tarball)
 
   (gexp->derivation "docker-system-test" test))
 
+(define (build-tarball&run-docker-system-test)
+  (run-docker-system-test %docker-system-tarball))
+
 (define %test-docker-system
   (system-test
    (name "docker-system")
    (description "Run a system image as produced by @command{guix system
 docker-image} inside Docker.")
-   (value (with-monad %store-monad
-            (>>= (lower-object
-                  (system-image (os->image
-                                 (operating-system
-                                   (inherit (simple-operating-system))
-                                   ;; Use locales for a single libc to
-                                   ;; reduce space requirements.
-                                   (locale-libcs (list glibc)))
-                                 #:type docker-image-type)))
-                 run-docker-system-test)))))
+   (value (build-tarball&run-docker-system-test))))
 
 
 (define %oci-os
-- 
2.49.0





From unknown Fri Jun 13 11:55:10 2025
X-Loop: help-debbugs@gnu.org
Subject: [bug#76081] [PATCH v12 5/5] home: Add home-oci-service-type.
Resent-From: Giacomo Leidi 
Original-Sender: "Debbugs-submit" 
Resent-CC: andrew@trop.in, gabriel@erlikon.ch, hako@ultrarare.space, janneke@gnu.org, ludo@gnu.org, maxim.cournoyer@gmail.com, tanguy@bioneland.org, guix-patches@gnu.org
Resent-Date: Fri, 13 Jun 2025 18:11:08 +0000
Resent-Message-ID: 
Resent-Sender: help-debbugs@gnu.org
X-GNU-PR-Message: followup 76081
X-GNU-PR-Package: guix-patches
X-GNU-PR-Keywords: moreinfo
To: 76081@debbugs.gnu.org
Cc: Giacomo Leidi , Andrew Tropin , Gabriel Wicki , Hilton Chain , Janneke Nieuwenhuizen , Ludovic =?UTF-8?Q?Court=C3=A8s?= , Maxim Cournoyer , Tanguy Le Carrour 
X-Debbugs-Original-Xcc: Andrew Tropin , Gabriel Wicki , Hilton Chain , Janneke Nieuwenhuizen , Ludovic =?UTF-8?Q?Court=C3=A8s?= , Maxim Cournoyer , Tanguy Le Carrour 
Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.174983825212975
          (code B ref 76081); Fri, 13 Jun 2025 18:11:08 +0000
Received: (at 76081) by debbugs.gnu.org; 13 Jun 2025 18:10:52 +0000
Received: from localhost ([127.0.0.1]:49880 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from )
	id 1uQ8rb-0003N6-UT
	for submit@debbugs.gnu.org; Fri, 13 Jun 2025 14:10:52 -0400
Received: from confino.investici.org ([2a11:7980:1::2:0]:65021)
 by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
 (Exim 4.84_2) (envelope-from )
 id 1uQ8rS-0003M8-6r
 for 76081@debbugs.gnu.org; Fri, 13 Jun 2025 14:10:47 -0400
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org;
 s=stigmate; t=1749838241;
 bh=ehJh4ajlXsEc6NgHwUmc0f7hs7FFOYulUmFy5aFjOj0=;
 h=From:To:Cc:Subject:Date:In-Reply-To:References:From;
 b=n1tzC5cfBLCS0WqO/PX6ZClJv8oPDSw7/M6uQkShaBTkHKaJvPICpGnOz6hLcPXwr
 LnI0VOhGy6g9mdcRrYxT4WkpmWkaSmb9fjR53L/DKZImspJmQctuRQE9POC3g9wDLp
 Jv79tjCwUXEDbauiuTwGdFH0iwx0i6yKd1EnCLzg=
Received: from mx1.investici.org (unknown [127.0.0.1])
 by confino.investici.org (Postfix) with ESMTP id 4bJnWP0t9Lz114C;
 Fri, 13 Jun 2025 18:10:41 +0000 (UTC)
Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19])
 (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with
 ESMTPSA id 4bJnWN6wR6z10tj; Fri, 13 Jun 2025 18:10:40 +0000 (UTC)
From: Giacomo Leidi 
Date: Fri, 13 Jun 2025 20:10:08 +0200
Message-ID: <202119dce53c6206cabb86890e4aad6de9fcfd71.1749838208.git.goodoldpaul@autistici.org>
X-Mailer: git-send-email 2.49.0
In-Reply-To: 
References: 
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
X-Spam-Score: -0.0 (/)
X-BeenThere: debbugs-submit@debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: 
List-Unsubscribe: , 
 
List-Archive: 
List-Post: 
List-Help: 
List-Subscribe: , 
 
Errors-To: debbugs-submit-bounces@debbugs.gnu.org
Sender: "Debbugs-submit" 
X-Spam-Score: -1.0 (-)

* gnu/home/service/containers.scm: New file;
* gnu/local.mk (GNU_SYSTEM_MODULES): Add it.
* doc/guix.texi (OCI backed services): Document it.

Change-Id: I8ce5b301e8032d0a7b2a9ca46752738cdee1f030
Signed-off-by: Giacomo Leidi 
---
 doc/guix.texi                    | 114 +++++++++++++++++++++++++++++++
 gnu/home/services/containers.scm |  49 +++++++++++++
 gnu/local.mk                     |   1 +
 3 files changed, 164 insertions(+)
 create mode 100644 gnu/home/services/containers.scm

diff --git a/doc/guix.texi b/doc/guix.texi
index fbffead4f9f..77c896cf0c7 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -52363,6 +52363,120 @@ Miscellaneous Home Services
 documentation of the system service (@pxref{Miscellaneous Services,
 @code{readymedia-service-type}}).
 
+@subsubheading OCI backed services
+
+@cindex OCI-backed, for Home
+The @code{(gnu home services containers)} module provides the following service:
+
+@defvar home-oci-service-type
+This is the type of the service that allows to manage your OCI containers with
+the same consistent interface you use for your other Home Shepherd services.
+@end defvar
+
+This service is a direct mapping of the @code{oci-service-type} system
+service (@pxref{Miscellaneous Services, OCI backed services}).  You can
+use it like this:
+
+@lisp
+(use-modules (gnu services containers)
+             (gnu home services containers))
+
+(simple-service 'home-oci-provisioning
+                home-oci-service-type
+                (oci-extension
+                  (volumes
+                    (list
+                      (oci-volume-configuration (name "prometheus"))
+                      (oci-volume-configuration (name "grafana"))))
+                  (networks
+                    (list
+                      (oci-network-configuration (name "monitoring"))))
+                  (containers
+                   (list
+                    (oci-container-configuration
+                     (network "monitoring")
+                     (image
+                      (oci-image
+                        (repository "guile")
+                        (tag "3")
+                        (value (specifications->manifest '("guile")))
+                        (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile"))
+                                        #:max-layers 2))))
+                     (entrypoint "/bin/guile")
+                     (command
+                      '("-c" "(display \"hello!\n\")")))
+                    (oci-container-configuration
+                      (image "prom/prometheus")
+                      (network "monitoring")
+                      (ports
+                       '(("9000" . "9000")
+                         ("9090" . "9090")))
+                      (volumes
+                       (list
+                        '(("prometheus" . "/var/lib/prometheus")))))
+                    (oci-container-configuration
+                      (image "grafana/grafana:10.0.1")
+                      (network "monitoring")
+                      (volumes
+                       '(("grafana:/var/lib/grafana"))))))))
+
+@end lisp
+
+You may specify a custom configuration by providing a
+@code{oci-configuration} record, exactly like for
+@code{oci-service-type}, but wrapping it in @code{for-home}:
+
+@lisp
+(use-modules (gnu services)
+             (gnu services containers)
+             (gnu home services containers))
+
+(service home-oci-service-type
+         (for-home
+          (oci-configuration
+           (runtime 'podman)
+           (verbose? #t))))
+
+(simple-service 'home-oci-provisioning
+                home-oci-service-type
+                (oci-extension
+                  (volumes
+                    (list
+                      (oci-volume-configuration (name "prometheus"))
+                      (oci-volume-configuration (name "grafana"))))
+                  (networks
+                    (list
+                      (oci-network-configuration (name "monitoring"))))
+                  (containers
+                   (list
+                    (oci-container-configuration
+                     (network "monitoring")
+                     (image
+                      (oci-image
+                        (repository "guile")
+                        (tag "3")
+                        (value (specifications->manifest '("guile")))
+                        (pack-options '(#:symlinks (("/bin/guile" -> "bin/guile"))
+                                        #:max-layers 2))))
+                     (entrypoint "/bin/guile")
+                     (command
+                      '("-c" "(display \"hello!\n\")")))
+                    (oci-container-configuration
+                      (image "prom/prometheus")
+                      (network "monitoring")
+                      (ports
+                       '(("9000" . "9000")
+                         ("9090" . "9090")))
+                      (volumes
+                       (list
+                        '(("prometheus" . "/var/lib/prometheus")))))
+                    (oci-container-configuration
+                      (image "grafana/grafana:10.0.1")
+                      (network "monitoring")
+                      (volumes
+                       '(("grafana:/var/lib/grafana"))))))))
+@end lisp
+
 @node Invoking guix home
 @section Invoking @command{guix home}
 
diff --git a/gnu/home/services/containers.scm b/gnu/home/services/containers.scm
new file mode 100644
index 00000000000..1ccdb3b2464
--- /dev/null
+++ b/gnu/home/services/containers.scm
@@ -0,0 +1,49 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2025 Giacomo Leidi 
+;;;
+;;; 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 .
+
+(define-module (gnu home services containers)
+  #:use-module (gnu home services)
+  #:use-module (gnu home services shepherd)
+  #:use-module (gnu services)
+  #:use-module (gnu services configuration)
+  #:use-module (gnu services containers)
+  #:use-module (guix gexp)
+  #:use-module (guix packages)
+  #:use-module (srfi srfi-1)
+  #:export (home-oci-service-type))
+
+(define home-oci-service-type
+  (service-type
+   (inherit (system->home-service-type oci-service-type))
+   (extensions
+    (list
+     (service-extension home-profile-service-type
+                        (lambda (config)
+                          (let ((runtime-cli
+                                 (oci-configuration-runtime-cli config))
+                                (runtime
+                                 (oci-configuration-runtime config)))
+                            (oci-service-profile runtime runtime-cli))))
+     (service-extension home-shepherd-service-type
+                        oci-configuration->shepherd-services)))
+   (extend
+    (lambda (config extension)
+      (for-home
+       (oci-configuration
+        (inherit (oci-configuration-extend config extension))))))
+   (default-value (for-home (oci-configuration)))))
diff --git a/gnu/local.mk b/gnu/local.mk
index ec557633708..a5676745f58 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -104,6 +104,7 @@ GNU_SYSTEM_MODULES =				\
   %D%/home/services.scm			\
   %D%/home/services/admin.scm			\
   %D%/home/services/backup.scm			\
+  %D%/home/services/containers.scm		\
   %D%/home/services/desktop.scm			\
   %D%/home/services/dict.scm			\
   %D%/home/services/dotfiles.scm		\
-- 
2.49.0





From unknown Fri Jun 13 11:55:10 2025
X-Loop: help-debbugs@gnu.org
Subject: [bug#76081] [PATCH v12 1/5] tests: oci-container: Set explicit timeouts.
References: <2f43e635-508c-407a-8309-06e75d492d89@autistici.org>
In-Reply-To: <2f43e635-508c-407a-8309-06e75d492d89@autistici.org>
Resent-From: Giacomo Leidi 
Original-Sender: "Debbugs-submit" 
Resent-CC: guix-patches@gnu.org
Resent-Date: Fri, 13 Jun 2025 18:11:08 +0000
Resent-Message-ID: 
Resent-Sender: help-debbugs@gnu.org
X-GNU-PR-Message: followup 76081
X-GNU-PR-Package: guix-patches
X-GNU-PR-Keywords: moreinfo
To: 76081@debbugs.gnu.org
Cc: Giacomo Leidi 
Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.174983825312981
          (code B ref 76081); Fri, 13 Jun 2025 18:11:08 +0000
Received: (at 76081) by debbugs.gnu.org; 13 Jun 2025 18:10:53 +0000
Received: from localhost ([127.0.0.1]:49882 helo=debbugs.gnu.org)
	by debbugs.gnu.org with esmtp (Exim 4.84_2)
	(envelope-from )
	id 1uQ8rc-0003NE-Jj
	for submit@debbugs.gnu.org; Fri, 13 Jun 2025 14:10:53 -0400
Received: from confino.investici.org ([2a11:7980:1::2:0]:33673)
 by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
 (Exim 4.84_2) (envelope-from )
 id 1uQ8rS-0003Lx-7M
 for 76081@debbugs.gnu.org; Fri, 13 Jun 2025 14:10:48 -0400
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org;
 s=stigmate; t=1749838239;
 bh=31iYOr+QZftHbsUkhDWOfy7VOLQSvIbHPJajVL0Tjio=;
 h=From:To:Cc:Subject:Date:From;
 b=PtzvdPzjXzlLCjhQbVOw1vVifATsOAiV7QL0FIMYTk1oiHEWe6SLCf6bit82zf7lG
 mbIPCQOiUazZtLaf7eAPNUySb7ZKK0jYD8Hw3hwbIIl+rJO9dTtR4UsQWaDYAZJ2be
 XsYfj4NYRJ1kn8GZL4eBhg+puKxMm1EI7wcs6xu0=
Received: from mx1.investici.org (unknown [127.0.0.1])
 by confino.investici.org (Postfix) with ESMTP id 4bJnWM1byfz110C;
 Fri, 13 Jun 2025 18:10:39 +0000 (UTC)
Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19])
 (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with
 ESMTPSA id 4bJnWM0VYGz10tj; Fri, 13 Jun 2025 18:10:39 +0000 (UTC)
From: Giacomo Leidi 
Date: Fri, 13 Jun 2025 20:10:04 +0200
Message-ID: 
X-Mailer: git-send-email 2.49.0
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
X-Spam-Score: -0.0 (/)
X-BeenThere: debbugs-submit@debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: 
List-Unsubscribe: , 
 
List-Archive: 
List-Post: 
List-Help: 
List-Subscribe: , 
 
Errors-To: debbugs-submit-bounces@debbugs.gnu.org
Sender: "Debbugs-submit" 
X-Spam-Score: -1.0 (-)

* gnu/tests/docker.scm: Simplify %test-oci-container test case and add
explicit timeouts to tests outcomes.

Signed-off-by: Giacomo Leidi 
---
 gnu/tests/docker.scm | 99 ++++++++++++++++++--------------------------
 1 file changed, 41 insertions(+), 58 deletions(-)

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 
 ;;; Copyright © 2019-2023 Ludovic Courtès 
-;;; Copyright © 2024 Giacomo Leidi 
+;;; Copyright © 2024, 2025 Giacomo Leidi 
 ;;;
 ;;; 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))))
 

base-commit: b7fc28345c8eae2fe68d0c2c740a809926c69b87
-- 
2.49.0