From patchwork Sun Jun 1 02:51:14 2025 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: paul X-Patchwork-Id: 42968 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 554D027BC4C; Sun, 1 Jun 2025 03:53:41 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-6.4 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,RCVD_IN_DNSWL_BLOCKED, RCVD_IN_VALIDITY_CERTIFIED,RCVD_IN_VALIDITY_RPBL,RCVD_IN_VALIDITY_SAFE, SPF_HELO_PASS,URIBL_BLOCKED autolearn=ham autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id AE2B727BC49 for ; Sun, 1 Jun 2025 03:53:40 +0100 (BST) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1uLYoy-0000ms-Hx; Sat, 31 May 2025 22:53:12 -0400 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 1uLYow-0000lO-F2 for guix-patches@gnu.org; Sat, 31 May 2025 22:53:10 -0400 Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1uLYow-0007Wy-6x for guix-patches@gnu.org; Sat, 31 May 2025 22:53:10 -0400 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=debbugs.gnu.org; s=debbugs-gnu-org; h=MIME-Version:Date:From:To:In-Reply-To:References:Subject; bh=ipBhomgLT0seJxYDQ3100CFNP2CVacjvVePtnZQnB4c=; b=OKji5MvDpnf7i6PsD6oq9VH1NgsAbOiKKPf8scUoJiFlLiLuRimWW5bHp5QOZ73qerzpqU8g4VUEq9FljSK+hZgn4CT/xWQ7+c3B4HQYg+UlHiXNQKJXWEap2CNx0wvXgkJlrZwwGkjp6GeXliDkpTCJDwZKRU8t8lQSCyd/sVETyDvNn3u8qtJhmN7yHt+WTv8Bp2gXtp+3gmSSqImRoFchEgP9c6NtCn43RMWrKpiGzSUXgyBjtFVVIDOMyU7yWD1sUsrq7Idzu4LyipdJEgc3MeIVhX8TBDlKvAt5my8R8foGQ8RdYtGHpvWlGxl9vOxQQk5iEd8uf2Hx6nCL8A==; Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1uLYov-0005s5-PA for guix-patches@gnu.org; Sat, 31 May 2025 22:53:09 -0400 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) 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 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Reply-to: Giacomo Leidi X-ACL-Warn: , Giacomo Leidi via Guix-patches X-Patchwork-Original-From: Giacomo Leidi via Guix-patches via From: paul Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org X-getmail-retrieved-from-mailbox: Patches * 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(-) base-commit: e29c57ab81517424b03579147910553d92246212 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)))) From patchwork Sun Jun 1 02:51:15 2025 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: paul X-Patchwork-Id: 42967 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id E278927BC4B; Sun, 1 Jun 2025 03:53:39 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-6.4 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,RCVD_IN_DNSWL_BLOCKED, RCVD_IN_VALIDITY_CERTIFIED,RCVD_IN_VALIDITY_RPBL,RCVD_IN_VALIDITY_SAFE, SPF_HELO_PASS,URIBL_BLOCKED autolearn=ham autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 117E427BC49 for ; Sun, 1 Jun 2025 03:53:39 +0100 (BST) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1uLYp0-0000o4-TI; Sat, 31 May 2025 22:53:14 -0400 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 1uLYoz-0000nk-Qz for guix-patches@gnu.org; Sat, 31 May 2025 22:53:13 -0400 Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1uLYoz-0007X6-DT for guix-patches@gnu.org; Sat, 31 May 2025 22:53:13 -0400 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=debbugs.gnu.org; s=debbugs-gnu-org; h=MIME-Version:References:In-Reply-To:Date:From:To:Subject; bh=c0mrrjGimQg3m608YSHrWpX7CdedaBO05E2EM3xayG0=; b=oQVRqc8omGUawaSeTdh9peyIDGNjF4NRKPS+1e2Nae37N4HQkxIe3/CVW+D4HOGH/EVf4cJfPGdEgGiVaXEm+uWsh/FfNdHzVumOgQk7+MtMgsTF2psvSdltTk9Q6QU95IrCswmJfRQheuQFaXCsTR0CalY80nU/8Qlk5Ruwnvys6M16BJV1yPGCai+Nm4wLdrmRQnRzx5Hxpt6FegnVpMZ05mPUjv+dBUxIntfIYYHmT6CJIFtK71ADsk/ETIBAuYnNDQVmUNsSGfwAOcN7B0AqNy459YLL3zK3u37ypDCtT3Ad9nXr9GJA9iFVWEEJIKhs7kPYSWTRnoKPlNi5PQ==; Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1uLYoy-0005sf-UJ; Sat, 31 May 2025 22:53:12 -0400 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) 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 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Reply-to: Giacomo Leidi X-ACL-Warn: , Giacomo Leidi via Guix-patches X-Patchwork-Original-From: Giacomo Leidi via Guix-patches via From: paul Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org X-getmail-retrieved-from-mailbox: Patches 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. From patchwork Sun Jun 1 02:51:16 2025 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: paul X-Patchwork-Id: 42964 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 7089F27BC4B; Sun, 1 Jun 2025 03:52:25 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-6.4 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,RCVD_IN_DNSWL_BLOCKED, RCVD_IN_VALIDITY_CERTIFIED,RCVD_IN_VALIDITY_RPBL,RCVD_IN_VALIDITY_SAFE, SPF_HELO_PASS,URIBL_BLOCKED autolearn=ham autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id B169627BC49 for ; Sun, 1 Jun 2025 03:52:22 +0100 (BST) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1uLYny-0000dt-W9; Sat, 31 May 2025 22:52:11 -0400 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 1uLYnx-0000db-J0 for guix-patches@gnu.org; Sat, 31 May 2025 22:52:09 -0400 Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1uLYnx-0007V3-66; Sat, 31 May 2025 22:52:09 -0400 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=debbugs.gnu.org; s=debbugs-gnu-org; h=MIME-Version:References:In-Reply-To:Date:From:To:Subject; bh=nOvNzAeUUqWY56T9zoJh/y4pYUmsawjQdb7in7TRP0g=; b=ADWccXCnhhEDIt28wAd1h65fgOrifXvdXgnpN9JQiq+S6Yr6N/visDMWM/eAvTMGivzEqMlnio7FfXfzQwpuzmQT/6r4KIrTqfWMJyGfKf8/gSIIEEBegIsvZ1cwOlO/qz9eC/ruey9QmvTSh/QnUNmLju+Yx7bFsLosdvakXig/Zd0sbhLsfW6qsRFquHsJ16qPcHZG/Spbuk8PHcfkDCni8zWgZLb+l60oGrOu9xkWZRaLCzYIhVvjiNE3UAvbGjS6qdSKN/uhxgL3atLo9klHMez1njM79UMxLR3BbOLxlA3fyu8HQC0AhhYGLssdmHOGBjbonMbEMDj9Cropmw==; Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1uLYnu-0005lq-Cl; Sat, 31 May 2025 22:52:06 -0400 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) 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 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Reply-to: Giacomo Leidi X-ACL-Warn: , Giacomo Leidi via Guix-patches X-Patchwork-Original-From: Giacomo Leidi via Guix-patches via From: paul Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org X-getmail-retrieved-from-mailbox: Patches 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)))) From patchwork Sun Jun 1 02:51:17 2025 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: paul X-Patchwork-Id: 42965 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 969D727BC4B; Sun, 1 Jun 2025 03:53:16 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-6.4 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,RCVD_IN_DNSWL_BLOCKED, RCVD_IN_VALIDITY_CERTIFIED,RCVD_IN_VALIDITY_RPBL,RCVD_IN_VALIDITY_SAFE, SPF_HELO_PASS,URIBL_BLOCKED autolearn=ham autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id C336727BC49 for ; Sun, 1 Jun 2025 03:53:15 +0100 (BST) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1uLYov-0000lH-Lf; Sat, 31 May 2025 22:53:09 -0400 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 1uLYou-0000ku-38 for guix-patches@gnu.org; Sat, 31 May 2025 22:53:08 -0400 Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1uLYot-0007Wk-MD for guix-patches@gnu.org; Sat, 31 May 2025 22:53:07 -0400 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=debbugs.gnu.org; s=debbugs-gnu-org; h=MIME-Version:References:In-Reply-To:Date:From:To:Subject; bh=HxTYqulnshs6Kv1MTBcz9pDRspS9WxFXQx7igpkMtZY=; b=COj4zqgU0zYebnjgF6IGbYV2JwafR7cteypxrqxrJYCrA4ujfiHvTkwKmJkuPIC78yVeuXwg19qSr9fyh08gsjm3zrUhR8DA9WGlNWibQLI+jtB7j0yhL9aYHxCWs8qRPYkW/dYsFbsrzqsYgEbnX8MkJGdqthgkznvLMZtUM2M9+RDR0yAFqOt9YEzXGysUnmNSCJAy5n7n0D3PVLs4VU1WofMbTcTnKVrYcDZdbXQoyx5DGbMJSKLElNWJG4d0CBGD98TqURIzYa8Ak9iy86u65eTiBmn4iqh6rsLtPDXt3OCahR1LndEX3T7XwAGP3z751ZWluNkScMHFywhuhQ==; Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1uLYos-0005rr-V5 for guix-patches@gnu.org; Sat, 31 May 2025 22:53:06 -0400 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) 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 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Reply-to: Giacomo Leidi X-ACL-Warn: , Giacomo Leidi via Guix-patches X-Patchwork-Original-From: Giacomo Leidi via Guix-patches via From: paul Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org X-getmail-retrieved-from-mailbox: Patches 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 From patchwork Sun Jun 1 02:51:18 2025 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: paul X-Patchwork-Id: 42966 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 9E00A27BC4B; Sun, 1 Jun 2025 03:53:26 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-6.4 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,RCVD_IN_DNSWL_BLOCKED, RCVD_IN_VALIDITY_CERTIFIED,RCVD_IN_VALIDITY_RPBL,RCVD_IN_VALIDITY_SAFE, SPF_HELO_PASS,URIBL_BLOCKED autolearn=ham autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id D6E9327BC49 for ; Sun, 1 Jun 2025 03:53:25 +0100 (BST) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1uLYp8-0000qY-4b; Sat, 31 May 2025 22:53:22 -0400 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 1uLYp5-0000qF-Q5 for guix-patches@gnu.org; Sat, 31 May 2025 22:53:19 -0400 Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1uLYp5-0007Xp-GH; Sat, 31 May 2025 22:53:19 -0400 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=debbugs.gnu.org; s=debbugs-gnu-org; h=MIME-Version:References:In-Reply-To:Date:From:To:Subject; bh=2qABf6sNZqBZLGINotJsfcFOkpx8oaYirflqE+y8og4=; b=uMgu0NqQniuzQlaIaHiFGQW7tH/xDr6DynAG5uejKET+HrKJVfr/h3oXZeh1/5WuOZj4vfkmsZMA+97zfYdFCXoTovyyyDBX0tca3bPXWf1v3F8rfRVcTW2Lklw/q8Uj06pf9Z7nD/HcbqNT+gh6aLWi0eetLK0TmvV8+bIF/90fUQ2OQMLJe+eyykRUdh97pGwtPNBMnWfNwUieAHl8MRRFB2vEml+OKWvHUkfgJJu7ngFVzKYVjb0URT4BI6qGyMZa0S7WtCInATB1RutVkfXuloN8XXfpkGqeKJXWOGLmnaW6HlCFTbVph6M3qU1AYNXXikzlDIngHnpeu4htnw==; Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1uLYp3-0005tR-7p; Sat, 31 May 2025 22:53:17 -0400 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) 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 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Reply-to: Giacomo Leidi X-ACL-Warn: , Giacomo Leidi via Guix-patches X-Patchwork-Original-From: Giacomo Leidi via Guix-patches via From: paul Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org X-getmail-retrieved-from-mailbox: Patches * 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 \