diff options
author | Ludovic Courtès <ludo@gnu.org> | 2018-01-22 23:07:10 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2018-01-22 23:39:51 +0100 |
commit | ee11ba1d93b24753eafcd77eef8543e5cac5ba4c (patch) | |
tree | 4179c8ead2eadbcee2dd7e922cfa82fe114a8c88 /bin | |
parent | f9481e2222ae127d631888c0d81f5b725c5cbc2a (diff) | |
download | cuirass-ee11ba1d93b24753eafcd77eef8543e5cac5ba4c.tar cuirass-ee11ba1d93b24753eafcd77eef8543e5cac5ba4c.tar.gz |
Introduce concurrency with Fibers.
* README: Mark Fibers as required.
* configure.ac: Check for Guile 2.2 only. Check for (fibers).
* bin/cuirass.in (main): Use (fibers). Run 'process-specs' and web
server in separate fibers.
* src/cuirass/base.scm (with-store): New macro.
(non-blocking-port): New procedure.
(evaluate): Use 'non-blocking-port'. Use 'read-string' followed by 'read'.
(process-specs): Move 'db-add-stamp' right after 'string=?' comparison.
Run evaluation and subsequent builds in a separate fiber.
* src/cuirass/http.scm (run-cuirass-server): Pass 'fibers as the second
argument to 'run-server'. Use 'log-message' instead of 'format'.
* src/cuirass/database.scm (with-database): Remove 'dynamic-wind'.
Diffstat (limited to 'bin')
-rw-r--r-- | bin/cuirass.in | 50 |
1 files changed, 32 insertions, 18 deletions
diff --git a/bin/cuirass.in b/bin/cuirass.in index f11a6a5..725712d 100644 --- a/bin/cuirass.in +++ b/bin/cuirass.in @@ -26,7 +26,9 @@ exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" "$@" (use-modules (cuirass) (cuirass ui) + (cuirass logging) (guix ui) + (fibers) (ice-9 getopt-long)) (define (show-help) @@ -90,23 +92,35 @@ exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" "$@" (let ((one-shot? (option-ref opts 'one-shot #f)) (port (string->number (option-ref opts 'port "8080"))) (host (option-ref opts 'listen "localhost")) - (interval (string->number (option-ref opts 'interval "10"))) + (interval (string->number (option-ref opts 'interval "300"))) (specfile (option-ref opts 'specifications #f))) (prepare-git) - (with-database db - (and specfile - (let ((new-specs (save-module-excursion - (lambda () - (set-current-module (make-user-module '())) - (primitive-load specfile))))) - (for-each (lambda (spec) (db-add-specification db spec)) - new-specs))) - (if one-shot? - (process-specs db (db-get-specifications db)) - (begin - (call-with-new-thread - (lambda () - (while #t - (process-specs db (db-get-specifications db)) - (sleep interval)))) - (run-cuirass-server db #:host host #:port port)))))))))) + (run-fibers + (lambda () + (with-database db + (and specfile + (let ((new-specs (save-module-excursion + (lambda () + (set-current-module (make-user-module '())) + (primitive-load specfile))))) + (for-each (lambda (spec) (db-add-specification db spec)) + new-specs))) + (if one-shot? + (process-specs db (db-get-specifications db)) + (begin + (spawn-fiber + (lambda () + (with-database db + (while #t + (process-specs db (db-get-specifications db)) + (log-message "sleeping for ~a seconds" interval) + (sleep interval))))) + (spawn-fiber + (lambda () + (with-database db + (run-cuirass-server db + #:host host + #:port port)))) + *unspecified*)))) + + #:drain? #t))))))) |