diff options
Diffstat (limited to 'guix-build-coordinator/utils.scm')
| -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))))) |