---
gnu/services/docker.scm | 240 +++++++++++++++++++++++++++++++++++++---
1 file changed, 222 insertions(+), 18 deletions(-)
@@ -5,6 +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 © 2022 Maya Tomasek <maya.omase@disroot.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -21,7 +22,9 @@
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
-(define-module (gnu services docker)
+(define-module (magi system docker)
+ #:use-module (srfi srfi-1)
+ #:use-module (ice-9 format)
#:use-module (gnu services)
#:use-module (gnu services configuration)
#:use-module (gnu services base)
@@ -36,9 +39,191 @@ (define-module (gnu services docker)
#:use-module (guix packages)
#:export (docker-configuration
+ docker-container
docker-service-type
singularity-service-type))
+(define (pair-of-strings? val)
+ (and (pair? val)
+ (string? (car val))
+ (string? (cdr val))))
+
+(define (list-of-pair-of-strings? val)
+ (list-of pair-of-strings?))
+
+(define-configuration/no-serialization docker-container
+ (name
+ (symbol '())
+ "Name of the docker container. Will be used to denote service to Shepherd and must be unique!
+We recommend, that the name of the container is prefixed with @code{docker-}.")
+ (documentation
+ (string "")
+ "Documentation on the docker container (optional). It will be used for the shepherd service.")
+ (image-name
+ (string #f)
+ "A name of the image that will be used. (Note that the existence of the image
+is not guaranteed by this daemon.)")
+ (volumes
+ (list-of-pair-of-strings '())
+ "A list of volume bindings. In (HOST-PATH CONTAINER-PATH) format.")
+ (ports
+ (list-of-pair-of-strings '())
+ "A list of port bindings. In (HOST-PORT CONTAINER-PORT) or (HOST-PORT CONTAINER-PORT OPTIONS) format.
+For example, both port bindings are valid:
+
+@lisp
+(ports '((\"2222\" \"22\") (\"21\" \"21\" \"tcp\")))
+@end lisp")
+ (environments
+ (list-of-pair-of-strings '())
+ "A list of environment variables, inside the container environment, in (VARIABLE VALUE) format.")
+ (network
+ (string "none")
+ "Network type.
+
+Available types are:
+@table @code
+@c Copied from https://docs.docker.com/network/
+
+@item none
+
+The default option. For this container, disable all networking. Usually used in
+conjunction with a custom network driver. none is not available for swarm services.
+
+@item bridge
+
+Bridge networks are usually used when your applications run in standalone
+containers that need to communicate.
+
+@item host
+
+For standalone containers, remove network isolation between the container and the Docker host,
+and use the host’s networking directly.
+
+@item overlay
+
+Overlay networks connect multiple Docker daemons together and enable swarm services to
+communicate with each other. You can also use overlay networks to facilitate
+communication between a swarm service and a standalone container, or between
+two standalone containers on different Docker daemons. This strategy removes
+the need to do OS-level routing between these containers.
+
+@item ipvlan
+
+IPvlan networks give users total control over both IPv4 and IPv6 addressing.
+The VLAN driver builds on top of that in giving operators complete control of
+layer 2 VLAN tagging and even IPvlan L3 routing for users interested in underlay
+network integration.
+
+@item macvlan
+
+Macvlan networks allow you to assign a MAC address to a container, making it appear
+as a physical device on your network. The Docker daemon routes traffic to containers
+by their MAC addresses. Using the macvlan driver is sometimes the best choice when
+dealing with legacy applications that expect to be directly connected to the physical
+network, rather than routed through the Docker host’s network stack.
+
+@end table")
+ (additional-arguments
+ (list-of-strings '())
+ "Additional arguments to the docker command line interface.")
+ (container-command
+ (list-of-strings '())
+ "Command to send into the container.")
+ (pid-file-timeout
+ (number 5)
+ "If the docker container does not show up in @code{docker ps} as @code{running} in less than pid-file-timeout seconds, the container is considered as failing to start.
+
+Note that some containers take a really long time to start, so you should adjust it accordingly."))
+
+(define (serialize-volumes config)
+ "Serialize list of pairs into flat list of @code{(\"-v\" \"HOST_PATH:CONTAINER_PATH\" ...)}"
+ (append-map
+ (lambda (volume-bind)
+ (list "-v" (apply format #f "~a:~a~^:~a" volume-bind)))
+ (docker-container-volumes config)))
+
+(define (serialize-ports config)
+ "Serialize list of either pairs, or lists into flat list of
+@code{(\"-p\" \"NUMBER:NUMBER\" \"-p\" \"NUMBER:NUMBER/PROTOCOL\" ...)}"
+ (append-map
+ (lambda (port-bind)
+ (list "-p" (apply format #f "~a:~a~^/~a" port-bind)))
+ (docker-container-ports config)))
+
+(define (serialize-environments config)
+ "Serialize list of pairs into flat list of @code{(\"-e\" \"VAR=val\" \"-e\" \"VAR=val\" ...)}."
+ (append-map
+ (lambda (env-bind)
+ (list "-e" (apply format #f "~a=~a" env-bind)))
+ (docker-container-environments config)))
+
+(define (docker-container-startup-script docker-cli container-name cid-file config)
+ "Return a program file, that executes the startup sequence of the @code{docker-container-shepherd-service}."
+ (let* ((image-name (docker-container-image-name config))
+ (volumes (serialize-volumes config))
+ (ports (serialize-ports config))
+ (envs (serialize-environments config))
+ (network (docker-container-network config))
+ (additional-arguments (docker-container-additional-arguments config))
+ (container-command (docker-container-container-command config)))
+ (with-imported-modules
+ '((guix build utils))
+ (program-file
+ (string-append "start-" container-name "-container")
+ #~(let ((docker (string-append #$docker-cli "/bin/docker")))
+ (use-modules (guix build utils))
+ ;; These two commands should fail
+ ;; they are there as a failsafe to
+ ;; prevent contamination from unremoved containers
+ (system* docker "stop" #$container-name)
+ (system* docker "rm" #$container-name)
+ (apply invoke `(,docker
+ "run"
+ ,(string-append "--name=" #$container-name)
+ ;; Automatically remove the container when stopping
+ ;; If you want persistent data, you need to use
+ ;; volume binds or other methods.
+ "--rm"
+ ,(string-append "--network=" #$network)
+ ;; Write to a cid file the container id, this allows
+ ;; for shepherd to manage container even when the process
+ ;; itself gets detached from the container
+ "--cidfile" #$cid-file
+ #$@volumes
+ #$@ports
+ #$@envs
+ #$@additional-arguments
+ ,#$image-name
+ #$@container-command)))))))
+
+(define (docker-container-shepherd-service docker-cli config)
+ "Return a shepherd-service that runs CONTAINER."
+ (let* ((container-name (symbol->string (docker-container-name config)))
+ (cid-file (string-append "/var/run/docker/" container-name ".pid"))
+ (pid-file-timeout (docker-container-pid-file-timeout config)))
+ (shepherd-service
+ (provision (list (docker-container-name config)))
+ (requirement `(dockerd))
+ (documentation (docker-container-documentation config))
+ (start #~(apply make-forkexec-constructor
+ `(,(list #$(docker-container-startup-script docker-cli container-name cid-file config))
+ ;; Watch the cid-file instead of the docker run command, as the daemon can
+ ;; still be running even when the command terminates
+ #:pid-file #$cid-file
+ #:pid-file-timeout #$pid-file-timeout)))
+ (stop #~(lambda _
+ (invoke
+ (string-append #$docker-cli "/bin/docker")
+ "stop"
+ #$container-name)
+ ;; Shepherd expects the stop command to return #f if it succeeds
+ ;; docker stop should always succeed
+ #f)))))
+
+(define (list-of-docker-containers? val)
+ (list-of docker-container?))
+
(define-configuration docker-configuration
(docker
(file-like docker)
@@ -65,8 +250,21 @@ (define-configuration docker-configuration
(environment-variables
(list '())
"Environment variables to set for dockerd")
+ (containers
+ (list-of-docker-containers '())
+ "List of docker containers to run as shepherd services.")
(no-serialization))
+(define (docker-container-shepherd-services config)
+ "Return shepherd services for all containers inside config."
+ (let ((docker-cli (docker-configuration-docker-cli config)))
+ (map
+ (lambda (container)
+ (docker-container-shepherd-service
+ docker-cli
+ container))
+ (docker-configuration-containers config))))
+
(define %docker-accounts
(list (user-group (name "docker") (system? #t))))
@@ -88,20 +286,20 @@ (define (containerd-shepherd-service config)
(debug? (docker-configuration-debug? config))
(containerd (docker-configuration-containerd config)))
(shepherd-service
- (documentation "containerd daemon.")
- (provision '(containerd))
- (start #~(make-forkexec-constructor
- (list (string-append #$package "/bin/containerd")
- #$@(if debug?
- '("--log-level=debug")
- '()))
- ;; For finding containerd-shim binary.
- #:environment-variables
- (list (string-append "PATH=" #$containerd "/bin"))
- #:pid-file "/run/containerd/containerd.pid"
- #:pid-file-timeout 300
- #:log-file "/var/log/containerd.log"))
- (stop #~(make-kill-destructor)))))
+ (documentation "containerd daemon.")
+ (provision '(containerd))
+ (start #~(make-forkexec-constructor
+ (list (string-append #$package "/bin/containerd")
+ #$@(if debug?
+ '("--log-level=debug")
+ '()))
+ ;; For finding containerd-shim binary.
+ #:environment-variables
+ (list (string-append "PATH=" #$containerd "/bin"))
+ #:pid-file "/run/containerd/containerd.pid"
+ #:pid-file-timeout 300
+ #:log-file "/var/log/containerd.log"))
+ (stop #~(make-kill-destructor)))))
(define (docker-shepherd-service config)
(let* ((docker (docker-configuration-docker config))
@@ -148,7 +346,7 @@ (define (docker-shepherd-service config)
(define docker-service-type
(service-type (name 'docker)
(description "Provide capability to run Docker application
-bundles in Docker containers.")
+bundles in Docker containers and optionally wrap those containers in shepherd services.")
(extensions
(list
;; Make sure the 'docker' command is available.
@@ -158,10 +356,16 @@ (define docker-service-type
%docker-activation)
(service-extension shepherd-root-service-type
(lambda (config)
- (list (containerd-shepherd-service config)
- (docker-shepherd-service config))))
+ (cons* (containerd-shepherd-service config)
+ (docker-shepherd-service config)
+ (docker-container-shepherd-services config))))
(service-extension account-service-type
(const %docker-accounts))))
+ (compose concatenate)
+ (extend (lambda (config containers)
+ (docker-configuration
+ (inherit config)
+ (containers (append containers (docker-configuration-containers config))))))
(default-value (docker-configuration))))
--
2.37.3