@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2024 Giacomo Leidi <goodoldpaul@autistici.org>
+;;; Copyright © 2024, 2025 Giacomo Leidi <goodoldpaul@autistici.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -17,19 +17,31 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu services containers)
+ #:use-module (gnu image)
+ #:use-module (gnu packages admin)
#:use-module (gnu packages bash)
#:use-module (gnu packages containers)
+ #:use-module (gnu packages docker)
#:use-module (gnu packages file-systems)
#:use-module (gnu services)
#:use-module (gnu services base)
#:use-module (gnu services configuration)
#:use-module (gnu services shepherd)
+ #:use-module (gnu system)
#:use-module (gnu system accounts)
+ #:use-module (gnu system image)
#:use-module (gnu system shadow)
#:use-module (gnu system pam)
+ #:use-module (guix diagnostics)
#:use-module (guix gexp)
+ #:use-module (guix i18n)
+ #:use-module (guix monads)
#:use-module (guix packages)
+ #:use-module (guix profiles)
+ #:use-module ((guix scripts pack) #:prefix pack:)
+ #:use-module (guix store)
#:use-module (srfi srfi-1)
+ #:use-module (ice-9 match)
#:export (rootless-podman-configuration
rootless-podman-configuration?
rootless-podman-configuration-fields
@@ -48,7 +60,44 @@ (define-module (gnu services containers)
rootless-podman-shepherd-services
rootless-podman-service-etc
- rootless-podman-service-type))
+ rootless-podman-service-type
+
+ oci-image
+ oci-image?
+ oci-image-fields
+ oci-image-repository
+ oci-image-tag
+ oci-image-value
+ oci-image-pack-options
+ oci-image-target
+ oci-image-system
+ oci-image-grafts?
+
+ oci-container-configuration
+ oci-container-configuration?
+ oci-container-configuration-fields
+ oci-container-configuration-user
+ oci-container-configuration-group
+ oci-container-configuration-command
+ oci-container-configuration-entrypoint
+ oci-container-configuration-host-environment
+ oci-container-configuration-environment
+ oci-container-configuration-image
+ oci-container-configuration-provision
+ oci-container-configuration-requirement
+ oci-container-configuration-log-file
+ oci-container-configuration-auto-start?
+ oci-container-configuration-respawn?
+ oci-container-configuration-shepherd-actions
+ oci-container-configuration-network
+ oci-container-configuration-ports
+ oci-container-configuration-volumes
+ oci-container-configuration-container-user
+ oci-container-configuration-workdir
+ oci-container-configuration-extra-arguments
+
+ oci-container-shepherd-service
+ %oci-container-accounts))
(define (gexp-or-string? value)
(or (gexp? value)
@@ -188,7 +237,7 @@ (define (rootless-podman-cgroups-limits-service config)
rootless-podman-shared-root-fs))
(one-shot? #t)
(documentation
- "Allow setting cgroups limits: cpu, cpuset, memory and
+ "Allow setting cgroups limits: cpu, cpuset, io, memory and
pids.")
(start
#~(make-forkexec-constructor
@@ -242,3 +291,497 @@ (define rootless-podman-service-type
(default-value (rootless-podman-configuration))
(description
"This service configures rootless @code{podman} on the Guix System.")))
+
+
+;;;
+;;; OCI container.
+;;;
+
+(define (oci-sanitize-pair pair delimiter)
+ (define (valid? member)
+ (or (string? member)
+ (gexp? member)
+ (file-like? member)))
+ (match pair
+ (((? valid? key) . (? valid? value))
+ #~(string-append #$key #$delimiter #$value))
+ (_
+ (raise
+ (formatted-message
+ (G_ "pair members must contain only strings, gexps or file-like objects
+but ~a was found")
+ pair)))))
+
+(define (oci-sanitize-mixed-list name value delimiter)
+ (map
+ (lambda (el)
+ (cond ((string? el) el)
+ ((pair? el) (oci-sanitize-pair el delimiter))
+ (else
+ (raise
+ (formatted-message
+ (G_ "~a members must be either a string or a pair but ~a was
+found!")
+ name el)))))
+ value))
+
+(define (oci-sanitize-host-environment value)
+ ;; Expected spec format:
+ ;; '(("HOME" . "/home/nobody") "JAVA_HOME=/java")
+ (oci-sanitize-mixed-list "host-environment" value "="))
+
+(define (oci-sanitize-environment value)
+ ;; Expected spec format:
+ ;; '(("HOME" . "/home/nobody") "JAVA_HOME=/java")
+ (oci-sanitize-mixed-list "environment" value "="))
+
+(define (oci-sanitize-ports value)
+ ;; Expected spec format:
+ ;; '(("8088" . "80") "2022:22")
+ (oci-sanitize-mixed-list "ports" value ":"))
+
+(define (oci-sanitize-volumes value)
+ ;; Expected spec format:
+ ;; '(("/mnt/dir" . "/dir") "/run/current-system/profile:/java")
+ (oci-sanitize-mixed-list "volumes" value ":"))
+
+(define (oci-sanitize-shepherd-actions value)
+ (map
+ (lambda (el)
+ (if (shepherd-action? el)
+ el
+ (raise
+ (formatted-message
+ (G_ "shepherd-actions may only be shepherd-action records
+but ~a was found") el))))
+ value))
+
+(define (oci-sanitize-extra-arguments value)
+ (define (valid? member)
+ (or (string? member)
+ (gexp? member)
+ (file-like? member)))
+ (map
+ (lambda (el)
+ (if (valid? el)
+ el
+ (raise
+ (formatted-message
+ (G_ "extra arguments may only be strings, gexps or file-like objects
+but ~a was found") el))))
+ value))
+
+(define (oci-image-reference image)
+ (if (string? image)
+ image
+ (string-append (oci-image-repository image)
+ ":" (oci-image-tag image))))
+
+(define (oci-lowerable-image? image)
+ (or (manifest? image)
+ (operating-system? image)
+ (gexp? image)
+ (file-like? image)))
+
+(define (string-or-oci-image? image)
+ (or (string? image)
+ (oci-image? image)))
+
+(define list-of-symbols?
+ (list-of symbol?))
+
+(define-maybe/no-serialization string)
+
+(define-configuration/no-serialization oci-image
+ (repository
+ (string)
+ "A string like @code{myregistry.local:5000/testing/test-image} that names
+the OCI image.")
+ (tag
+ (string "latest")
+ "A string representing the OCI image tag. Defaults to @code{latest}.")
+ (value
+ (oci-lowerable-image)
+ "A @code{manifest} or @code{operating-system} record that will be lowered
+into an OCI compatible tarball. Otherwise this field's value can be a gexp
+or a file-like object that evaluates to an OCI compatible tarball.")
+ (pack-options
+ (list '())
+ "An optional set of keyword arguments that will be passed to the
+@code{docker-image} procedure from @code{guix scripts pack}. They can be used
+to replicate @command{guix pack} behavior:
+
+@lisp
+(oci-image
+ (repository \"guile\")
+ (tag \"3\")
+ (manifest (specifications->manifest '(\"guile\")))
+ (pack-options
+ '(#:symlinks ((\"/bin/guile\" -> \"bin/guile\"))
+ #:max-layers 2)))
+@end lisp
+
+If the @code{value} field is an @code{operating-system} record, this field's
+value will be ignored.")
+ (system
+ (maybe-string)
+ "Attempt to build for a given system, e.g. \"i686-linux\"")
+ (target
+ (maybe-string)
+ "Attempt to cross-build for a given triple, e.g. \"aarch64-linux-gnu\"")
+ (grafts?
+ (boolean #f)
+ "Whether to allow grafting or not in the pack build."))
+
+(define-configuration/no-serialization oci-container-configuration
+ (user
+ (string "oci-container")
+ "The user under whose authority docker commands will be run.")
+ (group
+ (string "docker")
+ "The group under whose authority docker commands will be run.")
+ (command
+ (list-of-strings '())
+ "Overwrite the default command (@code{CMD}) of the image.")
+ (entrypoint
+ (maybe-string)
+ "Overwrite the default entrypoint (@code{ENTRYPOINT}) of the image.")
+ (host-environment
+ (list '())
+ "Set environment variables in the host environment where @command{docker run}
+is invoked. This is especially useful to pass secrets from the host to the
+container without having them on the @command{docker run}'s command line: by
+setting the @code{MYSQL_PASSWORD} on the host and by passing
+@code{--env MYSQL_PASSWORD} through the @code{extra-arguments} field, it is
+possible to securely set values in the container environment. This field's
+value can be a list of pairs or strings, even mixed:
+
+@lisp
+(list '(\"LANGUAGE\" . \"eo:ca:eu\")
+ \"JAVA_HOME=/opt/java\")
+@end lisp
+
+Pair members can be strings, gexps or file-like objects. Strings are passed
+directly to @code{make-forkexec-constructor}."
+ (sanitizer oci-sanitize-host-environment))
+ (environment
+ (list '())
+ "Set environment variables inside the container. This can be a list of pairs
+or strings, even mixed:
+
+@lisp
+(list '(\"LANGUAGE\" . \"eo:ca:eu\")
+ \"JAVA_HOME=/opt/java\")
+@end lisp
+
+Pair members can be strings, gexps or file-like objects. Strings are passed
+directly to the Docker CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#env,upstream}
+documentation for semantics."
+ (sanitizer oci-sanitize-environment))
+ (image
+ (string-or-oci-image)
+ "The image used to build the container. It can be a string or an
+@code{oci-image} record. Strings are resolved by the Docker
+Engine, and follow the usual format
+@code{myregistry.local:5000/testing/test-image:tag}.")
+ (provision
+ (maybe-string)
+ "Set the name of the provisioned Shepherd service.")
+ (requirement
+ (list-of-symbols '())
+ "Set additional Shepherd services dependencies to the provisioned Shepherd
+service.")
+ (log-file
+ (maybe-string)
+ "When @code{log-file} is set, it names the file to which the service’s
+standard output and standard error are redirected. @code{log-file} is created
+if it does not exist, otherwise it is appended to.")
+ (auto-start?
+ (boolean #t)
+ "Whether this service should be started automatically by the Shepherd. If it
+is @code{#f} the service has to be started manually with @command{herd start}.")
+ (respawn?
+ (boolean #f)
+ "Whether to restart the service when it stops, for instance when the
+underlying process dies.")
+ (shepherd-actions
+ (list '())
+ "This is a list of @code{shepherd-action} records defining actions supported
+by the service."
+ (sanitizer oci-sanitize-shepherd-actions))
+ (network
+ (maybe-string)
+ "Set a Docker network for the spawned container.")
+ (ports
+ (list '())
+ "Set the port or port ranges to expose from the spawned container. This can
+be a list of pairs or strings, even mixed:
+
+@lisp
+(list '(\"8080\" . \"80\")
+ \"10443:443\")
+@end lisp
+
+Pair members can be strings, gexps or file-like objects. Strings are passed
+directly to the Docker CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#publish,upstream}
+documentation for semantics."
+ (sanitizer oci-sanitize-ports))
+ (volumes
+ (list '())
+ "Set volume mappings for the spawned container. This can be a
+list of pairs or strings, even mixed:
+
+@lisp
+(list '(\"/root/data/grafana\" . \"/var/lib/grafana\")
+ \"/gnu/store:/gnu/store\")
+@end lisp
+
+Pair members can be strings, gexps or file-like objects. Strings are passed
+directly to the Docker CLI. You can refer to the
+@url{https://docs.docker.com/engine/reference/commandline/run/#volume,upstream}
+documentation for semantics."
+ (sanitizer oci-sanitize-volumes))
+ (container-user
+ (maybe-string)
+ "Set the current user inside the spawned container. You can refer to the
+@url{https://docs.docker.com/engine/reference/run/#user,upstream}
+documentation for semantics.")
+ (workdir
+ (maybe-string)
+ "Set the current working for the spawned Shepherd service.
+You can refer to the
+@url{https://docs.docker.com/engine/reference/run/#workdir,upstream}
+documentation for semantics.")
+ (extra-arguments
+ (list '())
+ "A list of strings, gexps or file-like objects that will be directly passed
+to the @command{docker run} invokation."
+ (sanitizer oci-sanitize-extra-arguments)))
+
+(define oci-container-configuration->options
+ (lambda (config)
+ (let ((entrypoint
+ (oci-container-configuration-entrypoint config))
+ (network
+ (oci-container-configuration-network config))
+ (user
+ (oci-container-configuration-container-user config))
+ (workdir
+ (oci-container-configuration-workdir config)))
+ (apply append
+ (filter (compose not unspecified?)
+ `(,(if (maybe-value-set? entrypoint)
+ `("--entrypoint" ,entrypoint)
+ '())
+ ,(append-map
+ (lambda (spec)
+ (list "--env" spec))
+ (oci-container-configuration-environment config))
+ ,(if (maybe-value-set? network)
+ `("--network" ,network)
+ '())
+ ,(if (maybe-value-set? user)
+ `("--user" ,user)
+ '())
+ ,(if (maybe-value-set? workdir)
+ `("--workdir" ,workdir)
+ '())
+ ,(append-map
+ (lambda (spec)
+ (list "-p" spec))
+ (oci-container-configuration-ports config))
+ ,(append-map
+ (lambda (spec)
+ (list "-v" spec))
+ (oci-container-configuration-volumes config))))))))
+
+(define* (get-keyword-value args keyword #:key (default #f))
+ (let ((kv (memq keyword args)))
+ (if (and kv (>= (length kv) 2))
+ (cadr kv)
+ default)))
+
+(define (lower-operating-system os target system)
+ (mlet* %store-monad
+ ((tarball
+ (lower-object
+ (system-image (os->image os #:type docker-image-type))
+ system
+ #:target target)))
+ (return tarball)))
+
+(define (lower-manifest name image target system)
+ (define value (oci-image-value image))
+ (define options (oci-image-pack-options image))
+ (define image-reference
+ (oci-image-reference image))
+ (define image-tag
+ (let* ((extra-options
+ (get-keyword-value options #:extra-options))
+ (image-tag-option
+ (and extra-options
+ (get-keyword-value extra-options #:image-tag))))
+ (if image-tag-option
+ '()
+ `(#:extra-options (#:image-tag ,image-reference)))))
+
+ (mlet* %store-monad
+ ((_ (set-grafting
+ (oci-image-grafts? image)))
+ (guile (set-guile-for-build (default-guile)))
+ (profile
+ (profile-derivation value
+ #:target target
+ #:system system
+ #:hooks '()
+ #:locales? #f))
+ (tarball (apply pack:docker-image
+ `(,name ,profile
+ ,@options
+ ,@image-tag
+ #:localstatedir? #t))))
+ (return tarball)))
+
+(define (lower-oci-image name image)
+ (define value (oci-image-value image))
+ (define image-target (oci-image-target image))
+ (define image-system (oci-image-system image))
+ (define target
+ (if (maybe-value-set? image-target)
+ image-target
+ (%current-target-system)))
+ (define system
+ (if (maybe-value-set? image-system)
+ image-system
+ (%current-system)))
+ (with-store store
+ (run-with-store store
+ (match value
+ ((? manifest? value)
+ (lower-manifest name image target system))
+ ((? operating-system? value)
+ (lower-operating-system value target system))
+ ((or (? gexp? value)
+ (? file-like? value))
+ value)
+ (_
+ (raise
+ (formatted-message
+ (G_ "oci-image value must contain only manifest,
+operating-system, gexp or file-like records but ~a was found")
+ value))))
+ #:target target
+ #:system system)))
+
+(define (%oci-image-loader name image tag)
+ (let ((docker (file-append docker-cli "/bin/docker"))
+ (tarball (lower-oci-image name image)))
+ (with-imported-modules '((guix build utils))
+ (program-file (format #f "~a-image-loader" name)
+ #~(begin
+ (use-modules (guix build utils)
+ (ice-9 popen)
+ (ice-9 rdelim))
+
+ (format #t "Loading image for ~a from ~a...~%" #$name #$tarball)
+ (define line
+ (read-line
+ (open-input-pipe
+ (string-append #$docker " load -i " #$tarball))))
+
+ (unless (or (eof-object? line)
+ (string-null? line))
+ (format #t "~a~%" line)
+ (let ((repository&tag
+ (string-drop line
+ (string-length
+ "Loaded image: "))))
+
+ (invoke #$docker "tag" repository&tag #$tag)
+ (format #t "Tagged ~a with ~a...~%" #$tarball #$tag))))))))
+
+(define (oci-container-shepherd-service config)
+ (define (guess-name name image)
+ (if (maybe-value-set? name)
+ name
+ (string-append "docker-"
+ (basename
+ (if (string? image)
+ (first (string-split image #\:))
+ (oci-image-repository image))))))
+
+ (let* ((docker (file-append docker-cli "/bin/docker"))
+ (actions (oci-container-configuration-shepherd-actions config))
+ (auto-start?
+ (oci-container-configuration-auto-start? config))
+ (user (oci-container-configuration-user config))
+ (group (oci-container-configuration-group config))
+ (host-environment
+ (oci-container-configuration-host-environment config))
+ (command (oci-container-configuration-command config))
+ (log-file (oci-container-configuration-log-file config))
+ (provision (oci-container-configuration-provision config))
+ (requirement (oci-container-configuration-requirement config))
+ (respawn?
+ (oci-container-configuration-respawn? config))
+ (image (oci-container-configuration-image config))
+ (image-reference (oci-image-reference image))
+ (options (oci-container-configuration->options config))
+ (name (guess-name provision image))
+ (extra-arguments
+ (oci-container-configuration-extra-arguments config)))
+
+ (shepherd-service (provision `(,(string->symbol name)))
+ (requirement `(dockerd user-processes ,@requirement))
+ (respawn? respawn?)
+ (auto-start? auto-start?)
+ (documentation
+ (string-append
+ "Docker backed Shepherd service for "
+ (if (oci-image? image) name image) "."))
+ (start
+ #~(lambda ()
+ #$@(if (oci-image? image)
+ #~((invoke #$(%oci-image-loader
+ name image image-reference)))
+ #~())
+ (fork+exec-command
+ ;; docker run [OPTIONS] IMAGE [COMMAND] [ARG...]
+ (list #$docker "run" "--rm" "--name" #$name
+ #$@options #$@extra-arguments
+ #$image-reference #$@command)
+ #:user #$user
+ #:group #$group
+ #$@(if (maybe-value-set? log-file)
+ (list #:log-file log-file)
+ '())
+ #:environment-variables
+ (list #$@host-environment))))
+ (stop
+ #~(lambda _
+ (invoke #$docker "rm" "-f" #$name)))
+ (actions
+ (if (oci-image? image)
+ '()
+ (append
+ (list
+ (shepherd-action
+ (name 'pull)
+ (documentation
+ (format #f "Pull ~a's image (~a)."
+ name image))
+ (procedure
+ #~(lambda _
+ (invoke #$docker "pull" #$image)))))
+ actions))))))
+
+(define %oci-container-accounts
+ (list (user-account
+ (name "oci-container")
+ (comment "OCI services account")
+ (group "docker")
+ (system? #t)
+ (home-directory "/var/empty")
+ (shell (file-append shadow "/sbin/nologin")))))
@@ -5,7 +5,7 @@
;;; Copyright © 2020 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2020 Jesse Dowell <jessedowell@gmail.com>
;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
-;;; Copyright © 2023, 2024 Giacomo Leidi <goodoldpaul@autistici.org>
+;;; Copyright © 2023, 2024, 2025 Giacomo Leidi <goodoldpaul@autistici.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -23,72 +23,60 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu services docker)
- #:use-module (gnu image)
#:use-module (gnu services)
#:use-module (gnu services configuration)
- #:use-module (gnu services base)
- #:use-module (gnu services dbus)
+ #:use-module (gnu services containers)
#:use-module (gnu services shepherd)
- #:use-module (gnu system)
- #:use-module (gnu system image)
#:use-module (gnu system privilege)
#:use-module (gnu system shadow)
- #:use-module (gnu packages admin) ;shadow
#:use-module (gnu packages docker)
#:use-module (gnu packages linux) ;singularity
- #:use-module (guix records)
- #:use-module (guix diagnostics)
#:use-module (guix gexp)
- #:use-module (guix i18n)
- #:use-module (guix monads)
- #:use-module (guix packages)
- #:use-module (guix profiles)
- #:use-module ((guix scripts pack) #:prefix pack:)
- #:use-module (guix store)
+ #:use-module (guix records)
#:use-module (srfi srfi-1)
#:use-module (ice-9 format)
#:use-module (ice-9 match)
+ #:re-export (oci-image ;for backwards compatibility, until the
+ oci-image? ;oci-container-service-type is fully deprecated
+ oci-image-fields
+ oci-image-repository
+ oci-image-tag
+ oci-image-value
+ oci-image-pack-options
+ oci-image-target
+ oci-image-system
+ oci-image-grafts?
+ oci-container-configuration
+ oci-container-configuration?
+ oci-container-configuration-fields
+ oci-container-configuration-user
+ oci-container-configuration-group
+ oci-container-configuration-command
+ oci-container-configuration-entrypoint
+ oci-container-configuration-host-environment
+ oci-container-configuration-environment
+ oci-container-configuration-image
+ oci-container-configuration-provision
+ oci-container-configuration-requirement
+ oci-container-configuration-log-file
+ oci-container-configuration-auto-start?
+ oci-container-configuration-respawn?
+ oci-container-configuration-shepherd-actions
+ oci-container-configuration-network
+ oci-container-configuration-ports
+ oci-container-configuration-volumes
+ oci-container-configuration-container-user
+ oci-container-configuration-workdir
+ oci-container-configuration-extra-arguments
+ oci-container-shepherd-service
+ %oci-container-accounts)
#:export (containerd-configuration
containerd-service-type
docker-configuration
docker-service-type
singularity-service-type
- oci-image
- oci-image?
- oci-image-fields
- oci-image-repository
- oci-image-tag
- oci-image-value
- oci-image-pack-options
- oci-image-target
- oci-image-system
- oci-image-grafts?
- oci-container-configuration
- oci-container-configuration?
- oci-container-configuration-fields
- oci-container-configuration-user
- oci-container-configuration-group
- oci-container-configuration-command
- oci-container-configuration-entrypoint
- oci-container-configuration-host-environment
- oci-container-configuration-environment
- oci-container-configuration-image
- oci-container-configuration-provision
- oci-container-configuration-requirement
- oci-container-configuration-log-file
- oci-container-configuration-auto-start?
- oci-container-configuration-respawn?
- oci-container-configuration-shepherd-actions
- oci-container-configuration-network
- oci-container-configuration-ports
- oci-container-configuration-volumes
- oci-container-configuration-container-user
- oci-container-configuration-workdir
- oci-container-configuration-extra-arguments
- oci-container-service-type
- oci-container-shepherd-service
- %oci-container-accounts))
+ oci-container-service-type))
(define-maybe file-like)
@@ -307,495 +295,6 @@ (define singularity-service-type
;;; OCI container.
;;;
-(define (oci-sanitize-pair pair delimiter)
- (define (valid? member)
- (or (string? member)
- (gexp? member)
- (file-like? member)))
- (match pair
- (((? valid? key) . (? valid? value))
- #~(string-append #$key #$delimiter #$value))
- (_
- (raise
- (formatted-message
- (G_ "pair members must contain only strings, gexps or file-like objects
-but ~a was found")
- pair)))))
-
-(define (oci-sanitize-mixed-list name value delimiter)
- (map
- (lambda (el)
- (cond ((string? el) el)
- ((pair? el) (oci-sanitize-pair el delimiter))
- (else
- (raise
- (formatted-message
- (G_ "~a members must be either a string or a pair but ~a was
-found!")
- name el)))))
- value))
-
-(define (oci-sanitize-host-environment value)
- ;; Expected spec format:
- ;; '(("HOME" . "/home/nobody") "JAVA_HOME=/java")
- (oci-sanitize-mixed-list "host-environment" value "="))
-
-(define (oci-sanitize-environment value)
- ;; Expected spec format:
- ;; '(("HOME" . "/home/nobody") "JAVA_HOME=/java")
- (oci-sanitize-mixed-list "environment" value "="))
-
-(define (oci-sanitize-ports value)
- ;; Expected spec format:
- ;; '(("8088" . "80") "2022:22")
- (oci-sanitize-mixed-list "ports" value ":"))
-
-(define (oci-sanitize-volumes value)
- ;; Expected spec format:
- ;; '(("/mnt/dir" . "/dir") "/run/current-system/profile:/java")
- (oci-sanitize-mixed-list "volumes" value ":"))
-
-(define (oci-sanitize-shepherd-actions value)
- (map
- (lambda (el)
- (if (shepherd-action? el)
- el
- (raise
- (formatted-message
- (G_ "shepherd-actions may only be shepherd-action records
-but ~a was found") el))))
- value))
-
-(define (oci-sanitize-extra-arguments value)
- (define (valid? member)
- (or (string? member)
- (gexp? member)
- (file-like? member)))
- (map
- (lambda (el)
- (if (valid? el)
- el
- (raise
- (formatted-message
- (G_ "extra arguments may only be strings, gexps or file-like objects
-but ~a was found") el))))
- value))
-
-(define (oci-image-reference image)
- (if (string? image)
- image
- (string-append (oci-image-repository image)
- ":" (oci-image-tag image))))
-
-(define (oci-lowerable-image? image)
- (or (manifest? image)
- (operating-system? image)
- (gexp? image)
- (file-like? image)))
-
-(define (string-or-oci-image? image)
- (or (string? image)
- (oci-image? image)))
-
-(define list-of-symbols?
- (list-of symbol?))
-
-(define-maybe/no-serialization string)
-
-(define-configuration/no-serialization oci-image
- (repository
- (string)
- "A string like @code{myregistry.local:5000/testing/test-image} that names
-the OCI image.")
- (tag
- (string "latest")
- "A string representing the OCI image tag. Defaults to @code{latest}.")
- (value
- (oci-lowerable-image)
- "A @code{manifest} or @code{operating-system} record that will be lowered
-into an OCI compatible tarball. Otherwise this field's value can be a gexp
-or a file-like object that evaluates to an OCI compatible tarball.")
- (pack-options
- (list '())
- "An optional set of keyword arguments that will be passed to the
-@code{docker-image} procedure from @code{guix scripts pack}. They can be used
-to replicate @command{guix pack} behavior:
-
-@lisp
-(oci-image
- (repository \"guile\")
- (tag \"3\")
- (manifest (specifications->manifest '(\"guile\")))
- (pack-options
- '(#:symlinks ((\"/bin/guile\" -> \"bin/guile\"))
- #:max-layers 2)))
-@end lisp
-
-If the @code{value} field is an @code{operating-system} record, this field's
-value will be ignored.")
- (system
- (maybe-string)
- "Attempt to build for a given system, e.g. \"i686-linux\"")
- (target
- (maybe-string)
- "Attempt to cross-build for a given triple, e.g. \"aarch64-linux-gnu\"")
- (grafts?
- (boolean #f)
- "Whether to allow grafting or not in the pack build."))
-
-(define-configuration/no-serialization oci-container-configuration
- (user
- (string "oci-container")
- "The user under whose authority docker commands will be run.")
- (group
- (string "docker")
- "The group under whose authority docker commands will be run.")
- (command
- (list-of-strings '())
- "Overwrite the default command (@code{CMD}) of the image.")
- (entrypoint
- (maybe-string)
- "Overwrite the default entrypoint (@code{ENTRYPOINT}) of the image.")
- (host-environment
- (list '())
- "Set environment variables in the host environment where @command{docker run}
-is invoked. This is especially useful to pass secrets from the host to the
-container without having them on the @command{docker run}'s command line: by
-setting the @code{MYSQL_PASSWORD} on the host and by passing
-@code{--env MYSQL_PASSWORD} through the @code{extra-arguments} field, it is
-possible to securely set values in the container environment. This field's
-value can be a list of pairs or strings, even mixed:
-
-@lisp
-(list '(\"LANGUAGE\" . \"eo:ca:eu\")
- \"JAVA_HOME=/opt/java\")
-@end lisp
-
-Pair members can be strings, gexps or file-like objects. Strings are passed
-directly to @code{make-forkexec-constructor}."
- (sanitizer oci-sanitize-host-environment))
- (environment
- (list '())
- "Set environment variables inside the container. This can be a list of pairs
-or strings, even mixed:
-
-@lisp
-(list '(\"LANGUAGE\" . \"eo:ca:eu\")
- \"JAVA_HOME=/opt/java\")
-@end lisp
-
-Pair members can be strings, gexps or file-like objects. Strings are passed
-directly to the Docker CLI. You can refer to the
-@url{https://docs.docker.com/engine/reference/commandline/run/#env,upstream}
-documentation for semantics."
- (sanitizer oci-sanitize-environment))
- (image
- (string-or-oci-image)
- "The image used to build the container. It can be a string or an
-@code{oci-image} record. Strings are resolved by the Docker
-Engine, and follow the usual format
-@code{myregistry.local:5000/testing/test-image:tag}.")
- (provision
- (maybe-string)
- "Set the name of the provisioned Shepherd service.")
- (requirement
- (list-of-symbols '())
- "Set additional Shepherd services dependencies to the provisioned Shepherd
-service.")
- (log-file
- (maybe-string)
- "When @code{log-file} is set, it names the file to which the service’s
-standard output and standard error are redirected. @code{log-file} is created
-if it does not exist, otherwise it is appended to.")
- (auto-start?
- (boolean #t)
- "Whether this service should be started automatically by the Shepherd. If it
-is @code{#f} the service has to be started manually with @command{herd start}.")
- (respawn?
- (boolean #f)
- "Whether to restart the service when it stops, for instance when the
-underlying process dies.")
- (shepherd-actions
- (list '())
- "This is a list of @code{shepherd-action} records defining actions supported
-by the service."
- (sanitizer oci-sanitize-shepherd-actions))
- (network
- (maybe-string)
- "Set a Docker network for the spawned container.")
- (ports
- (list '())
- "Set the port or port ranges to expose from the spawned container. This can
-be a list of pairs or strings, even mixed:
-
-@lisp
-(list '(\"8080\" . \"80\")
- \"10443:443\")
-@end lisp
-
-Pair members can be strings, gexps or file-like objects. Strings are passed
-directly to the Docker CLI. You can refer to the
-@url{https://docs.docker.com/engine/reference/commandline/run/#publish,upstream}
-documentation for semantics."
- (sanitizer oci-sanitize-ports))
- (volumes
- (list '())
- "Set volume mappings for the spawned container. This can be a
-list of pairs or strings, even mixed:
-
-@lisp
-(list '(\"/root/data/grafana\" . \"/var/lib/grafana\")
- \"/gnu/store:/gnu/store\")
-@end lisp
-
-Pair members can be strings, gexps or file-like objects. Strings are passed
-directly to the Docker CLI. You can refer to the
-@url{https://docs.docker.com/engine/reference/commandline/run/#volume,upstream}
-documentation for semantics."
- (sanitizer oci-sanitize-volumes))
- (container-user
- (maybe-string)
- "Set the current user inside the spawned container. You can refer to the
-@url{https://docs.docker.com/engine/reference/run/#user,upstream}
-documentation for semantics.")
- (workdir
- (maybe-string)
- "Set the current working for the spawned Shepherd service.
-You can refer to the
-@url{https://docs.docker.com/engine/reference/run/#workdir,upstream}
-documentation for semantics.")
- (extra-arguments
- (list '())
- "A list of strings, gexps or file-like objects that will be directly passed
-to the @command{docker run} invokation."
- (sanitizer oci-sanitize-extra-arguments)))
-
-(define oci-container-configuration->options
- (lambda (config)
- (let ((entrypoint
- (oci-container-configuration-entrypoint config))
- (network
- (oci-container-configuration-network config))
- (user
- (oci-container-configuration-container-user config))
- (workdir
- (oci-container-configuration-workdir config)))
- (apply append
- (filter (compose not unspecified?)
- `(,(if (maybe-value-set? entrypoint)
- `("--entrypoint" ,entrypoint)
- '())
- ,(append-map
- (lambda (spec)
- (list "--env" spec))
- (oci-container-configuration-environment config))
- ,(if (maybe-value-set? network)
- `("--network" ,network)
- '())
- ,(if (maybe-value-set? user)
- `("--user" ,user)
- '())
- ,(if (maybe-value-set? workdir)
- `("--workdir" ,workdir)
- '())
- ,(append-map
- (lambda (spec)
- (list "-p" spec))
- (oci-container-configuration-ports config))
- ,(append-map
- (lambda (spec)
- (list "-v" spec))
- (oci-container-configuration-volumes config))))))))
-
-(define* (get-keyword-value args keyword #:key (default #f))
- (let ((kv (memq keyword args)))
- (if (and kv (>= (length kv) 2))
- (cadr kv)
- default)))
-
-(define (lower-operating-system os target system)
- (mlet* %store-monad
- ((tarball
- (lower-object
- (system-image (os->image os #:type docker-image-type))
- system
- #:target target)))
- (return tarball)))
-
-(define (lower-manifest name image target system)
- (define value (oci-image-value image))
- (define options (oci-image-pack-options image))
- (define image-reference
- (oci-image-reference image))
- (define image-tag
- (let* ((extra-options
- (get-keyword-value options #:extra-options))
- (image-tag-option
- (and extra-options
- (get-keyword-value extra-options #:image-tag))))
- (if image-tag-option
- '()
- `(#:extra-options (#:image-tag ,image-reference)))))
-
- (mlet* %store-monad
- ((_ (set-grafting
- (oci-image-grafts? image)))
- (guile (set-guile-for-build (default-guile)))
- (profile
- (profile-derivation value
- #:target target
- #:system system
- #:hooks '()
- #:locales? #f))
- (tarball (apply pack:docker-image
- `(,name ,profile
- ,@options
- ,@image-tag
- #:localstatedir? #t))))
- (return tarball)))
-
-(define (lower-oci-image name image)
- (define value (oci-image-value image))
- (define image-target (oci-image-target image))
- (define image-system (oci-image-system image))
- (define target
- (if (maybe-value-set? image-target)
- image-target
- (%current-target-system)))
- (define system
- (if (maybe-value-set? image-system)
- image-system
- (%current-system)))
- (with-store store
- (run-with-store store
- (match value
- ((? manifest? value)
- (lower-manifest name image target system))
- ((? operating-system? value)
- (lower-operating-system value target system))
- ((or (? gexp? value)
- (? file-like? value))
- value)
- (_
- (raise
- (formatted-message
- (G_ "oci-image value must contain only manifest,
-operating-system, gexp or file-like records but ~a was found")
- value))))
- #:target target
- #:system system)))
-
-(define (%oci-image-loader name image tag)
- (let ((docker (file-append docker-cli "/bin/docker"))
- (tarball (lower-oci-image name image)))
- (with-imported-modules '((guix build utils))
- (program-file (format #f "~a-image-loader" name)
- #~(begin
- (use-modules (guix build utils)
- (ice-9 popen)
- (ice-9 rdelim))
-
- (format #t "Loading image for ~a from ~a...~%" #$name #$tarball)
- (define line
- (read-line
- (open-input-pipe
- (string-append #$docker " load -i " #$tarball))))
-
- (unless (or (eof-object? line)
- (string-null? line))
- (format #t "~a~%" line)
- (let ((repository&tag
- (string-drop line
- (string-length
- "Loaded image: "))))
-
- (invoke #$docker "tag" repository&tag #$tag)
- (format #t "Tagged ~a with ~a...~%" #$tarball #$tag))))))))
-
-(define (oci-container-shepherd-service config)
- (define (guess-name name image)
- (if (maybe-value-set? name)
- name
- (string-append "docker-"
- (basename
- (if (string? image)
- (first (string-split image #\:))
- (oci-image-repository image))))))
-
- (let* ((docker (file-append docker-cli "/bin/docker"))
- (actions (oci-container-configuration-shepherd-actions config))
- (auto-start?
- (oci-container-configuration-auto-start? config))
- (user (oci-container-configuration-user config))
- (group (oci-container-configuration-group config))
- (host-environment
- (oci-container-configuration-host-environment config))
- (command (oci-container-configuration-command config))
- (log-file (oci-container-configuration-log-file config))
- (provision (oci-container-configuration-provision config))
- (requirement (oci-container-configuration-requirement config))
- (respawn?
- (oci-container-configuration-respawn? config))
- (image (oci-container-configuration-image config))
- (image-reference (oci-image-reference image))
- (options (oci-container-configuration->options config))
- (name (guess-name provision image))
- (extra-arguments
- (oci-container-configuration-extra-arguments config)))
-
- (shepherd-service (provision `(,(string->symbol name)))
- (requirement `(dockerd user-processes ,@requirement))
- (respawn? respawn?)
- (auto-start? auto-start?)
- (documentation
- (string-append
- "Docker backed Shepherd service for "
- (if (oci-image? image) name image) "."))
- (start
- #~(lambda ()
- #$@(if (oci-image? image)
- #~((invoke #$(%oci-image-loader
- name image image-reference)))
- #~())
- (fork+exec-command
- ;; docker run [OPTIONS] IMAGE [COMMAND] [ARG...]
- (list #$docker "run" "--rm" "--name" #$name
- #$@options #$@extra-arguments
- #$image-reference #$@command)
- #:user #$user
- #:group #$group
- #$@(if (maybe-value-set? log-file)
- (list #:log-file log-file)
- '())
- #:environment-variables
- (list #$@host-environment))))
- (stop
- #~(lambda _
- (invoke #$docker "rm" "-f" #$name)))
- (actions
- (if (oci-image? image)
- '()
- (append
- (list
- (shepherd-action
- (name 'pull)
- (documentation
- (format #f "Pull ~a's image (~a)."
- name image))
- (procedure
- #~(lambda _
- (invoke #$docker "pull" #$image)))))
- actions))))))
-
-(define %oci-container-accounts
- (list (user-account
- (name "oci-container")
- (comment "OCI services account")
- (group "docker")
- (system? #t)
- (home-directory "/var/empty")
- (shell (file-append shadow "/sbin/nologin")))))
-
(define (configs->shepherd-services configs)
(map oci-container-shepherd-service configs))
@@ -1,7 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019 Danny Milosavljevic <dannym@scratchpost.org>
;;; Copyright © 2019-2023 Ludovic Courtès <ludo@gnu.org>
-;;; Copyright © 2024 Giacomo Leidi <goodoldpaul@autistici.org>
+;;; Copyright © 2024, 2025 Giacomo Leidi <goodoldpaul@autistici.org>
;;;
;;; 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))))