guix
/
guix-cuirass
mirror of git://git.savannah.gnu.org/guix/guix-cuirass.git
2
0
Fork 0
Code Issues Releases Wiki Activity

cuirass: Catch exceptions in the main fiber and stop everything. 

* bin/cuirass.in (main): Add 'exit-channel' and read from it.
Catch exceptions in the main fiber and write to that channel upon
error.
This commit is contained in:
Ludovic Courtès 2018-01-26 14:27:46 +01:00
parent 5d559f8021
commit dd8b6f66e4
1 changed files with 30 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
bin/cuirass.in
View File

@ -29,6 +29,7 @@ exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" "$@"
(cuirass logging)
(guix ui)
(fibers)
(fibers channels)
(ice-9 getopt-long))
(define (show-help)
@ -107,7 +108,8 @@ exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" "$@"
new-specs)))
(if one-shot?
(process-specs db (db-get-specifications db))
(let ((pending
(let ((exit-channel (make-channel))
(pending
(begin
(log-message "retrieving list of pending builds...")
(db-get-builds db '((status pending))))))
@ -121,16 +123,33 @@ exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" "$@"
(spawn-fiber
(lambda ()
(with-database db
(while #t
(process-specs db (db-get-specifications db))
(log-message "sleeping for ~a seconds" interval)
(sleep interval)))))
(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!")
(with-database db
(run-cuirass-server db
#:host host
#:port port))
*unspecified*))))
(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)))))
(spawn-fiber
(lambda ()
(with-database db
(run-cuirass-server db
#:host host
#:port port))))
(primitive-exit (get-message exit-channel))))))
#:drain? #t)))))))