gnu: docker: Allow passing tarballs for images in oci-container-configuration.

This commit allows for loading an OCI image tarball before running an
OCI backed Shepherd service. It does so by adding a one shot Shepherd
service to the dependencies of the OCI backed service that at boot runs
docker load on the tarball.

* gnu/services/docker.scm (oci-image): New record;
(lower-oci-image): new variable, lower it;
(string-or-oci-image?): sanitize it;
(oci-container-configuration)[image]: allow also for oci-image records;
(oci-container-shepherd-service): use it;
(%oci-image-loader): new variable.

Change-Id: Ie504f479ea0d47f74b0ec5df9085673ffd3f639d
Signed-off-by: Ludovic Courtès <ludo@gnu.org>
This commit is contained in:
Giacomo Leidi 2024-05-04 00:11:16 +02:00 committed by Ludovic Courtès
parent 68adfaea25
commit c07731a777
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 286 additions and 28 deletions

View file

@ -40534,6 +40534,17 @@ processes as Shepherd Services.
@lisp
(service oci-container-service-type
(list
(oci-container-configuration
(image
(oci-image
(repository "guile")
(tag "3")
(value (specifications->manifest '("guile")))
(pack-options '(#:symlinks (("/bin/guile" -> "bin/guile"))
#:max-layers 2))))
(entrypoint "/bin/guile")
(command
'("-c" "(display \"hello!\n\")")))
(oci-container-configuration
(image "prom/prometheus")
(network "host")
@ -40610,9 +40621,10 @@ Strings are passed directly to the Docker CLI. You can refer to the
@uref{https://docs.docker.com/engine/reference/commandline/run/#env,upstream}
documentation for semantics.
@item @code{image} (type: string)
The image used to build the container. Images are resolved by the
Docker Engine, and follow the usual format
@item @code{image} (type: 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}.
@item @code{provision} (default: @code{""}) (type: string)
@ -40673,6 +40685,58 @@ passed to the @command{docker run} invokation.
@end deftp
@c %end of fragment
@c %start of fragment
@deftp {Data Type} oci-image
Available @code{oci-image} fields are:
@table @asis
@item @code{repository} (type: string)
A string like @code{myregistry.local:5000/testing/test-image} that names
the OCI image.
@item @code{tag} (default: @code{"latest"}) (type: string)
A string representing the OCI image tag. Defaults to @code{latest}.
@item @code{value} (type: 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.
@item @code{pack-options} (default: @code{'()}) (type: 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")
(value
(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.
@item @code{system} (default: @code{""}) (type: string)
Attempt to build for a given system, e.g. "i686-linux"
@item @code{target} (default: @code{""}) (type: string)
Attempt to cross-build for a given triple, e.g. "aarch64-linux-gnu"
@item @code{grafts?} (default: @code{#f}) (type: boolean)
Whether to allow grafting or not in the pack build.
@end table
@end deftp
@c %end of fragment
@cindex Audit

View file

@ -23,11 +23,14 @@
;;; 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 shepherd)
#:use-module (gnu system)
#:use-module (gnu system image)
#:use-module (gnu system setuid)
#:use-module (gnu system shadow)
#:use-module (gnu packages admin) ;shadow
@ -37,7 +40,11 @@ (define-module (gnu services docker)
#: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 format)
#:use-module (ice-9 match)
@ -45,6 +52,16 @@ (define-module (gnu services docker)
#:export (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
@ -52,9 +69,11 @@ (define-module (gnu services docker)
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-network
oci-container-configuration-ports
oci-container-configuration-volumes
@ -62,7 +81,8 @@ (define-module (gnu services docker)
oci-container-configuration-workdir
oci-container-configuration-extra-arguments
oci-container-service-type
oci-container-shepherd-service))
oci-container-shepherd-service
%oci-container-accounts))
(define-maybe file-like)
@ -320,11 +340,68 @@ (define (valid? member)
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")
@ -372,8 +449,9 @@ (define-configuration/no-serialization oci-container-configuration
documentation for semantics."
(sanitizer oci-sanitize-environment))
(image
(string)
"The image used to build the container. Images are resolved by the Docker
(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
@ -470,14 +548,122 @@ (define oci-container-configuration->options
(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 (car (string-split image #\:))))))
(basename
(if (string? image)
(first (string-split image #\:))
(oci-image-repository image))))))
(let* ((docker-command (file-append docker-cli "/bin/docker"))
(let* ((docker (file-append docker-cli "/bin/docker"))
(user (oci-container-configuration-user config))
(group (oci-container-configuration-group config))
(host-environment
@ -486,6 +672,7 @@ (define (guess-name name image)
(provision (oci-container-configuration-provision config))
(requirement (oci-container-configuration-requirement 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
@ -496,21 +683,28 @@ (define (guess-name name image)
(respawn? #f)
(documentation
(string-append
"Docker backed Shepherd service for image: " image))
"Docker backed Shepherd service for "
(if (oci-image? image) name image) "."))
(start
#~(make-forkexec-constructor
#~(lambda ()
(when #$(oci-image? image)
(invoke #$(%oci-image-loader
name image image-reference)))
(fork+exec-command
;; docker run [OPTIONS] IMAGE [COMMAND] [ARG...]
(list #$docker-command "run" "--rm"
"--name" #$name
#$@options #$@extra-arguments #$image #$@command)
(list #$docker "run" "--rm" "--name" #$name
#$@options #$@extra-arguments
#$image-reference #$@command)
#:user #$user
#:group #$group
#:environment-variables
(list #$@host-environment)))
(list #$@host-environment))))
(stop
#~(lambda _
(invoke #$docker-command "rm" "-f" #$name)))
(invoke #$docker "rm" "-f" #$name)))
(actions
(if (oci-image? image)
'()
(list
(shepherd-action
(name 'pull)
@ -519,7 +713,7 @@ (define (guess-name name image)
name image))
(procedure
#~(lambda _
(invoke #$docker-command "pull" #$image)))))))))
(invoke #$docker "pull" #$image))))))))))
(define %oci-container-accounts
(list (user-account