Andy Wingo 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’.