From patchwork Sun Mar 9 01:06:12 2025 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Giacomo Leidi X-Patchwork-Id: 39954 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 1FC9C27BBE9; Sun, 9 Mar 2025 01:07:53 +0000 (GMT) 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=unavailable 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 08C2327BBE2 for ; Sun, 9 Mar 2025 01:07:50 +0000 (GMT) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1tr58K-0007yu-3a; Sat, 08 Mar 2025 20:07:12 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1tr58D-0007sz-4e for guix-patches@gnu.org; Sat, 08 Mar 2025 20:07:05 -0500 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 1tr58C-0003tt-QS for guix-patches@gnu.org; Sat, 08 Mar 2025 20:07:04 -0500 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=5w1pguUy5euk/p6I7KBfaqhA/lWVRKQOsLxduTGYZqY=; b=OdAkvj5wy/tQpSwfcADY1t8DANGk21PoakNbdgAh8oj4P7OEe9OquLKpdu125WQJ50FomZzELJ76vUfR8+5ensHa2OkVMJalr6mIav5g4NSuOH7VKTciADlUaAXnMRIwdXYC0IXBqvySLfFZq3KdG8d44gQKxXYnLusQWJ0Pq3p4RMrqm+RjRD7+QtW/QYf9a6DROEHi9iR/rfOh2a9k1kxWpyL/XnMtYAaUVFLCE43Ogeu8fFO3Q07bsrgEPVKZKKZVz1+OZLqgxHI5ND5QrLtS89tlpjtRsQxVooR/BZQQ98RFwcLakdzst4w/3WUAcDJetep+dlu2QTM71jXH0w==; Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1tr58C-0000LB-L3 for guix-patches@gnu.org; Sat, 08 Mar 2025 20:07:04 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#76081] [PATCH v8 2/5] services: oci-container-configuration: Move to (gnu services containers). Resent-From: Giacomo Leidi Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sun, 09 Mar 2025 01:07:04 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 76081 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: To: 76081@debbugs.gnu.org Cc: Giacomo Leidi Received: via spool by 76081-submit@debbugs.gnu.org id=B76081.17414824011235 (code B ref 76081); Sun, 09 Mar 2025 01:07:04 +0000 Received: (at 76081) by debbugs.gnu.org; 9 Mar 2025 01:06:41 +0000 Received: from localhost ([127.0.0.1]:57388 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1tr57n-0000Jp-6E for submit@debbugs.gnu.org; Sat, 08 Mar 2025 20:06:41 -0500 Received: from confino.investici.org ([2a11:7980:1::2:0]:50417) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1tr57Z-0000IZ-Cd for 76081@debbugs.gnu.org; Sat, 08 Mar 2025 20:06:29 -0500 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=autistici.org; s=stigmate; t=1741482383; bh=5w1pguUy5euk/p6I7KBfaqhA/lWVRKQOsLxduTGYZqY=; h=From:To:Cc:Subject:Date:In-Reply-To:References:From; b=n6AxZ2HVYVPW9xmWASiPyYFkZMXDVQPI+Z6E0N4Mj2UpzghD1hWHVAxjibPFf2kWC 18KAR1PFcP+yb4LCJcfH/uSshfifcqv1LQGSVzvFnLumUFAICn2moaRqI3HFNjxyY0 P/crJdliXiMElEevKxI6Y5b2Tof4QvDmZgN6TXmg= Received: from mx1.investici.org (unknown [127.0.0.1]) by confino.investici.org (Postfix) with ESMTP id 4Z9MKq0TGnz11NQ; Sun, 9 Mar 2025 01:06:23 +0000 (UTC) Received: from [93.190.126.19] (mx1.investici.org [93.190.126.19]) (Authenticated sender: goodoldpaul@autistici.org) by localhost (Postfix) with ESMTPSA id 4Z9MKp6Ctmz11NJ; Sun, 9 Mar 2025 01:06:22 +0000 (UTC) Date: Sun, 9 Mar 2025 02:06:12 +0100 Message-ID: <5ea9ef46b656b23c6213ec086084fd572b10816a.1741482375.git.goodoldpaul@autistici.org> X-Mailer: git-send-email 2.48.1 In-Reply-To: <36e9d9e4474b8d547a86a0225e89f0039af39970.1741482375.git.goodoldpaul@autistici.org> References: <36e9d9e4474b8d547a86a0225e89f0039af39970.1741482375.git.goodoldpaul@autistici.org> MIME-Version: 1.0 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: Giacomo Leidi 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 the oci-container-configuration and related configuration records to (gnu services containers). Public symbols are still exported for backwards compatibility but since the oci-container-service-type will be deprecated in favor of the more general oci-service-type, everything is moved outside of the docker related module. * gnu/services/docker.scm: Move everything related to oci-container-configuration to... * gnu/services/containers.scm: ...here.scm. * gnu/tests/docker.scm: Simplify %test-oci-container test case. Change-Id: Iae599dd5cc7442eb632f0c1b3b12f6b928397ae7 --- gnu/services/containers.scm | 549 +++++++++++++++++++++++++++++++++- gnu/services/docker.scm | 577 +++--------------------------------- gnu/tests/docker.scm | 99 +++---- 3 files changed, 625 insertions(+), 600 deletions(-) diff --git a/gnu/services/containers.scm b/gnu/services/containers.scm index d5a211765a6..24f31c756b8 100644 --- a/gnu/services/containers.scm +++ b/gnu/services/containers.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2024 Giacomo Leidi +;;; Copyright © 2024, 2025 Giacomo Leidi ;;; ;;; This file is part of GNU Guix. ;;; @@ -17,19 +17,31 @@ ;;; along with GNU Guix. If not, see . (define-module (gnu services containers) + #:use-module (gnu image) + #:use-module (gnu packages admin) #:use-module (gnu packages bash) #:use-module (gnu packages containers) + #:use-module (gnu packages docker) #:use-module (gnu packages file-systems) #:use-module (gnu services) #:use-module (gnu services base) #:use-module (gnu services configuration) #:use-module (gnu services shepherd) + #:use-module (gnu system) #:use-module (gnu system accounts) + #:use-module (gnu system image) #:use-module (gnu system shadow) #:use-module (gnu system pam) + #:use-module (guix diagnostics) #:use-module (guix gexp) + #:use-module (guix i18n) + #:use-module (guix monads) #:use-module (guix packages) + #:use-module (guix profiles) + #:use-module ((guix scripts pack) #:prefix pack:) + #:use-module (guix store) #:use-module (srfi srfi-1) + #:use-module (ice-9 match) #:export (rootless-podman-configuration rootless-podman-configuration? rootless-podman-configuration-fields @@ -48,7 +60,44 @@ (define-module (gnu services containers) rootless-podman-shepherd-services rootless-podman-service-etc - rootless-podman-service-type)) + rootless-podman-service-type + + oci-image + oci-image? + oci-image-fields + oci-image-repository + oci-image-tag + oci-image-value + oci-image-pack-options + oci-image-target + oci-image-system + oci-image-grafts? + + oci-container-configuration + oci-container-configuration? + oci-container-configuration-fields + oci-container-configuration-user + oci-container-configuration-group + oci-container-configuration-command + oci-container-configuration-entrypoint + oci-container-configuration-host-environment + oci-container-configuration-environment + oci-container-configuration-image + oci-container-configuration-provision + oci-container-configuration-requirement + oci-container-configuration-log-file + oci-container-configuration-auto-start? + oci-container-configuration-respawn? + oci-container-configuration-shepherd-actions + oci-container-configuration-network + oci-container-configuration-ports + oci-container-configuration-volumes + oci-container-configuration-container-user + oci-container-configuration-workdir + oci-container-configuration-extra-arguments + + oci-container-shepherd-service + %oci-container-accounts)) (define (gexp-or-string? value) (or (gexp? value) @@ -190,7 +239,7 @@ (define (rootless-podman-cgroups-limits-service config) rootless-podman-shared-root-fs)) (one-shot? #t) (documentation - "Allow setting cgroups limits: cpu, cpuset, memory and + "Allow setting cgroups limits: cpu, cpuset, io, memory and pids.") (start #~(make-forkexec-constructor @@ -244,3 +293,497 @@ (define rootless-podman-service-type (default-value (rootless-podman-configuration)) (description "This service configures rootless @code{podman} on the Guix System."))) + + +;;; +;;; OCI container. +;;; + +(define (oci-sanitize-pair pair delimiter) + (define (valid? member) + (or (string? member) + (gexp? member) + (file-like? member))) + (match pair + (((? valid? key) . (? valid? value)) + #~(string-append #$key #$delimiter #$value)) + (_ + (raise + (formatted-message + (G_ "pair members must contain only strings, gexps or file-like objects +but ~a was found") + pair))))) + +(define (oci-sanitize-mixed-list name value delimiter) + (map + (lambda (el) + (cond ((string? el) el) + ((pair? el) (oci-sanitize-pair el delimiter)) + (else + (raise + (formatted-message + (G_ "~a members must be either a string or a pair but ~a was +found!") + name el))))) + value)) + +(define (oci-sanitize-host-environment value) + ;; Expected spec format: + ;; '(("HOME" . "/home/nobody") "JAVA_HOME=/java") + (oci-sanitize-mixed-list "host-environment" value "=")) + +(define (oci-sanitize-environment value) + ;; Expected spec format: + ;; '(("HOME" . "/home/nobody") "JAVA_HOME=/java") + (oci-sanitize-mixed-list "environment" value "=")) + +(define (oci-sanitize-ports value) + ;; Expected spec format: + ;; '(("8088" . "80") "2022:22") + (oci-sanitize-mixed-list "ports" value ":")) + +(define (oci-sanitize-volumes value) + ;; Expected spec format: + ;; '(("/mnt/dir" . "/dir") "/run/current-system/profile:/java") + (oci-sanitize-mixed-list "volumes" value ":")) + +(define (oci-sanitize-shepherd-actions value) + (map + (lambda (el) + (if (shepherd-action? el) + el + (raise + (formatted-message + (G_ "shepherd-actions may only be shepherd-action records +but ~a was found") el)))) + value)) + +(define (oci-sanitize-extra-arguments value) + (define (valid? member) + (or (string? member) + (gexp? member) + (file-like? member))) + (map + (lambda (el) + (if (valid? el) + el + (raise + (formatted-message + (G_ "extra arguments may only be strings, gexps or file-like objects +but ~a was found") el)))) + value)) + +(define (oci-image-reference image) + (if (string? image) + image + (string-append (oci-image-repository image) + ":" (oci-image-tag image)))) + +(define (oci-lowerable-image? image) + (or (manifest? image) + (operating-system? image) + (gexp? image) + (file-like? image))) + +(define (string-or-oci-image? image) + (or (string? image) + (oci-image? image))) + +(define list-of-symbols? + (list-of symbol?)) + +(define-maybe/no-serialization string) + +(define-configuration/no-serialization oci-image + (repository + (string) + "A string like @code{myregistry.local:5000/testing/test-image} that names +the OCI image.") + (tag + (string "latest") + "A string representing the OCI image tag. Defaults to @code{latest}.") + (value + (oci-lowerable-image) + "A @code{manifest} or @code{operating-system} record that will be lowered +into an OCI compatible tarball. Otherwise this field's value can be a gexp +or a file-like object that evaluates to an OCI compatible tarball.") + (pack-options + (list '()) + "An optional set of keyword arguments that will be passed to the +@code{docker-image} procedure from @code{guix scripts pack}. They can be used +to replicate @command{guix pack} behavior: + +@lisp +(oci-image + (repository \"guile\") + (tag \"3\") + (manifest (specifications->manifest '(\"guile\"))) + (pack-options + '(#:symlinks ((\"/bin/guile\" -> \"bin/guile\")) + #:max-layers 2))) +@end lisp + +If the @code{value} field is an @code{operating-system} record, this field's +value will be ignored.") + (system + (maybe-string) + "Attempt to build for a given system, e.g. \"i686-linux\"") + (target + (maybe-string) + "Attempt to cross-build for a given triple, e.g. \"aarch64-linux-gnu\"") + (grafts? + (boolean #f) + "Whether to allow grafting or not in the pack build.")) + +(define-configuration/no-serialization oci-container-configuration + (user + (string "oci-container") + "The user under whose authority docker commands will be run.") + (group + (string "docker") + "The group under whose authority docker commands will be run.") + (command + (list-of-strings '()) + "Overwrite the default command (@code{CMD}) of the image.") + (entrypoint + (maybe-string) + "Overwrite the default entrypoint (@code{ENTRYPOINT}) of the image.") + (host-environment + (list '()) + "Set environment variables in the host environment where @command{docker run} +is invoked. This is especially useful to pass secrets from the host to the +container without having them on the @command{docker run}'s command line: by +setting the @code{MYSQL_PASSWORD} on the host and by passing +@code{--env MYSQL_PASSWORD} through the @code{extra-arguments} field, it is +possible to securely set values in the container environment. This field's +value can be a list of pairs or strings, even mixed: + +@lisp +(list '(\"LANGUAGE\" . \"eo:ca:eu\") + \"JAVA_HOME=/opt/java\") +@end lisp + +Pair members can be strings, gexps or file-like objects. Strings are passed +directly to @code{make-forkexec-constructor}." + (sanitizer oci-sanitize-host-environment)) + (environment + (list '()) + "Set environment variables inside the container. This can be a list of pairs +or strings, even mixed: + +@lisp +(list '(\"LANGUAGE\" . \"eo:ca:eu\") + \"JAVA_HOME=/opt/java\") +@end lisp + +Pair members can be strings, gexps or file-like objects. Strings are passed +directly to the Docker CLI. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run/#env,upstream} +documentation for semantics." + (sanitizer oci-sanitize-environment)) + (image + (string-or-oci-image) + "The image used to build the container. It can be a string or an +@code{oci-image} record. Strings are resolved by the Docker +Engine, and follow the usual format +@code{myregistry.local:5000/testing/test-image:tag}.") + (provision + (maybe-string) + "Set the name of the provisioned Shepherd service.") + (requirement + (list-of-symbols '()) + "Set additional Shepherd services dependencies to the provisioned Shepherd +service.") + (log-file + (maybe-string) + "When @code{log-file} is set, it names the file to which the service’s +standard output and standard error are redirected. @code{log-file} is created +if it does not exist, otherwise it is appended to.") + (auto-start? + (boolean #t) + "Whether this service should be started automatically by the Shepherd. If it +is @code{#f} the service has to be started manually with @command{herd start}.") + (respawn? + (boolean #f) + "Whether to restart the service when it stops, for instance when the +underlying process dies.") + (shepherd-actions + (list '()) + "This is a list of @code{shepherd-action} records defining actions supported +by the service." + (sanitizer oci-sanitize-shepherd-actions)) + (network + (maybe-string) + "Set a Docker network for the spawned container.") + (ports + (list '()) + "Set the port or port ranges to expose from the spawned container. This can +be a list of pairs or strings, even mixed: + +@lisp +(list '(\"8080\" . \"80\") + \"10443:443\") +@end lisp + +Pair members can be strings, gexps or file-like objects. Strings are passed +directly to the Docker CLI. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run/#publish,upstream} +documentation for semantics." + (sanitizer oci-sanitize-ports)) + (volumes + (list '()) + "Set volume mappings for the spawned container. This can be a +list of pairs or strings, even mixed: + +@lisp +(list '(\"/root/data/grafana\" . \"/var/lib/grafana\") + \"/gnu/store:/gnu/store\") +@end lisp + +Pair members can be strings, gexps or file-like objects. Strings are passed +directly to the Docker CLI. You can refer to the +@url{https://docs.docker.com/engine/reference/commandline/run/#volume,upstream} +documentation for semantics." + (sanitizer oci-sanitize-volumes)) + (container-user + (maybe-string) + "Set the current user inside the spawned container. You can refer to the +@url{https://docs.docker.com/engine/reference/run/#user,upstream} +documentation for semantics.") + (workdir + (maybe-string) + "Set the current working for the spawned Shepherd service. +You can refer to the +@url{https://docs.docker.com/engine/reference/run/#workdir,upstream} +documentation for semantics.") + (extra-arguments + (list '()) + "A list of strings, gexps or file-like objects that will be directly passed +to the @command{docker run} invokation." + (sanitizer oci-sanitize-extra-arguments))) + +(define oci-container-configuration->options + (lambda (config) + (let ((entrypoint + (oci-container-configuration-entrypoint config)) + (network + (oci-container-configuration-network config)) + (user + (oci-container-configuration-container-user config)) + (workdir + (oci-container-configuration-workdir config))) + (apply append + (filter (compose not unspecified?) + `(,(if (maybe-value-set? entrypoint) + `("--entrypoint" ,entrypoint) + '()) + ,(append-map + (lambda (spec) + (list "--env" spec)) + (oci-container-configuration-environment config)) + ,(if (maybe-value-set? network) + `("--network" ,network) + '()) + ,(if (maybe-value-set? user) + `("--user" ,user) + '()) + ,(if (maybe-value-set? workdir) + `("--workdir" ,workdir) + '()) + ,(append-map + (lambda (spec) + (list "-p" spec)) + (oci-container-configuration-ports config)) + ,(append-map + (lambda (spec) + (list "-v" spec)) + (oci-container-configuration-volumes config)))))))) + +(define* (get-keyword-value args keyword #:key (default #f)) + (let ((kv (memq keyword args))) + (if (and kv (>= (length kv) 2)) + (cadr kv) + default))) + +(define (lower-operating-system os target system) + (mlet* %store-monad + ((tarball + (lower-object + (system-image (os->image os #:type docker-image-type)) + system + #:target target))) + (return tarball))) + +(define (lower-manifest name image target system) + (define value (oci-image-value image)) + (define options (oci-image-pack-options image)) + (define image-reference + (oci-image-reference image)) + (define image-tag + (let* ((extra-options + (get-keyword-value options #:extra-options)) + (image-tag-option + (and extra-options + (get-keyword-value extra-options #:image-tag)))) + (if image-tag-option + '() + `(#:extra-options (#:image-tag ,image-reference))))) + + (mlet* %store-monad + ((_ (set-grafting + (oci-image-grafts? image))) + (guile (set-guile-for-build (default-guile))) + (profile + (profile-derivation value + #:target target + #:system system + #:hooks '() + #:locales? #f)) + (tarball (apply pack:docker-image + `(,name ,profile + ,@options + ,@image-tag + #:localstatedir? #t)))) + (return tarball))) + +(define (lower-oci-image name image) + (define value (oci-image-value image)) + (define image-target (oci-image-target image)) + (define image-system (oci-image-system image)) + (define target + (if (maybe-value-set? image-target) + image-target + (%current-target-system))) + (define system + (if (maybe-value-set? image-system) + image-system + (%current-system))) + (with-store store + (run-with-store store + (match value + ((? manifest? value) + (lower-manifest name image target system)) + ((? operating-system? value) + (lower-operating-system value target system)) + ((or (? gexp? value) + (? file-like? value)) + value) + (_ + (raise + (formatted-message + (G_ "oci-image value must contain only manifest, +operating-system, gexp or file-like records but ~a was found") + value)))) + #:target target + #:system system))) + +(define (%oci-image-loader name image tag) + (let ((docker (file-append docker-cli "/bin/docker")) + (tarball (lower-oci-image name image))) + (with-imported-modules '((guix build utils)) + (program-file (format #f "~a-image-loader" name) + #~(begin + (use-modules (guix build utils) + (ice-9 popen) + (ice-9 rdelim)) + + (format #t "Loading image for ~a from ~a...~%" #$name #$tarball) + (define line + (read-line + (open-input-pipe + (string-append #$docker " load -i " #$tarball)))) + + (unless (or (eof-object? line) + (string-null? line)) + (format #t "~a~%" line) + (let ((repository&tag + (string-drop line + (string-length + "Loaded image: ")))) + + (invoke #$docker "tag" repository&tag #$tag) + (format #t "Tagged ~a with ~a...~%" #$tarball #$tag)))))))) + +(define (oci-container-shepherd-service config) + (define (guess-name name image) + (if (maybe-value-set? name) + name + (string-append "docker-" + (basename + (if (string? image) + (first (string-split image #\:)) + (oci-image-repository image)))))) + + (let* ((docker (file-append docker-cli "/bin/docker")) + (actions (oci-container-configuration-shepherd-actions config)) + (auto-start? + (oci-container-configuration-auto-start? config)) + (user (oci-container-configuration-user config)) + (group (oci-container-configuration-group config)) + (host-environment + (oci-container-configuration-host-environment config)) + (command (oci-container-configuration-command config)) + (log-file (oci-container-configuration-log-file config)) + (provision (oci-container-configuration-provision config)) + (requirement (oci-container-configuration-requirement config)) + (respawn? + (oci-container-configuration-respawn? config)) + (image (oci-container-configuration-image config)) + (image-reference (oci-image-reference image)) + (options (oci-container-configuration->options config)) + (name (guess-name provision image)) + (extra-arguments + (oci-container-configuration-extra-arguments config))) + + (shepherd-service (provision `(,(string->symbol name))) + (requirement `(dockerd user-processes ,@requirement)) + (respawn? respawn?) + (auto-start? auto-start?) + (documentation + (string-append + "Docker backed Shepherd service for " + (if (oci-image? image) name image) ".")) + (start + #~(lambda () + #$@(if (oci-image? image) + #~((invoke #$(%oci-image-loader + name image image-reference))) + #~()) + (fork+exec-command + ;; docker run [OPTIONS] IMAGE [COMMAND] [ARG...] + (list #$docker "run" "--rm" "--name" #$name + #$@options #$@extra-arguments + #$image-reference #$@command) + #:user #$user + #:group #$group + #$@(if (maybe-value-set? log-file) + (list #:log-file log-file) + '()) + #:environment-variables + (list #$@host-environment)))) + (stop + #~(lambda _ + (invoke #$docker "rm" "-f" #$name))) + (actions + (if (oci-image? image) + '() + (append + (list + (shepherd-action + (name 'pull) + (documentation + (format #f "Pull ~a's image (~a)." + name image)) + (procedure + #~(lambda _ + (invoke #$docker "pull" #$image))))) + actions)))))) + +(define %oci-container-accounts + (list (user-account + (name "oci-container") + (comment "OCI services account") + (group "docker") + (system? #t) + (home-directory "/var/empty") + (shell (file-append shadow "/sbin/nologin"))))) diff --git a/gnu/services/docker.scm b/gnu/services/docker.scm index 9ab3e583345..828ceea313a 100644 --- a/gnu/services/docker.scm +++ b/gnu/services/docker.scm @@ -5,7 +5,7 @@ ;;; Copyright © 2020 Efraim Flashner ;;; Copyright © 2020 Jesse Dowell ;;; Copyright © 2021 Brice Waegeneire -;;; Copyright © 2023, 2024 Giacomo Leidi +;;; Copyright © 2023, 2024, 2025 Giacomo Leidi ;;; ;;; This file is part of GNU Guix. ;;; @@ -23,72 +23,60 @@ ;;; along with GNU Guix. If not, see . (define-module (gnu services docker) - #:use-module (gnu image) #:use-module (gnu services) #:use-module (gnu services configuration) - #:use-module (gnu services base) - #:use-module (gnu services dbus) + #:use-module (gnu services containers) #:use-module (gnu services shepherd) - #:use-module (gnu system) - #:use-module (gnu system image) #:use-module (gnu system privilege) #:use-module (gnu system shadow) - #:use-module (gnu packages admin) ;shadow #:use-module (gnu packages docker) #:use-module (gnu packages linux) ;singularity - #:use-module (guix records) - #:use-module (guix diagnostics) #:use-module (guix gexp) - #:use-module (guix i18n) - #:use-module (guix monads) - #:use-module (guix packages) - #:use-module (guix profiles) - #:use-module ((guix scripts pack) #:prefix pack:) - #:use-module (guix store) + #:use-module (guix records) #:use-module (srfi srfi-1) #:use-module (ice-9 format) #:use-module (ice-9 match) + #:re-export (oci-image ;for backwards compatibility, until the + oci-image? ;oci-container-service-type is fully deprecated + oci-image-fields + oci-image-repository + oci-image-tag + oci-image-value + oci-image-pack-options + oci-image-target + oci-image-system + oci-image-grafts? + oci-container-configuration + oci-container-configuration? + oci-container-configuration-fields + oci-container-configuration-user + oci-container-configuration-group + oci-container-configuration-command + oci-container-configuration-entrypoint + oci-container-configuration-host-environment + oci-container-configuration-environment + oci-container-configuration-image + oci-container-configuration-provision + oci-container-configuration-requirement + oci-container-configuration-log-file + oci-container-configuration-auto-start? + oci-container-configuration-respawn? + oci-container-configuration-shepherd-actions + oci-container-configuration-network + oci-container-configuration-ports + oci-container-configuration-volumes + oci-container-configuration-container-user + oci-container-configuration-workdir + oci-container-configuration-extra-arguments + oci-container-shepherd-service + %oci-container-accounts) #:export (containerd-configuration containerd-service-type docker-configuration docker-service-type singularity-service-type - oci-image - oci-image? - oci-image-fields - oci-image-repository - oci-image-tag - oci-image-value - oci-image-pack-options - oci-image-target - oci-image-system - oci-image-grafts? - oci-container-configuration - oci-container-configuration? - oci-container-configuration-fields - oci-container-configuration-user - oci-container-configuration-group - oci-container-configuration-command - oci-container-configuration-entrypoint - oci-container-configuration-host-environment - oci-container-configuration-environment - oci-container-configuration-image - oci-container-configuration-provision - oci-container-configuration-requirement - oci-container-configuration-log-file - oci-container-configuration-auto-start? - oci-container-configuration-respawn? - oci-container-configuration-shepherd-actions - oci-container-configuration-network - oci-container-configuration-ports - oci-container-configuration-volumes - oci-container-configuration-container-user - oci-container-configuration-workdir - oci-container-configuration-extra-arguments - oci-container-service-type - oci-container-shepherd-service - %oci-container-accounts)) + oci-container-service-type)) (define-maybe file-like) @@ -309,495 +297,6 @@ (define singularity-service-type ;;; OCI container. ;;; -(define (oci-sanitize-pair pair delimiter) - (define (valid? member) - (or (string? member) - (gexp? member) - (file-like? member))) - (match pair - (((? valid? key) . (? valid? value)) - #~(string-append #$key #$delimiter #$value)) - (_ - (raise - (formatted-message - (G_ "pair members must contain only strings, gexps or file-like objects -but ~a was found") - pair))))) - -(define (oci-sanitize-mixed-list name value delimiter) - (map - (lambda (el) - (cond ((string? el) el) - ((pair? el) (oci-sanitize-pair el delimiter)) - (else - (raise - (formatted-message - (G_ "~a members must be either a string or a pair but ~a was -found!") - name el))))) - value)) - -(define (oci-sanitize-host-environment value) - ;; Expected spec format: - ;; '(("HOME" . "/home/nobody") "JAVA_HOME=/java") - (oci-sanitize-mixed-list "host-environment" value "=")) - -(define (oci-sanitize-environment value) - ;; Expected spec format: - ;; '(("HOME" . "/home/nobody") "JAVA_HOME=/java") - (oci-sanitize-mixed-list "environment" value "=")) - -(define (oci-sanitize-ports value) - ;; Expected spec format: - ;; '(("8088" . "80") "2022:22") - (oci-sanitize-mixed-list "ports" value ":")) - -(define (oci-sanitize-volumes value) - ;; Expected spec format: - ;; '(("/mnt/dir" . "/dir") "/run/current-system/profile:/java") - (oci-sanitize-mixed-list "volumes" value ":")) - -(define (oci-sanitize-shepherd-actions value) - (map - (lambda (el) - (if (shepherd-action? el) - el - (raise - (formatted-message - (G_ "shepherd-actions may only be shepherd-action records -but ~a was found") el)))) - value)) - -(define (oci-sanitize-extra-arguments value) - (define (valid? member) - (or (string? member) - (gexp? member) - (file-like? member))) - (map - (lambda (el) - (if (valid? el) - el - (raise - (formatted-message - (G_ "extra arguments may only be strings, gexps or file-like objects -but ~a was found") el)))) - value)) - -(define (oci-image-reference image) - (if (string? image) - image - (string-append (oci-image-repository image) - ":" (oci-image-tag image)))) - -(define (oci-lowerable-image? image) - (or (manifest? image) - (operating-system? image) - (gexp? image) - (file-like? image))) - -(define (string-or-oci-image? image) - (or (string? image) - (oci-image? image))) - -(define list-of-symbols? - (list-of symbol?)) - -(define-maybe/no-serialization string) - -(define-configuration/no-serialization oci-image - (repository - (string) - "A string like @code{myregistry.local:5000/testing/test-image} that names -the OCI image.") - (tag - (string "latest") - "A string representing the OCI image tag. Defaults to @code{latest}.") - (value - (oci-lowerable-image) - "A @code{manifest} or @code{operating-system} record that will be lowered -into an OCI compatible tarball. Otherwise this field's value can be a gexp -or a file-like object that evaluates to an OCI compatible tarball.") - (pack-options - (list '()) - "An optional set of keyword arguments that will be passed to the -@code{docker-image} procedure from @code{guix scripts pack}. They can be used -to replicate @command{guix pack} behavior: - -@lisp -(oci-image - (repository \"guile\") - (tag \"3\") - (manifest (specifications->manifest '(\"guile\"))) - (pack-options - '(#:symlinks ((\"/bin/guile\" -> \"bin/guile\")) - #:max-layers 2))) -@end lisp - -If the @code{value} field is an @code{operating-system} record, this field's -value will be ignored.") - (system - (maybe-string) - "Attempt to build for a given system, e.g. \"i686-linux\"") - (target - (maybe-string) - "Attempt to cross-build for a given triple, e.g. \"aarch64-linux-gnu\"") - (grafts? - (boolean #f) - "Whether to allow grafting or not in the pack build.")) - -(define-configuration/no-serialization oci-container-configuration - (user - (string "oci-container") - "The user under whose authority docker commands will be run.") - (group - (string "docker") - "The group under whose authority docker commands will be run.") - (command - (list-of-strings '()) - "Overwrite the default command (@code{CMD}) of the image.") - (entrypoint - (maybe-string) - "Overwrite the default entrypoint (@code{ENTRYPOINT}) of the image.") - (host-environment - (list '()) - "Set environment variables in the host environment where @command{docker run} -is invoked. This is especially useful to pass secrets from the host to the -container without having them on the @command{docker run}'s command line: by -setting the @code{MYSQL_PASSWORD} on the host and by passing -@code{--env MYSQL_PASSWORD} through the @code{extra-arguments} field, it is -possible to securely set values in the container environment. This field's -value can be a list of pairs or strings, even mixed: - -@lisp -(list '(\"LANGUAGE\" . \"eo:ca:eu\") - \"JAVA_HOME=/opt/java\") -@end lisp - -Pair members can be strings, gexps or file-like objects. Strings are passed -directly to @code{make-forkexec-constructor}." - (sanitizer oci-sanitize-host-environment)) - (environment - (list '()) - "Set environment variables inside the container. This can be a list of pairs -or strings, even mixed: - -@lisp -(list '(\"LANGUAGE\" . \"eo:ca:eu\") - \"JAVA_HOME=/opt/java\") -@end lisp - -Pair members can be strings, gexps or file-like objects. Strings are passed -directly to the Docker CLI. You can refer to the -@url{https://docs.docker.com/engine/reference/commandline/run/#env,upstream} -documentation for semantics." - (sanitizer oci-sanitize-environment)) - (image - (string-or-oci-image) - "The image used to build the container. It can be a string or an -@code{oci-image} record. Strings are resolved by the Docker -Engine, and follow the usual format -@code{myregistry.local:5000/testing/test-image:tag}.") - (provision - (maybe-string) - "Set the name of the provisioned Shepherd service.") - (requirement - (list-of-symbols '()) - "Set additional Shepherd services dependencies to the provisioned Shepherd -service.") - (log-file - (maybe-string) - "When @code{log-file} is set, it names the file to which the service’s -standard output and standard error are redirected. @code{log-file} is created -if it does not exist, otherwise it is appended to.") - (auto-start? - (boolean #t) - "Whether this service should be started automatically by the Shepherd. If it -is @code{#f} the service has to be started manually with @command{herd start}.") - (respawn? - (boolean #f) - "Whether to restart the service when it stops, for instance when the -underlying process dies.") - (shepherd-actions - (list '()) - "This is a list of @code{shepherd-action} records defining actions supported -by the service." - (sanitizer oci-sanitize-shepherd-actions)) - (network - (maybe-string) - "Set a Docker network for the spawned container.") - (ports - (list '()) - "Set the port or port ranges to expose from the spawned container. This can -be a list of pairs or strings, even mixed: - -@lisp -(list '(\"8080\" . \"80\") - \"10443:443\") -@end lisp - -Pair members can be strings, gexps or file-like objects. Strings are passed -directly to the Docker CLI. You can refer to the -@url{https://docs.docker.com/engine/reference/commandline/run/#publish,upstream} -documentation for semantics." - (sanitizer oci-sanitize-ports)) - (volumes - (list '()) - "Set volume mappings for the spawned container. This can be a -list of pairs or strings, even mixed: - -@lisp -(list '(\"/root/data/grafana\" . \"/var/lib/grafana\") - \"/gnu/store:/gnu/store\") -@end lisp - -Pair members can be strings, gexps or file-like objects. Strings are passed -directly to the Docker CLI. You can refer to the -@url{https://docs.docker.com/engine/reference/commandline/run/#volume,upstream} -documentation for semantics." - (sanitizer oci-sanitize-volumes)) - (container-user - (maybe-string) - "Set the current user inside the spawned container. You can refer to the -@url{https://docs.docker.com/engine/reference/run/#user,upstream} -documentation for semantics.") - (workdir - (maybe-string) - "Set the current working for the spawned Shepherd service. -You can refer to the -@url{https://docs.docker.com/engine/reference/run/#workdir,upstream} -documentation for semantics.") - (extra-arguments - (list '()) - "A list of strings, gexps or file-like objects that will be directly passed -to the @command{docker run} invocation." - (sanitizer oci-sanitize-extra-arguments))) - -(define oci-container-configuration->options - (lambda (config) - (let ((entrypoint - (oci-container-configuration-entrypoint config)) - (network - (oci-container-configuration-network config)) - (user - (oci-container-configuration-container-user config)) - (workdir - (oci-container-configuration-workdir config))) - (apply append - (filter (compose not unspecified?) - `(,(if (maybe-value-set? entrypoint) - `("--entrypoint" ,entrypoint) - '()) - ,(append-map - (lambda (spec) - (list "--env" spec)) - (oci-container-configuration-environment config)) - ,(if (maybe-value-set? network) - `("--network" ,network) - '()) - ,(if (maybe-value-set? user) - `("--user" ,user) - '()) - ,(if (maybe-value-set? workdir) - `("--workdir" ,workdir) - '()) - ,(append-map - (lambda (spec) - (list "-p" spec)) - (oci-container-configuration-ports config)) - ,(append-map - (lambda (spec) - (list "-v" spec)) - (oci-container-configuration-volumes config)))))))) - -(define* (get-keyword-value args keyword #:key (default #f)) - (let ((kv (memq keyword args))) - (if (and kv (>= (length kv) 2)) - (cadr kv) - default))) - -(define (lower-operating-system os target system) - (mlet* %store-monad - ((tarball - (lower-object - (system-image (os->image os #:type docker-image-type)) - system - #:target target))) - (return tarball))) - -(define (lower-manifest name image target system) - (define value (oci-image-value image)) - (define options (oci-image-pack-options image)) - (define image-reference - (oci-image-reference image)) - (define image-tag - (let* ((extra-options - (get-keyword-value options #:extra-options)) - (image-tag-option - (and extra-options - (get-keyword-value extra-options #:image-tag)))) - (if image-tag-option - '() - `(#:extra-options (#:image-tag ,image-reference))))) - - (mlet* %store-monad - ((_ (set-grafting - (oci-image-grafts? image))) - (guile (set-guile-for-build (default-guile))) - (profile - (profile-derivation value - #:target target - #:system system - #:hooks '() - #:locales? #f)) - (tarball (apply pack:docker-image - `(,name ,profile - ,@options - ,@image-tag - #:localstatedir? #t)))) - (return tarball))) - -(define (lower-oci-image name image) - (define value (oci-image-value image)) - (define image-target (oci-image-target image)) - (define image-system (oci-image-system image)) - (define target - (if (maybe-value-set? image-target) - image-target - (%current-target-system))) - (define system - (if (maybe-value-set? image-system) - image-system - (%current-system))) - (with-store store - (run-with-store store - (match value - ((? manifest? value) - (lower-manifest name image target system)) - ((? operating-system? value) - (lower-operating-system value target system)) - ((or (? gexp? value) - (? file-like? value)) - value) - (_ - (raise - (formatted-message - (G_ "oci-image value must contain only manifest, -operating-system, gexp or file-like records but ~a was found") - value)))) - #:target target - #:system system))) - -(define (%oci-image-loader name image tag) - (let ((docker (file-append docker-cli "/bin/docker")) - (tarball (lower-oci-image name image))) - (with-imported-modules '((guix build utils)) - (program-file (format #f "~a-image-loader" name) - #~(begin - (use-modules (guix build utils) - (ice-9 popen) - (ice-9 rdelim)) - - (format #t "Loading image for ~a from ~a...~%" #$name #$tarball) - (define line - (read-line - (open-input-pipe - (string-append #$docker " load -i " #$tarball)))) - - (unless (or (eof-object? line) - (string-null? line)) - (format #t "~a~%" line) - (let ((repository&tag - (string-drop line - (string-length - "Loaded image: ")))) - - (invoke #$docker "tag" repository&tag #$tag) - (format #t "Tagged ~a with ~a...~%" #$tarball #$tag)))))))) - -(define (oci-container-shepherd-service config) - (define (guess-name name image) - (if (maybe-value-set? name) - name - (string-append "docker-" - (basename - (if (string? image) - (first (string-split image #\:)) - (oci-image-repository image)))))) - - (let* ((docker (file-append docker-cli "/bin/docker")) - (actions (oci-container-configuration-shepherd-actions config)) - (auto-start? - (oci-container-configuration-auto-start? config)) - (user (oci-container-configuration-user config)) - (group (oci-container-configuration-group config)) - (host-environment - (oci-container-configuration-host-environment config)) - (command (oci-container-configuration-command config)) - (log-file (oci-container-configuration-log-file config)) - (provision (oci-container-configuration-provision config)) - (requirement (oci-container-configuration-requirement config)) - (respawn? - (oci-container-configuration-respawn? config)) - (image (oci-container-configuration-image config)) - (image-reference (oci-image-reference image)) - (options (oci-container-configuration->options config)) - (name (guess-name provision image)) - (extra-arguments - (oci-container-configuration-extra-arguments config))) - - (shepherd-service (provision `(,(string->symbol name))) - (requirement `(dockerd user-processes ,@requirement)) - (respawn? respawn?) - (auto-start? auto-start?) - (documentation - (string-append - "Docker backed Shepherd service for " - (if (oci-image? image) name image) ".")) - (start - #~(lambda () - #$@(if (oci-image? image) - #~((invoke #$(%oci-image-loader - name image image-reference))) - #~()) - (fork+exec-command - ;; docker run [OPTIONS] IMAGE [COMMAND] [ARG...] - (list #$docker "run" "--rm" "--name" #$name - #$@options #$@extra-arguments - #$image-reference #$@command) - #:user #$user - #:group #$group - #$@(if (maybe-value-set? log-file) - (list #:log-file log-file) - '()) - #:environment-variables - (list #$@host-environment)))) - (stop - #~(lambda _ - (invoke #$docker "rm" "-f" #$name))) - (actions - (if (oci-image? image) - '() - (append - (list - (shepherd-action - (name 'pull) - (documentation - (format #f "Pull ~a's image (~a)." - name image)) - (procedure - #~(lambda _ - (invoke #$docker "pull" #$image))))) - actions)))))) - -(define %oci-container-accounts - (list (user-account - (name "oci-container") - (comment "OCI services account") - (group "docker") - (system? #t) - (home-directory "/var/empty") - (shell (file-append shadow "/sbin/nologin"))))) - (define (configs->shepherd-services configs) (map oci-container-shepherd-service configs)) diff --git a/gnu/tests/docker.scm b/gnu/tests/docker.scm index 90c8d0f8508..5dcf05a17e3 100644 --- a/gnu/tests/docker.scm +++ b/gnu/tests/docker.scm @@ -1,7 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2019 Danny Milosavljevic ;;; Copyright © 2019-2023 Ludovic Courtès -;;; Copyright © 2024 Giacomo Leidi +;;; Copyright © 2024, 2025 Giacomo Leidi ;;; ;;; This file is part of GNU Guix. ;;; @@ -414,71 +414,54 @@ (define (run-oci-container-test) (test-runner-current (system-test-runner #$output)) (test-begin "oci-container") - (test-assert "containerd service running" - (marionette-eval - '(begin - (use-modules (gnu services herd)) - (match (start-service 'containerd) - (#f #f) - (('service response-parts ...) - (match (assq-ref response-parts 'running) - ((pid) pid))))) - marionette)) - - (test-assert "containerd PID file present" - (wait-for-file "/run/containerd/containerd.pid" marionette)) - - (test-assert "dockerd running" - (marionette-eval - '(begin - (use-modules (gnu services herd)) - (match (start-service 'dockerd) - (#f #f) - (('service response-parts ...) - (match (assq-ref response-parts 'running) - ((pid) pid))))) - marionette)) - - (sleep 10) ; let service start + (wait-for-file "/run/containerd/containerd.pid" marionette) (test-assert "docker-guile running" (marionette-eval '(begin (use-modules (gnu services herd)) - (match (start-service 'docker-guile) - (#f #f) - (('service response-parts ...) - (match (assq-ref response-parts 'running) - ((pid) pid))))) + (wait-for-service 'docker-guile #:timeout 120) + #t) marionette)) - (test-equal "passing host environment variables and volumes" - '("value" "hello") - (marionette-eval - `(begin - (use-modules (ice-9 popen) - (ice-9 rdelim)) - - (define slurp - (lambda args - (let* ((port (apply open-pipe* OPEN_READ args)) - (output (let ((line (read-line port))) - (if (eof-object? line) - "" - line))) - (status (close-pipe port))) - output))) - (let* ((response1 (slurp - ,(string-append #$docker-cli "/bin/docker") - "exec" "docker-guile" - "/bin/guile" "-c" "(display (getenv \"VARIABLE\"))")) - (response2 (slurp - ,(string-append #$docker-cli "/bin/docker") - "exec" "docker-guile" - "/bin/guile" "-c" "(begin (use-modules (ice-9 popen) (ice-9 rdelim)) + (test-assert "passing host environment variables and volumes" + (begin + (define (run-test) + (marionette-eval + `(begin + (use-modules (ice-9 popen) + (ice-9 rdelim)) + + (define slurp + (lambda args + (let* ((port (apply open-pipe* OPEN_READ args)) + (output (let ((line (read-line port))) + (if (eof-object? line) + "" + line))) + (status (close-pipe port))) + output))) + (let* ((response1 (slurp + ,(string-append #$docker-cli "/bin/docker") + "exec" "docker-guile" + "/bin/guile" "-c" "(display (getenv \"VARIABLE\"))")) + (response2 (slurp + ,(string-append #$docker-cli "/bin/docker") + "exec" "docker-guile" + "/bin/guile" "-c" "(begin (use-modules (ice-9 popen) (ice-9 rdelim)) (display (call-with-input-file \"/shared.txt\" read-line)))"))) - (list response1 response2))) - marionette)) + (list response1 response2))) + marionette)) + ;; Allow services to come up on slower machines + (let loop ((attempts 0)) + (if (= attempts 60) + (error "Service didn't come up after more than 60 seconds") + (if (equal? '("value" "hello") + (run-test)) + #t + (begin + (sleep 1) + (loop (+ 1 attempts)))))))) (test-end))))