Hi,
One can always pass a list of 'oci-{container,network,volume}-configuration's to an 'oci-configuration':@lisp -(service oci-container-service-type - (list - (oci-container-configuration - (network "host") - (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") - (ports - '(("9000" . "9000") - ("9090" . "9090")))) - (oci-container-configuration - (image "grafana/grafana:10.0.1") - (network "host") - (volumes - '("/var/lib/grafana:/var/lib/grafana"))))) +(simple-service 'oci-provisioning + oci-service-type + (oci-extension + (networks + (list + (oci-network-configuration (name "monitoring")))) + (containers + (list + (oci-container-configuration + (network "monitoring") + (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") + (ports + '(("9000" . "9000") + ("9090" . "9090")))) + (oci-container-configuration + (image "grafana/grafana:10.0.1") + (network "host") + (volumes + '("/var/lib/grafana:/var/lib/grafana")))))))I was curious: was is the gain to have by using the extension mechanism instead of directly accepting a list of 'oci-configuration' or similarly named record to the oci-service-type?
(service oci-service-type
(oci-configuration
(runtime 'podman)
(containers
(list
(oci-container-configuration ...)))))
Thank you I was not aware of this option, I tried to move as much as I could to gnu/build/oci-containers.scm.+(define (oci-object-exists? runtime runtime-cli object verbose?) + #~(lambda* (name #:key (format-string "{{.Name}}")) + (use-modules (ice-9 format) + (ice-9 match) + (ice-9 popen) + (ice-9 rdelim) + (srfi srfi-1)) + + (define (read-lines file-or-port) + (define (loop-lines port) + (let loop ((lines '())) + (match (read-line port) + ((? eof-object?) + (reverse lines)) + (line + (loop (cons line lines)))))) + + (if (port? file-or-port) + (loop-lines file-or-port) + (call-with-input-file file-or-port + loop-lines))) + + #$(if (eq? runtime 'podman) + #~(let ((command + (list #$runtime-cli + #$object "exists" name))) + (when #$verbose? + (format #t "Running~{ ~a~}~%" command)) + (define exit-code (status:exit-val (apply system* command))) + (when #$verbose? + (format #t "Exit code: ~a~%" exit-code)) + (equal? EXIT_SUCCESS exit-code)) + #~(let ((command + (string-append #$runtime-cli + " " #$object " ls --format " + "\"" format-string "\""))) + (when #$verbose? + (format #t "Running ~a~%" command)) + (member name (read-lines (open-input-pipe command)))))))That's a complex piece of staged code; have you considered placing it in a supporting build-side module, e.g. gnu/build/oci-containers.scm ? Then it could be more simply imported in the gexp environment and used. See the gnu/build/jami-service.scm for an example.
Good idea, I made an intermediate oci-container-invocation record.+(define* (oci-image-loader runtime runtime-cli name image tag #:key (verbose? #f)) + "Return a file-like object that, once lowered, will evaluate to a program able +to load IMAGE through RUNTIME-CLI and to tag it with TAG afterwards." + (let ((tarball (lower-oci-image name image))) (with-imported-modules '((guix build utils)) - (program-file (format #f "~a-image-loader" name) + (program-file + (format #f "~a-image-loader" name) #~(begin (use-modules (guix build utils) + (ice-9 match) (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 - (if (string? image) - (first (string-split image #\:)) - (oci-image-repository image)))))) - - (let* ((docker (file-append docker-cli "/bin/docker")) - (actions (oci-container-configuration-shepherd-actions config)) + (ice-9 rdelim) + (srfi srfi-1)) + (define object-exists? + #$(oci-object-exists? runtime runtime-cli "image" verbose?)) + (define load-command + (string-append #$runtime-cli + " load -i " #$tarball)) + + (if (object-exists? #$tag #:format-string "{{.Repository}}:{{.Tag}}") + (format #t "~a image already exists, skipping.~%" #$tag) + (begin + (format #t "Loading image for ~a from ~a...~%" #$name #$tarball) + (when #$verbose? + (format #t "Running ~a~%" load-command)) + (let ((line (read-line + (open-input-pipe load-command)))) + (unless (or (eof-object? line) + (string-null? line)) + (format #t "~a~%" line) + (let* ((repository&tag + (string-drop line + (string-length + "Loaded image: "))) + (tag-command + (list #$runtime-cli "tag" repository&tag #$tag)) + (drop-old-tag-command + (list #$runtime-cli "image" "rm" "-f" repository&tag))) + + (unless (string=? repository&tag #$tag) + (when #$verbose? + (format #t "Running~{ ~a~}~%" tag-command)) + + (let ((exit-code + (status:exit-val (apply system* tag-command)))) + (format #t "Tagged ~a with ~a...~%" #$tarball #$tag) + + (when #$verbose? + (format #t "Exit code: ~a~%" exit-code)) + + (when (equal? EXIT_SUCCESS exit-code) + (when #$verbose? + (format #t "Running~{ ~a~}~%" drop-old-tag-command)) + (let ((drop-exit-code + (status:exit-val (apply system* drop-old-tag-command)))) + (when #$verbose? + (format #t "Exit code: ~a~%" drop-exit-code)))))))))))))))) + +(define (oci-container-run-invocation runtime runtime-cli name command image-reference + options runtime-extra-arguments run-extra-arguments)That's a lot of arguments! Perhaps it could accept a record instead? Please also mind the 80 chars max width.
+ "Return a list representing the OCI runtime +invocation for running containers." + ;; run [OPTIONS] IMAGE [COMMAND] [ARG...] + `(,runtime-cli ,@runtime-extra-arguments "run" "--rm" + ,@(if (eq? runtime 'podman) + ;; This is because podman takes some time to + ;; release container names. --replace seems + ;; to be required to be able to restart services. + '("--replace") + '()) + "--name" ,name + ,@options ,@run-extra-arguments + ,image-reference ,@command)) + +(define* (oci-container-entrypoint runtime runtime-cli name image image-reference + invocation #:key (verbose? #f) (pre-script #~()))The default value for a keyword argument is #f, so I'd omit the explicit default for verbose?.Max width :-).+ (begin + (when #$verbose? + (format #t "Running~{ ~a~}~%" invocation)) + (let ((exit-code (status:exit-val (apply system* invocation)))) + (when #$verbose? + (format #t "Exit code: ~a~%" exit-code)))))) + (list #$@invocations))))) + +(define* (oci-object-shepherd-service object runtime runtime-cli name requirement invocations
I should have dropped the default #f for keywords in all procedure, thanks.
Thank you, I have addressed this in gnu/build/oci-containers.scm+ "Return a file-like object that, once lowered, will evaluate to the entrypoint +for the Shepherd service that will run IMAGE through RUNTIME-CLI." + (program-file + (string-append "oci-entrypoint-" name) + #~(begin + (use-modules (ice-9 format) + (srfi srfi-1)) + (when #$verbose? + (format #t "Running in verbose mode...~%") + (format #t "Current user: ~a ~a~%" + (getuid) (passwd:name (getpwuid (getuid)))) + (format #t "Current group: ~a ~a~%" + (getgid) (group:name (getgrgid (getgid)))) + (format #t "Current directory ~a~%" (getcwd)))I'd use a single format call; you can format the string naturally like (format #t "\ Running in verbose mode... Current user: ~a ~a ... " arg1 arg2, ...)+ (define invocation (list #$@invocation)) + #$@pre-script + (when #$verbose? + (format #t "Running~{ ~a~}~%" invocation)) + (apply execlp `(,(first invocation) ,@invocation)))))You can more simply: (apply execlp (first invocation) invocation)
I tried to address this but it's really difficult to trim much, please let me know if there's some better way.+ +(define* (oci-container-shepherd-service runtime runtime-cli config + #:key + (runtime-environment #~()) + (runtime-extra-arguments '()) + (oci-requirement '()) + (user #f) + (group #f) + (verbose? #f)) + "Return a Shepherd service object that will run the OCI container represented +by CONFIG through RUNTIME-CLI." + (let* ((actions (oci-container-configuration-shepherd-actions config)) (auto-start? (oci-container-configuration-auto-start? config)) - (user (oci-container-configuration-user config)) - (group (oci-container-configuration-group config)) + (maybe-user (oci-container-configuration-user config)) + (maybe-group (oci-container-configuration-group config)) + (user (if (maybe-value-set? maybe-user) + maybe-user + user)) + (group (if (maybe-value-set? maybe-group) + maybe-group + group)) (host-environment (oci-container-configuration-host-environment config)) (command (oci-container-configuration-command config)) (log-file (oci-container-configuration-log-file config)) - (provision (oci-container-configuration-provision config)) (requirement (oci-container-configuration-requirement config)) (respawn? (oci-container-configuration-respawn? config)) (image (oci-container-configuration-image config)) (image-reference (oci-image-reference image)) (options (oci-container-configuration->options config)) - (name (guess-name provision image)) + (name + (oci-container-shepherd-name runtime config)) (extra-arguments - (oci-container-configuration-extra-arguments config))) + (oci-container-configuration-extra-arguments config)) + (invocation + (oci-container-run-invocation + runtime runtime-cli name command image-reference + options runtime-extra-arguments extra-arguments)) + (container-action + (lambda* (command #:key (environment-variables #f)) + #~(lambda _ + (fork+exec-command + (list #$@command) + #$@(if user (list #:user user) '()) + #$@(if group (list #:group group) '()) + #$@(if (maybe-value-set? log-file) + (list #:log-file log-file) + '()) + #$@(if (and user (eq? runtime 'podman)) + (list #:directory + #~(passwd:dir (getpwnam #$user))) + '()) + #$@(if environment-variables + (list #:environment-variables + environment-variables) + '()))))))That's a very long let. Since many values appear to simply be accessed from theh oci-container-configuration, match-record could be used to great effect. For readability, I'd also define the action procedures using nested 'define' inside the let/match-record.
It is, I just replace this with a more descriptive error that allows the users to drop the duplicate without silently dropping a random one between the two.+(define (oci-service-subids config) + "Return a subids-extension record representing subuids and subgids required by +the rootless Podman backend." + (define (delete-duplicate-ranges ranges) + (delete-duplicates ranges + (lambda args + (apply string=? (map subid-range-name ranges)))))I don't understand how the above 'delete-duplicate-ranges' procedure works; the 2nd argument of delete-duplicates is normally a predicate that accepts two values, but here it's a lambda that disregards the arguments: it seems it'd be wasteful to compute the same result over and over?
I think this test can be dropped anyway since we later wait for Shepherd services to be started, it is a development leftover.+ (response1 + (slurp bash "-c" + (string-append "ls -la /sys/fs/cgroup | " + "grep -E ' \\./?$' | awk '{ print $4 }'"))) + (response2 (slurp bash "-c" + (string-append "ls -l /sys/fs/cgroup/cgroup" + ".{procs,subtree_control,threads} | " + "awk '{ print $4 }' | sort -u"))))Is there perhaps an easier way to check that the podman services were started successfully? Perhaps using the podman command directly to query the state of the running containers? 'ls' is usually frowned for scripting; it's meant for interactive use. Perhaps you could use the shell wildcard feature or the find command instead? I comment explaining what the above does/check exactly would be useful; it's not obvious.
+ (let loop ((attempts 0)) + (if (= attempts 60) + (error "Services didn't come up after more than 60 seconds") + (if (equal? '("cgroup" "cgroup") + (run-test)) + #t + (begin + (sleep 1) + (format #t "Services didn't come up yet, retrying with attempt ~a~%" + (+ 1 attempts)) + (loop (+ 1 attempts))))))))Note that we have a 'with-retries' definition in (gnu build jami-service) which could be used here; perhaps it should be relocated elsewhere.
Thank you for the hint, I created gnu/build/utils.scm and tested my changes with:
guix shell -CPWN --writable-root nss-certs -m manifest.scm -- make check-system TESTS="pounce jami ngircd"
You bring two good points, addressed by dropping dynamic-wind and refactoring duplicate code in tests.+ (lambda (port) + (display (string-join response "\n") port))))) + (lambda () + (primitive-exit 127))))The fork is used to be able to run the podman command with the right passwd and uid, right? Maybe you could use the shepherd's provided 'command' or 'fork+exec-command', which have a nice API to do this. Also, is the dynamic-wind unnecessary? I would have thought that if a forked children aborts, its exit status should be reflected accordingly?
This should be addressed now.The idiom of forking ot invoke podman is used so commonly it should be extracted to a procedure or syntax and reused.
Thank you a lot for taking the time to go through all of this, I hope I addressed all your comments successfully. Please let me know if something seems off.Phew, that was a large chunk! I'll continue my review with the remaining commits, but when I'm done, could you please submit a v11, taking into account my comments?