summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRicardo Wurmus <rekado@elephly.net>2019-08-10 13:46:55 +0200
committerRicardo Wurmus <rekado@elephly.net>2019-08-10 13:46:55 +0200
commite11f17226522f6b7c347f8001a50a734d6c5df76 (patch)
tree708a27aea85add2aae9a978f6272612fc1c1e167
parent1aeea2f97f36ffe3274f8684ba3ae0c932f1f8ff (diff)
downloadcuirass-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.
-rw-r--r--README4
-rw-r--r--bin/cuirass.in107
2 files changed, 59 insertions, 52 deletions
diff --git a/README b/README
index e2540cd..98824cf 100644
--- a/README
+++ b/README
@@ -56,6 +56,10 @@ without the '--specifications' option:
./pre-inst-env cuirass --database=test.db
+To start the web interface run:
+
+ ./pre-inst-env cuirass --web
+
Contributing
============
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