aboutsummaryrefslogtreecommitdiff
path: root/bin
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2018-01-22 23:07:10 +0100
committerLudovic Courtès <ludo@gnu.org>2018-01-22 23:39:51 +0100
commitee11ba1d93b24753eafcd77eef8543e5cac5ba4c (patch)
tree4179c8ead2eadbcee2dd7e922cfa82fe114a8c88 /bin
parentf9481e2222ae127d631888c0d81f5b725c5cbc2a (diff)
downloadcuirass-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.in50
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)))))))