diff options
author | Christopher Baines <mail@cbaines.net> | 2020-06-19 10:26:08 +0100 |
---|---|---|
committer | Christopher Baines <mail@cbaines.net> | 2020-06-19 10:26:14 +0100 |
commit | 54008b34f7dfa1a1d15c6505fa996263a39f2285 (patch) | |
tree | 6cf7792a2c6cdc9091d32b3b7df33fc3f4b025c7 /guix-build-coordinator | |
parent | dd6b1741693d54bea49901c5e541433a3d958d9d (diff) | |
download | build-coordinator-54008b34f7dfa1a1d15c6505fa996263a39f2285.tar build-coordinator-54008b34f7dfa1a1d15c6505fa996263a39f2285.tar.gz |
Add with-timeout to utils
Diffstat (limited to 'guix-build-coordinator')
-rw-r--r-- | guix-build-coordinator/utils.scm | 37 |
1 files changed, 36 insertions, 1 deletions
diff --git a/guix-build-coordinator/utils.scm b/guix-build-coordinator/utils.scm index e72cf94..5c0fffd 100644 --- a/guix-build-coordinator/utils.scm +++ b/guix-build-coordinator/utils.scm @@ -54,7 +54,9 @@ with-time-logging - create-work-queue)) + create-work-queue + + with-timeout)) (define %worker-thread-args @@ -593,3 +595,36 @@ References: ~a~%" (iota thread-count)) (values process-job count-jobs))) + +;; copied from (guix scripts substitute) +(define-syntax-rule (with-timeout duration handler body ...) + "Run BODY; when DURATION seconds have expired, call HANDLER, and run BODY +again." + (begin + (sigaction SIGALRM + (lambda (signum) + (sigaction SIGALRM SIG_DFL) + handler)) + (alarm duration) + (call-with-values + (lambda () + (let try () + (catch 'system-error + (lambda () + body ...) + (lambda args + ;; Before Guile v2.0.9-39-gfe51c7b, the SIGALRM triggers EINTR + ;; because of the bug at + ;; <http://lists.gnu.org/archive/html/guile-devel/2013-06/msg00050.html>. + ;; When that happens, try again. Note: SA_RESTART cannot be + ;; used because of <http://bugs.gnu.org/14640>. + (if (= EINTR (system-error-errno args)) + (begin + ;; Wait a little to avoid bursts. + (usleep (random 3000000 %random-state)) + (try)) + (apply throw args)))))) + (lambda result + (alarm 0) + (sigaction SIGALRM SIG_DFL) + (apply values result))))) |