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 @lisp
(service oci-container-service-type (service oci-container-service-type
(list (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 (oci-container-configuration
(image "prom/prometheus") (image "prom/prometheus")
(network "host") (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} @uref{https://docs.docker.com/engine/reference/commandline/run/#env,upstream}
documentation for semantics. documentation for semantics.
@item @code{image} (type: string) @item @code{image} (type: string-or-oci-image)
The image used to build the container. Images are resolved by the The image used to build the container. It can be a string or an
Docker Engine, and follow the usual format @code{oci-image} record. Strings are resolved by the Docker Engine, and
follow the usual format
@code{myregistry.local:5000/testing/test-image:tag}. @code{myregistry.local:5000/testing/test-image:tag}.
@item @code{provision} (default: @code{""}) (type: string) @item @code{provision} (default: @code{""}) (type: string)
@ -40673,6 +40685,58 @@ passed to the @command{docker run} invokation.
@end deftp @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 @c %end of fragment
@cindex Audit @cindex Audit

View file

@ -23,11 +23,14 @@
;;; 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 base)
#:use-module (gnu services dbus) #: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 setuid) #:use-module (gnu system setuid)
#:use-module (gnu system shadow) #:use-module (gnu system shadow)
#:use-module (gnu packages admin) ;shadow #:use-module (gnu packages admin) ;shadow
@ -37,7 +40,11 @@ (define-module (gnu services docker)
#:use-module (guix diagnostics) #:use-module (guix diagnostics)
#:use-module (guix gexp) #:use-module (guix gexp)
#:use-module (guix i18n) #: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 format) #:use-module (ice-9 format)
#:use-module (ice-9 match) #:use-module (ice-9 match)
@ -45,6 +52,16 @@ (define-module (gnu services docker)
#:export (docker-configuration #:export (docker-configuration
docker-service-type docker-service-type
singularity-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? oci-container-configuration?
oci-container-configuration-fields oci-container-configuration-fields
@ -52,9 +69,11 @@ (define-module (gnu services docker)
oci-container-configuration-group oci-container-configuration-group
oci-container-configuration-command oci-container-configuration-command
oci-container-configuration-entrypoint oci-container-configuration-entrypoint
oci-container-configuration-host-environment
oci-container-configuration-environment oci-container-configuration-environment
oci-container-configuration-image oci-container-configuration-image
oci-container-configuration-provision oci-container-configuration-provision
oci-container-configuration-requirement
oci-container-configuration-network oci-container-configuration-network
oci-container-configuration-ports oci-container-configuration-ports
oci-container-configuration-volumes oci-container-configuration-volumes
@ -62,7 +81,8 @@ (define-module (gnu services docker)
oci-container-configuration-workdir oci-container-configuration-workdir
oci-container-configuration-extra-arguments oci-container-configuration-extra-arguments
oci-container-service-type oci-container-service-type
oci-container-shepherd-service)) oci-container-shepherd-service
%oci-container-accounts))
(define-maybe file-like) (define-maybe file-like)
@ -320,11 +340,68 @@ (define (valid? member)
but ~a was found") el)))) but ~a was found") el))))
value)) 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? (define list-of-symbols?
(list-of symbol?)) (list-of symbol?))
(define-maybe/no-serialization string) (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 (define-configuration/no-serialization oci-container-configuration
(user (user
(string "oci-container") (string "oci-container")
@ -372,8 +449,9 @@ (define-configuration/no-serialization oci-container-configuration
documentation for semantics." documentation for semantics."
(sanitizer oci-sanitize-environment)) (sanitizer oci-sanitize-environment))
(image (image
(string) (string-or-oci-image)
"The image used to build the container. Images are resolved by the Docker "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 Engine, and follow the usual format
@code{myregistry.local:5000/testing/test-image:tag}.") @code{myregistry.local:5000/testing/test-image:tag}.")
(provision (provision
@ -470,14 +548,122 @@ (define oci-container-configuration->options
(list "-v" spec)) (list "-v" spec))
(oci-container-configuration-volumes config)))))))) (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 (oci-container-shepherd-service config)
(define (guess-name name image) (define (guess-name name image)
(if (maybe-value-set? name) (if (maybe-value-set? name)
name name
(string-append "docker-" (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)) (user (oci-container-configuration-user config))
(group (oci-container-configuration-group config)) (group (oci-container-configuration-group config))
(host-environment (host-environment
@ -486,6 +672,7 @@ (define (guess-name name image)
(provision (oci-container-configuration-provision config)) (provision (oci-container-configuration-provision config))
(requirement (oci-container-configuration-requirement config)) (requirement (oci-container-configuration-requirement config))
(image (oci-container-configuration-image config)) (image (oci-container-configuration-image config))
(image-reference (oci-image-reference image))
(options (oci-container-configuration->options config)) (options (oci-container-configuration->options config))
(name (guess-name provision image)) (name (guess-name provision image))
(extra-arguments (extra-arguments
@ -496,30 +683,37 @@ (define (guess-name name image)
(respawn? #f) (respawn? #f)
(documentation (documentation
(string-append (string-append
"Docker backed Shepherd service for image: " image)) "Docker backed Shepherd service for "
(if (oci-image? image) name image) "."))
(start (start
#~(make-forkexec-constructor #~(lambda ()
;; docker run [OPTIONS] IMAGE [COMMAND] [ARG...] (when #$(oci-image? image)
(list #$docker-command "run" "--rm" (invoke #$(%oci-image-loader
"--name" #$name name image image-reference)))
#$@options #$@extra-arguments #$image #$@command) (fork+exec-command
#:user #$user ;; docker run [OPTIONS] IMAGE [COMMAND] [ARG...]
#:group #$group (list #$docker "run" "--rm" "--name" #$name
#:environment-variables #$@options #$@extra-arguments
(list #$@host-environment))) #$image-reference #$@command)
#:user #$user
#:group #$group
#:environment-variables
(list #$@host-environment))))
(stop (stop
#~(lambda _ #~(lambda _
(invoke #$docker-command "rm" "-f" #$name))) (invoke #$docker "rm" "-f" #$name)))
(actions (actions
(list (if (oci-image? image)
(shepherd-action '()
(name 'pull) (list
(documentation (shepherd-action
(format #f "Pull ~a's image (~a)." (name 'pull)
name image)) (documentation
(procedure (format #f "Pull ~a's image (~a)."
#~(lambda _ name image))
(invoke #$docker-command "pull" #$image))))))))) (procedure
#~(lambda _
(invoke #$docker "pull" #$image))))))))))
(define %oci-container-accounts (define %oci-container-accounts
(list (user-account (list (user-account