From aa72ac94a3223faa287c01557874c3840219e000 Mon Sep 17 00:00:00 2001 From: Timo Wilken Date: Thu, 7 Dec 2023 23:14:38 +0100 Subject: Generalise Docker service and use it to run Grafana --- tw/services/docker.scm | 139 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 139 insertions(+) create mode 100644 tw/services/docker.scm (limited to 'tw/services/docker.scm') diff --git a/tw/services/docker.scm b/tw/services/docker.scm new file mode 100644 index 00000000..02ba25e4 --- /dev/null +++ b/tw/services/docker.scm @@ -0,0 +1,139 @@ +(define-module (tw services docker) + #:use-module ((gnu packages docker) #:select (docker-cli)) + #:use-module (gnu services) + #:use-module (gnu services configuration) + #:use-module (gnu services shepherd) + #:use-module (guix gexp) + #:use-module (guix packages) + #:use-module (guix records) + #:use-module (ice-9 match) + #:use-module ((srfi srfi-1) #:select (every append-map concatenate)) + #:use-module ((srfi srfi-26) #:select (cut)) + #:export (docker-container-service-type + docker-container-configuration)) + +(define-maybe/no-serialization string) + +(define docker-volume? + (match-lambda + (((? string? host-path) + (? string? container-path)) + #t) + (((? string? host-path) + (? string? container-path) + (? boolean? read-write?)) + #t) + (_ #f))) + +(define (list-of-volumes? thing) + (and (list? thing) + (every docker-volume? thing))) + +(define (list-of-files? thing) + (and (list? thing) + (every (lambda (item) + (or (string? item) (file-like? item))) + thing))) + +(define-configuration/no-serialization docker-container-configuration + (name maybe-string "The name to assign to the running container, if given.") + (user maybe-string "The user to run the container as.") + (image string "The Docker image to run.") + (volumes (list-of-volumes '()) "A list of Docker volumes to mount in the +container. Each volume is given as a list containing the path on the host (or +volume name), the path in the container and an optional boolean (defaulting to +false) specifying whether to allow the container write access to the given +volume.") + (environment-variables (list-of-strings '()) "A list of +@code{VARIABLE=value} strings specifying environment variables to set inside +the container. Warning: it is not safe to pass secrets using this method; use +@code{environment-files} instead!") + (environment-files (list-of-files '()) "A list of files containing +environment variable assignments, to be applied inside the container.") + (network-type (string "none") "Allow the container to connect to the network?") + (read-only-root? (boolean #t) "Run the container with a read-only root file system?") + (remove-after-stop? (boolean #t) "Delete the container once it has stopped? +Enable this if you set a @code{name} to avoid blocking the name for the +following run.") + (docker-args (list-of-strings '()) "Extra command-line arguments to pass to +@code{docker run}.") + (docker-cli (package docker-cli) "The package containing the Docker +executable to use.")) + +(define (docker-container-shepherd-service config) + (match-record config + (image + volumes + name + user + environment-variables + environment-files + network-type + read-only-root? + remove-after-stop? + docker-args + docker-cli) + + (let ((docker-run-args + `(,@(if read-only-root? '("--read-only") '()) + ,@(if remove-after-stop? '("--rm") '()) + "--network" ,network-type + ,@(if (maybe-value-set? name) `("--name" ,name) '()) + ,@(if (maybe-value-set? user) `("--user" ,user) '()) + ,@(append-map (cut list "--env-file" <>) environment-files) + ,@(append-map (cut list "-e" <>) environment-variables) + ,@(append-map + (match-lambda + (((? string? host-path) + (? string? container-path)) + `("-v" ,(string-append host-path ":" container-path))) + (((? string? host-path) + (? string? container-path) + (? boolean? read-write?)) + `("-v" ,(string-append host-path ":" container-path ":" + (if read-write? "rw" "ro"))))) + volumes)))) + + (shepherd-service + (provision (list (string->symbol + (string-append "docker-container-" (maybe-value name image))))) + (requirement (if (string=? network-type "none") '() '(networking))) + (documentation (format #f "Run a Docker container called ~s from the image ~s." + (maybe-value name) image)) + (start #~(lambda () + (use-modules ((srfi srfi-1) #:select (every)) + ((srfi srfi-26) #:select (cut)) + (ice-9 popen) + (ice-9 textual-ports)) + (let* ((hex (char-set #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9 + #\a #\b #\c #\d #\e #\f #\A #\B #\C #\D #\E #\F)) + (pipe + (open-pipe* OPEN_READ #$(file-append docker-cli "/bin/docker") + "run" "-d" #$@docker-run-args #$@docker-args #$image)) + (container-id + (string-trim-both (get-string-all pipe) char-whitespace?))) + (close-pipe pipe) + ;; We expect a hexadecimal container ID from `docker run'. + (and (every (cut char-set-contains? hex <>) + (string->list container-id)) + container-id)))) + ;; First arg is shepherd's "running value", i.e. whatever `start' returned. + (stop #~(lambda* (#:optional (container-id #$(maybe-value name #f))) + (if (zero? + (status:exit-val + (system* #$(file-append docker-cli "/bin/docker") "stop" container-id))) + #f ; #f means the service stopped and can be restarted again. + container-id))))))) + +(define (docker-container-shepherd-services configs) + (map docker-container-shepherd-service configs)) + +(define docker-container-service-type + (service-type + (name 'docker-container) + (extensions + (list (service-extension shepherd-root-service-type docker-container-shepherd-services))) + (default-value '()) + (compose concatenate) + (extend append) + (description "Run Docker containers under Shepherd."))) -- cgit v1.2.3