From mboxrd@z Thu Jan 1 00:00:00 1970 Received: from eggs.gnu.org ([2001:4830:134:3::10]:51830) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1d6NnB-000347-5S for guix-patches@gnu.org; Thu, 04 May 2017 16:56:06 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1d6Nn8-0007sj-1m for guix-patches@gnu.org; Thu, 04 May 2017 16:56:05 -0400 Received: from debbugs.gnu.org ([208.118.235.43]:56722) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1d6Nn7-0007se-TZ for guix-patches@gnu.org; Thu, 04 May 2017 16:56:01 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1d6Nn7-0005Hi-Ld for guix-patches@gnu.org; Thu, 04 May 2017 16:56:01 -0400 Subject: bug#26645: [PATCH 8/9] potluck: Add host-channel subcommand. Resent-Message-ID: From: ludo@gnu.org (Ludovic =?UTF-8?Q?Court=C3=A8s?=) References: <20170424205923.27726-1-wingo@igalia.com> <20170424205923.27726-8-wingo@igalia.com> Date: Thu, 04 May 2017 22:55:36 +0200 In-Reply-To: <20170424205923.27726-8-wingo@igalia.com> (Andy Wingo's message of "Mon, 24 Apr 2017 22:59:22 +0200") Message-ID: <87y3uc8hpz.fsf@gnu.org> MIME-Version: 1.0 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+kyle=kyleam.com@gnu.org Sender: "Guix-patches" To: Andy Wingo Cc: 26645@debbugs.gnu.org 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=3Davail" filename)) Please use =E2=80=98statfs=E2=80=99 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=E2=80=99t there be multiple threads running this code in parallel? I= =E2=80=99m wary of changing the cwd in general, especially in multi-threaded programs. How hard would it be to aviod the =E2=80=98chdir=E2=80=99 and =E2=80=98with-directory-excursion=E2=80=99 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=E2=80=99.