bug#26645: [PATCH 8/9] potluck: Add host-channel subcommand.

[Ludovic Courtès]

Andy Wingo <address@hidden> skribis:

> * guix/potluck/host.scm: New file.
> * Makefile.am (MODULES): Add new file.
> * guix/scripts/potluck.scm: Add host-channel command.

[...]

> +(define-module (guix potluck host)

Could you add a commentary explaining what it does?

> +;;;
> +;;; async queues
> +;;;

Nice; perhaps in the future (guix workers) should use these instead of
rolling & entangling its own.

> +(define (bytes-free-on-fs filename)
> +  (let* ((p (open-pipe* "r" "df" "-B1" "--output=avail" filename))

Please use ‘statfs’ from (guix build syscalls) instead, it should be
nicer.  ;-)

> +(define (process-update host working-dir source-checkout target-checkout
> +                        remote-git-url branch)

Please add a docstring to guide the reader.

> +  (when (< (bytes-free-on-fs working-dir) *mininum-free-space*)
> +    (delete-directory-contents-recursively working-dir)
> +    (when (< (bytes-free-on-fs working-dir) *mininum-free-space*)
> +      (error "not enough free space")))
> +  (chdir working-dir)
> +  (let* ((repo-dir (uri-encode remote-git-url))
> +         (repo+branch-dir (in-vicinity repo-dir (uri-encode branch))))
> +    (cond
> +     ((file-exists? repo-dir)
> +      (chdir repo-dir)
> +      (git-fetch))
> +     (else
> +      (git-clone remote-git-url repo-dir)
> +      (chdir repo-dir)))
> +    (git-reset #:ref (string-append "origin/" branch) #:mode 'hard)
> +    (unless (file-is-directory? "guix-potluck")
> +      (error "repo+branch has no guix-potluck dir" remote-git-url branch))
> +    (let* ((files (scm-files-in-dir "guix-potluck"))
> +           ;; This step safely loads and validates the potluck package
> +           ;; definitions.
> +           (packages (map load-potluck-package files))
> +           (source-dir (in-vicinity source-checkout repo+branch-dir))
> +           (target-dir (in-vicinity target-checkout
> +                                    (in-vicinity "gnu/packages/potluck"
> +                                                 repo+branch-dir))))
> +      ;; Clear source and target repo entries.
> +      (define (ensure-empty-dir filename)
> +        (when (file-exists? filename)
> +          (delete-file-recursively filename))
> +        (mkdir-p filename))
> +      (define (commit-dir dir)
> +        (with-directory-excursion dir

Can’t there be multiple threads running this code in parallel?  I’m
wary of changing the cwd in general, especially in multi-threaded
programs.  How hard would it be to aviod the ‘chdir’ and
‘with-directory-excursion’ uses?

> +(define (host-potluck host local-port working-dir source-checkout
> +                      target-checkout)

Please add a docstring.

> +  (let ((worker-thread #f)
> +        (queue (make-async-queue)))
> +    (dynamic-wind (lambda ()
> +                    (set! worker-thread
> +                      (make-thread
> +                       (service-queue host working-dir
> +                                      source-checkout target-checkout
> +                                      queue))))
> +                  (lambda ()
> +                    (run-server
> +                     (lambda (request body)
> +                       (handler request body queue))
> +                     ;; Always listen on localhost.
> +                     'http `(#:port ,local-port)))
> +                  (lambda ()
> +                    (cancel-thread worker-thread)))))

In fact perhaps (guix workers) would work here?

As always I would feel reassured with a couple of tests.  :-)  Perhaps
we could spawn a service thread as in tests/publish.scm, and mock the
Git procedures?

Thank you!

Ludo’.