diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2018-01-27 16:04:31 +0100 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2018-01-27 16:04:31 +0100 |
| commit | 0098e613dbd910063a63d50d9ea5028b2892b619 (patch) | |
| tree | 2f26163027a572862bda3efe039962241c560bbf /bin | |
| parent | 4558d1c86914e2427fc99afbe00c28cb716dbd3d (diff) | |
| download | cuirass-0098e613dbd910063a63d50d9ea5028b2892b619.tar cuirass-0098e613dbd910063a63d50d9ea5028b2892b619.tar.gz | |
cuirass: Add 'essential-task' and wrap the main fibers in it.
* src/cuirass/utils.scm (essential-task): New procedure.
* bin/cuirass.in (main): Wrap each fiber in 'essential-task'.
Diffstat (limited to 'bin')
| -rw-r--r-- | bin/cuirass.in | 47 |
1 files changed, 19 insertions, 28 deletions
diff --git a/bin/cuirass.in b/bin/cuirass.in index 13de395..4431a60 100644 --- a/bin/cuirass.in +++ b/bin/cuirass.in @@ -27,6 +27,7 @@ exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" "$@" (use-modules (cuirass) (cuirass ui) (cuirass logging) + (cuirass utils) (guix ui) (fibers) (fibers channels) @@ -117,38 +118,28 @@ exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" "$@" ;; First off, restart builds that had not completed or ;; were not even started on a previous run. (spawn-fiber - (lambda () - (with-database db - (restart-builds db pending)))) + (essential-task + 'restart-builds exit-channel + (lambda () + (with-database db + (restart-builds db pending))))) (spawn-fiber - (lambda () - (catch #t - (lambda () - (with-database db - (while #t - (process-specs db (db-get-specifications db)) - (log-message "sleeping for ~a seconds" interval) - (sleep interval)))) - (lambda (key . args) - ;; If something goes wrong in this fiber, we have - ;; a problem, so stop everything. - (log-message "uncaught exception in main fiber!") - - (false-if-exception - (let ((stack (make-stack #t))) - (display-backtrace stack (current-error-port)) - (print-exception (current-error-port) - (stack-ref stack 0) - key args))) - (put-message exit-channel 1))))) + (essential-task + 'build exit-channel + (lambda () + (with-database db + (while #t + (process-specs db (db-get-specifications db)) + (log-message "next evaluation in ~a seconds" interval) + (sleep interval)))))) (spawn-fiber - (lambda () - (with-database db - (run-cuirass-server db - #:host host - #:port port)))) + (essential-task + 'web-server exit-channel + (lambda () + (with-database db + (run-cuirass-server db #:host host #:port port))))) (primitive-exit (get-message exit-channel)))))) |