nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

offload: Honor the build timeout internally. 

* guix/scripts/offload.scm (call-with-timeout): New procedure.
(with-timeout): New macro.
(process-request): Use it around 'transfer-and-offload' call.
This commit is contained in:
Ludovic Courtès 2018-06-11 11:42:59 +02:00
parent 14299d21f2
commit a708de151c
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 38 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
guix/scripts/offload.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
;;;
;;; This file is part of GNU Guix.
@ -494,6 +494,30 @@ slot (which must later be released with 'release-build-slot'), or #f and #f."
(()
(values #f #f))))))
(define (call-with-timeout timeout drv thunk)
"Call THUNK and leave after TIMEOUT seconds. If TIMEOUT is #f, simply call
THUNK. Use DRV as an indication of what we were building when the timeout
expired."
(if (number? timeout)
(dynamic-wind
(lambda ()
(sigaction SIGALRM
(lambda _
;; The exit code here will be 1, which guix-daemon will
;; interpret as a transient failure.
(leave (G_ "timeout expired while offloading '~a'~%")
(derivation-file-name drv))))
(alarm timeout))
thunk
(lambda ()
(alarm 0)))
(thunk)))
(define-syntax-rule (with-timeout timeout drv exp ...)
"Evaluate EXP... and leave after TIMEOUT seconds if EXP hasn't completed.
If TIMEOUT is #f, simply evaluate EXP..."
(call-with-timeout timeout drv (lambda () exp ...)))
(define* (process-request wants-local? system drv features
#:key
print-build-trace? (max-silent-time 3600)
@ -520,13 +544,18 @@ slot (which must later be released with 'release-build-slot'), or #f and #f."
(display "# accept\n")
(let ((inputs (string-tokenize (read-line)))
(outputs (string-tokenize (read-line))))
(transfer-and-offload drv machine
#:inputs inputs
#:outputs outputs
#:max-silent-time max-silent-time
#:build-timeout build-timeout
#:print-build-trace?
print-build-trace?)))
;; Even if BUILD-TIMEOUT is honored by MACHINE, there can
;; be issues with the connection or deadlocks that could
;; lead the 'guix offload' process to remain stuck forever.
;; To avoid that, install a timeout here as well.
(with-timeout build-timeout drv
(transfer-and-offload drv machine
#:inputs inputs
#:outputs outputs
#:max-silent-time max-silent-time
#:build-timeout build-timeout
#:print-build-trace?
print-build-trace?))))
(lambda ()
(release-build-slot slot)))
@ -755,6 +784,7 @@ This tool is meant to be used internally by 'guix-daemon'.\n"))
;;; eval: (put 'with-machine-lock 'scheme-indent-function 2)
;;; eval: (put 'with-file-lock 'scheme-indent-function 1)
;;; eval: (put 'with-error-to-port 'scheme-indent-function 1)
;;; eval: (put 'with-timeout 'scheme-indent-function 2)
;;; End:
;;; offload.scm ends here