mirror of
https://codeberg.org/guix/guix.git
synced 2025-10-02 02:15:12 +00:00
services: oci-container-configuration: Move to (gnu services containers).
This patch moves the oci-container-configuration and related configuration records to (gnu services containers). Public symbols are still exported for backwards compatibility but since the oci-container-service-type will be deprecated in favor of the more general oci-service-type, everything is moved outside of the docker related module. * gnu/services/docker.scm: Move everything related to oci-container-configuration to... * gnu/services/containers.scm: ...here.scm. Change-Id: Iae599dd5cc7442eb632f0c1b3b12f6b928397ae7 Signed-off-by: Maxim Cournoyer <maxim.cournoyer@gmail.com>
This commit is contained in:
Giacomo Leidi
Maxim Cournoyer
parent
92058c15c8
commit
30259d52e1
2 changed files with 584 additions and 542 deletions
|
|
@ -1,5 +1,5 @@
|
||||||
;;; GNU Guix --- Functional package management for GNU
|
;;; 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.
|
;;; This file is part of GNU Guix.
|
||||||
;;;
|
;;;
|
||||||
|
|
@ -17,19 +17,31 @@
|
||||||
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
(define-module (gnu services containers)
|
(define-module (gnu services containers)
|
||||||
|
#:use-module (gnu image)
|
||||||
|
#:use-module (gnu packages admin)
|
||||||
#:use-module (gnu packages bash)
|
#:use-module (gnu packages bash)
|
||||||
#:use-module (gnu packages containers)
|
#:use-module (gnu packages containers)
|
||||||
|
#:use-module (gnu packages docker)
|
||||||
#:use-module (gnu packages file-systems)
|
#:use-module (gnu packages file-systems)
|
||||||
#:use-module (gnu services)
|
#:use-module (gnu services)
|
||||||
#:use-module (gnu services base)
|
#:use-module (gnu services base)
|
||||||
#:use-module (gnu services configuration)
|
#:use-module (gnu services configuration)
|
||||||
#:use-module (gnu services shepherd)
|
#:use-module (gnu services shepherd)
|
||||||
|
#:use-module (gnu system)
|
||||||
#:use-module (gnu system accounts)
|
#:use-module (gnu system accounts)
|
||||||
|
#:use-module (gnu system image)
|
||||||
#:use-module (gnu system shadow)
|
#:use-module (gnu system shadow)
|
||||||
#:use-module (gnu system pam)
|
#:use-module (gnu system pam)
|
||||||
|
#:use-module (guix diagnostics)
|
||||||
#:use-module (guix gexp)
|
#:use-module (guix gexp)
|
||||||
|
#:use-module (guix i18n)
|
||||||
|
#:use-module (guix monads)
|
||||||
#:use-module (guix packages)
|
#: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 (srfi srfi-1)
|
||||||
|
#:use-module (ice-9 match)
|
||||||
#:export (rootless-podman-configuration
|
#:export (rootless-podman-configuration
|
||||||
rootless-podman-configuration?
|
rootless-podman-configuration?
|
||||||
rootless-podman-configuration-fields
|
rootless-podman-configuration-fields
|
||||||
|
|
@ -48,7 +60,44 @@
|
||||||
rootless-podman-shepherd-services
|
rootless-podman-shepherd-services
|
||||||
rootless-podman-service-etc
|
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)
|
(define (gexp-or-string? value)
|
||||||
(or (gexp? value)
|
(or (gexp? value)
|
||||||
|
|
@ -190,7 +239,7 @@ available for each configured user."))
|
||||||
rootless-podman-shared-root-fs))
|
rootless-podman-shared-root-fs))
|
||||||
(one-shot? #t)
|
(one-shot? #t)
|
||||||
(documentation
|
(documentation
|
||||||
"Allow setting cgroups limits: cpu, cpuset, memory and
|
"Allow setting cgroups limits: cpu, cpuset, io, memory and
|
||||||
pids.")
|
pids.")
|
||||||
(start
|
(start
|
||||||
#~(make-forkexec-constructor
|
#~(make-forkexec-constructor
|
||||||
|
|
@ -244,3 +293,497 @@ to be shared. This service sets it so.")
|
||||||
(default-value (rootless-podman-configuration))
|
(default-value (rootless-podman-configuration))
|
||||||
(description
|
(description
|
||||||
"This service configures rootless @code{podman} on the Guix System.")))
|
"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 Efraim Flashner <efraim@flashner.co.il>
|
||||||
;;; Copyright © 2020 Jesse Dowell <jessedowell@gmail.com>
|
;;; Copyright © 2020 Jesse Dowell <jessedowell@gmail.com>
|
||||||
;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
|
;;; 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.
|
;;; This file is part of GNU Guix.
|
||||||
;;;
|
;;;
|
||||||
|
|
@ -23,39 +23,21 @@
|
||||||
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
(define-module (gnu services docker)
|
(define-module (gnu services docker)
|
||||||
#:use-module (gnu image)
|
|
||||||
#:use-module (gnu services)
|
#:use-module (gnu services)
|
||||||
#:use-module (gnu services configuration)
|
#:use-module (gnu services configuration)
|
||||||
#:use-module (gnu services base)
|
#:use-module (gnu services containers)
|
||||||
#:use-module (gnu services dbus)
|
|
||||||
#:use-module (gnu services shepherd)
|
#:use-module (gnu services shepherd)
|
||||||
#:use-module (gnu system)
|
|
||||||
#:use-module (gnu system image)
|
|
||||||
#:use-module (gnu system privilege)
|
#:use-module (gnu system privilege)
|
||||||
#:use-module (gnu system shadow)
|
#:use-module (gnu system shadow)
|
||||||
#:use-module (gnu packages admin) ;shadow
|
|
||||||
#:use-module (gnu packages docker)
|
#:use-module (gnu packages docker)
|
||||||
#:use-module (gnu packages linux) ;singularity
|
#:use-module (gnu packages linux) ;singularity
|
||||||
#:use-module (guix records)
|
|
||||||
#:use-module (guix diagnostics)
|
|
||||||
#:use-module (guix gexp)
|
#:use-module (guix gexp)
|
||||||
#:use-module (guix i18n)
|
#:use-module (guix records)
|
||||||
#: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 (srfi srfi-1)
|
||||||
#:use-module (ice-9 format)
|
#:use-module (ice-9 format)
|
||||||
#:use-module (ice-9 match)
|
#:use-module (ice-9 match)
|
||||||
|
#:re-export (oci-image ;for backwards compatibility, until the
|
||||||
#:export (containerd-configuration
|
oci-image? ;oci-container-service-type is fully deprecated
|
||||||
containerd-service-type
|
|
||||||
docker-configuration
|
|
||||||
docker-service-type
|
|
||||||
singularity-service-type
|
|
||||||
oci-image
|
|
||||||
oci-image?
|
|
||||||
oci-image-fields
|
oci-image-fields
|
||||||
oci-image-repository
|
oci-image-repository
|
||||||
oci-image-tag
|
oci-image-tag
|
||||||
|
|
@ -86,9 +68,15 @@
|
||||||
oci-container-configuration-container-user
|
oci-container-configuration-container-user
|
||||||
oci-container-configuration-workdir
|
oci-container-configuration-workdir
|
||||||
oci-container-configuration-extra-arguments
|
oci-container-configuration-extra-arguments
|
||||||
oci-container-service-type
|
|
||||||
oci-container-shepherd-service
|
oci-container-shepherd-service
|
||||||
%oci-container-accounts))
|
%oci-container-accounts)
|
||||||
|
|
||||||
|
#:export (containerd-configuration
|
||||||
|
containerd-service-type
|
||||||
|
docker-configuration
|
||||||
|
docker-service-type
|
||||||
|
singularity-service-type
|
||||||
|
oci-container-service-type))
|
||||||
|
|
||||||
(define-maybe file-like)
|
(define-maybe file-like)
|
||||||
|
|
||||||
|
|
@ -309,495 +297,6 @@ bundles in Docker containers.")
|
||||||
;;; OCI container.
|
;;; 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)
|
(define (configs->shepherd-services configs)
|
||||||
(map oci-container-shepherd-service configs))
|
(map oci-container-shepherd-service configs))
|
||||||
|
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue