diff options
author | Ricardo Wurmus <rekado@elephly.net> | 2019-08-10 13:46:55 +0200 |
---|---|---|
committer | Ricardo Wurmus <rekado@elephly.net> | 2019-08-10 13:46:55 +0200 |
commit | e11f17226522f6b7c347f8001a50a734d6c5df76 (patch) | |
tree | 708a27aea85add2aae9a978f6272612fc1c1e167 /bin | |
parent | 1aeea2f97f36ffe3274f8684ba3ae0c932f1f8ff (diff) | |
download | cuirass-e11f17226522f6b7c347f8001a50a734d6c5df76.tar cuirass-e11f17226522f6b7c347f8001a50a734d6c5df76.tar.gz |
Separate web interface.
* bin/cuirass.in (show-help): Document "--web" option.
(%options): Default to running without web interface.
(main): Either run the web interface or build packages.
* README: Mention the "--web" option.
Diffstat (limited to 'bin')
-rw-r--r-- | bin/cuirass.in | 107 |
1 files changed, 55 insertions, 52 deletions
diff --git a/bin/cuirass.in b/bin/cuirass.in index b09ca27..29db4e8 100644 --- a/bin/cuirass.in +++ b/bin/cuirass.in @@ -49,6 +49,7 @@ exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" "$@" Add specifications from SPECFILE to database. -D --database=DB Use DB to store build results. --ttl=DURATION Keep build results live for at least DURATION. + --web Start the web interface -p --port=NUM Port of the HTTP server. --listen=HOST Listen on the network interface for HOST -I, --interval=N Wait N seconds between each poll @@ -61,6 +62,7 @@ exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" "$@" (define %options '((one-shot (value #f)) + (web (value #f)) (cache-directory (value #t)) (specifications (single-char #\S) (value #t)) (database (single-char #\D) (value #t)) @@ -123,58 +125,59 @@ exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" "$@" (run-fibers (lambda () (with-database - (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 spec)) - new-specs))) - (if one-shot? - (process-specs (db-get-specifications)) - (let ((exit-channel (make-channel))) - - (clear-build-queue) - - ;; If Cuirass was stopped during an evaluation, consider - ;; it done. Builds that were not registered during this - ;; evaluation will be registered during the next - ;; evaluation. - (db-set-evaluations-done) - - ;; First off, restart builds that had not completed or - ;; were not even started on a previous run. - (spawn-fiber - (essential-task - 'restart-builds exit-channel - (lambda () - (restart-builds)))) - - (spawn-fiber - (essential-task - 'build exit-channel - (lambda () - (while #t - (process-specs (db-get-specifications)) - (log-message "next evaluation in ~a seconds" interval) - (sleep interval))))) - - (spawn-fiber - (essential-task - 'web-server exit-channel - (lambda () - (run-cuirass-server #:host host #:port port))) - #:parallel? #t) - - (spawn-fiber - (essential-task - 'monitor exit-channel - (lambda () - (while #t - (log-monitoring-stats) - (sleep 600))))) - - (primitive-exit (get-message exit-channel)))))) + (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 spec)) + new-specs))) + (if one-shot? + (process-specs (db-get-specifications)) + (let ((exit-channel (make-channel))) + + (if (option-ref opts 'web #f) + (spawn-fiber + (essential-task + 'web exit-channel + (lambda () + (run-cuirass-server #:host host #:port port))) + #:parallel? #t) + (begin + + (clear-build-queue) + + ;; If Cuirass was stopped during an evaluation, consider + ;; it done. Builds that were not registered during this + ;; evaluation will be registered during the next + ;; evaluation. + (db-set-evaluations-done) + + ;; First off, restart builds that had not completed or + ;; were not even started on a previous run. + (spawn-fiber + (essential-task + 'restart-builds exit-channel + (lambda () + (restart-builds)))) + + (spawn-fiber + (essential-task + 'build exit-channel + (lambda () + (while #t + (process-specs (db-get-specifications)) + (log-message "next evaluation in ~a seconds" interval) + (sleep interval))))) + + (spawn-fiber + (essential-task + 'monitor exit-channel + (lambda () + (while #t + (log-monitoring-stats) + (sleep 600))))))) + (primitive-exit (get-message exit-channel)))))) ;; Most of our code is I/O so preemption doesn't matter much (it ;; could help while we're doing SQL requests, for instance, but it |