[bug#58123] [PATCH] gnu: services: docker: Add docker-container-service-type

[Maxime Devos <maximedevos@telenet.be>]

[-- Attachment #1.1.1: Type: text/plain, Size: 10291 bytes --]



On 27-09-2022 19:16, guix-patches--- via wrote:
> 
> This patch provides a new service type, which allows the creation of shepherd
> services from docker containers.
> ---
> Hi,
> 
> I have written a definition of the docker-container-service-type. It is
> a service that allows you to convert docker containers into shepherd
> services.  [...]
> 
> There is currently no documentation outside of docstrings, I plan to
> write it, but first I would welcome comments from you, maybe this
> service isn't suitable for guix, as it does imply breaking of the
> declarative guix model, but that goes for docker and flatpak too, so I
> thought I can try it.

We already have a docker-service-type, why not a 
docker-container-service-type, though I wouldn't recommend docker 
myself.  Can't really document on the docker bits, but some mostly 
superficial comments:

>
> +(define (pair-of-strings? val)
> +  (and (pair val)

I think you meant 'pair?' here, not 'pair'.

> +       (string? (car val))
> +       (string? (cdr val))))
> +
> +(define (list-of-pair-of-strings? val)
> +  (list-of pair-of-strings?))
> +
> +(define-configuration/no-serialization docker-container-configuration
> +  (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-}.")
> +  (comment
> +   (string "")
> +   "A documentation on the docker container.")

I don't think documentation is countable, maybe

"Documentation on the Docker container (optional)."

?  (I don't know what casing is appropriate here).

> +  (image-name
> +   (string)
> +   "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 binds. In (HOST_PATH CONTAINER_PATH) format.")

binds -> bindings and HOST_PATH CONTAINER_PATH -> (HOST-PATH 
CONTAINER-PATH) per Scheme conventions.

> +  (ports
> +   (list-of-pair-of-strings '())
> +   "A list of port binds. 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"

* binds -> bindings

> +   (environments
> +    (list-of-pair-of-strings '())
> +    "A list of variable binds, inside the container enviornment. In (VARIABLE VALUE) format."))

'enviornment' -> 'environment', 'variable binds' -> 'environment 
variables', '. In' -> ', in'.

> +  (network
> +   (string "none")
> +   "Network type.")

Can the available network types be listed or a reference to the Docker 
documentation be added, to help users with determining what to set it to?

> +  (additional-arguments
> +   (list-of-strings '())
> +   "Additional arguments to the docker command line interface.")
> +  (container-command
> +   (list-of-strings '())
> +   "Command to send into the container.")
> +  (attached?
> +   (boolean #t)
> +   "Run the container as an normal attached process (sending SIGTERM).
> +Or run the container as a isolated environment that must be stopped with @code{docker stop}.
> +
> +Please verify first, that you container is indeed not attached, otherwise @code{shepherd} might
> +assume the process is dead, even when it is not.
> +
> +You can do that, by first running your container with @code{docker run image-name}.
> +
> +Then check @code{docker ps}, if the command shows beside your container the word @code{running}.
> +Your container is indeed detached, but if it shows @code{starting}, and it doesn't flip to
> +@code{running} after a while, it means that you container is attached, and you need to keep this
> +option turned @code{#t}."))
> +
> +(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" (format #f "~?" "~a:~a" volume-bind)))
> +   (docker-container-configuration-volumes config)))

See following about pairs and simplification.

> +
> +(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" (format #f "~?" "~a:~a~^/~a" port-bind)))
> +   (docker-container-configuration-ports config)))

See following about pairs and simplification.

> +
> +(define (serialized-environments config)
> +  "Serialize list of pairs into flat list of @code{(\"-e\" \"VAR=val\" \"-e\" \"VAR=val\" ...)}."
> +  (append-map
> +   (lambda (env-bind)
> +     (list "-e" (format #f "~?" "~a=~a" env-bind)))
> +   (docker-container-configuration-environments config)))

I tried this out in a REPL, but found that it doesn't accept pairs but 
2-element lists:

scheme@(guile-user)> (format #f "~?" "~a=~a" '("x" . "y"))
ice-9/boot-9.scm:1685:16: In procedure raise-exception:
In procedure length: Wrong type argument in position 1: ("x" . "y")

Entering a new prompt.  Type `,bt' for a backtrace or `,q' to continue.
scheme@(guile-user) [1]> ,q
scheme@(guile-user)> (format #f "~?" "~a=~a" '("x" "y"))
$1 = "x=y"

Also, the 'format' can be simplified:

(apply format #f "~a=~a" env-bind)


> +
> +(define (docker-container-startup-script docker-cli container-name config)
> +  "Return a program file, that executes the startup sequence of the @code{docker-container-shepherd-service}."
> +  (let* ((attached? (docker-container-configuration-attached? config))
> +         (image-name (docker-container-configuration-image config))
> +         (volumes (serialize-volumes config))
> +         (ports (serialize-ports config))
> +         (envs (serialize-environments config))
> +         (network (docker-container-configuration-network config))
> +         (additional-arguments (docker-container-configuration-additional-arguments config))
> +         (container-command (docker-container-configuration-container-command config)))
> +    (program-file
> +     (string-append "start-" container-name "-container")
> +     #~(let ((docker (string-append #$docker-cli "/bin/docker")))
> +         (system* docker "stop" #$container-name)
> +         (system* docker "rm" #$container-name) > +         (apply system* `(,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)
> +                          ;; TODO:
> +                          ;; 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
> +                          ,@(if (not #$attached) '("--cidfile" #$cid-file) '())
> +                          #$@volumes
> +                          #$@ports
> +                          #$@envs
> +                          #$@additional-arguments
> +                          ,#$image-name
> +                          #$@container-command))))))

'system*' can fail, which it does by returning some number (and not by 
an exception).  I recommend using 'invoke' from (guix build utils) 
(which uses exceptions) instead; you may need use-modules + 
with-imported-modules to use that module.


> +
> +(define (docker-container-shepherd-service docker-cli config)
> +  "Return a shepherd-service that runs CONTAINER."
> +  (let* ((container-name (symbol->string (docker-container-configuration-name config)))
> +         (cid-file (string-append "/var/run/docker/" container-name ".pid"))

This sounds like ".", ".." and anything containing a "/" or "\x00" would 
be invalid container names, I recommend refining the type check for 
'container-name' a little.  It also looks like container names must be 
unique within a system, that sounds like something to mention in its 
docstring to me.

> +         (attached? (docker-container-configuration-attached? config)))
> +    (shepherd-service
> +     (provision (list (docker-container-configuration-name config)))
> +     (requirement `(dockerd))
> +     (start #~(make-forkexec-constructor
> +               (list #$(docker-container-startup-script docker-cli container-name config))
> +               ;; Watch the cid-file instead of the docker run command, as the daemon can
> +               ;; still be running even when the command terminates
> +               (if (not #$attached?)
> +                   #:pid-file #$cid-file)))

I don't think this does what you want it to do -- when attached, it will 
evaluate to #$cid-file, when not, it will evaluate to #:pid-flile.

Try apply+list instead:

(apply
   make-forkexec-constructor
   (list ...)
   #$(if $attached
         #~()
         #~(list #:pid-file #$cid-file)))

(Changing the staging is not required, though myself I prefer it this way.)

I recommend writing a system test (in gnu/tests/docker.scm), to prevent 
such problems, though I don't know how feasible it would be.

> +     (stop (if #$attached?
> +               #~(make-kill-destructor)
> +               #~(lambda _
> +                   (exec-command (list
> +                                  (string-append #$docker-cli "/bin/docker")
> +                                  "stop" #$container-name))
> +                   #f))))))

Not very familiar with how Shepherd works here, but I think that the 
'return #false' dseserves a command.

Also, on (string-append #$docker-cli "/bin/docker"): we have
#$(file-append docker-cli "/bin/docker") for that, though in this case 
it doesn't matter (for uses inside 'quote', it does, but here, not really).

Greetings,
Maxime.

[-- Attachment #1.1.2: OpenPGP public key --]
[-- Type: application/pgp-keys, Size: 929 bytes --]

[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 236 bytes --]