GNU bug report logs -
#26645
guix potluck
Previous Next
Reported by: Andy Wingo <wingo <at> pobox.com>
Date: Mon, 24 Apr 2017 20:54:02 UTC
Severity: important
Done: Maxim Cournoyer <maxim.cournoyer <at> gmail.com>
Bug is archived. No further changes may be made.
Full log
Message #187 received at 26645 <at> debbugs.gnu.org (full text, mbox):
Andy Wingo <wingo <at> igalia.com> 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’.
This bug report was last modified 1 year and 308 days ago.
Previous Next
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.