futurile/guix-play
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

offload: Honor absolute build timeouts.

Browse Source 
* guix/scripts/offload.scm (offload): Remove default value for
  'build-timeout'.  Pass '--timeout' to the remote 'guix build'
  process.
  (transfer-and-offload, process-request): Remove default value for
  'build-timeout'.
This commit is contained in:
Ludovic Courtès 2014-03-09 23:13:53 +01:00
parent 002622b65b
commit 714084e6c0
1 changed files with 7 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
guix/scripts/offload.scm
View File

@ -256,7 +256,7 @@ connections allowed to MACHINE."
(define* (offload drv machine (define* (offload drv machine
#:key print-build-trace? (max-silent-time 3600) #:key print-build-trace? (max-silent-time 3600)
(build-timeout 7200) (log-port (current-output-port))) build-timeout (log-port (current-output-port)))
"Perform DRV on MACHINE, assuming DRV and its prerequisites are available "Perform DRV on MACHINE, assuming DRV and its prerequisites are available
there, and write the build log to LOG-PORT. Return the exit status." there, and write the build log to LOG-PORT. Return the exit status."
(format (current-error-port) "offloading '~a' to '~a'...~%" (format (current-error-port) "offloading '~a' to '~a'...~%"
@ -267,9 +267,12 @@ there, and write the build log to LOG-PORT. Return the exit status."
;; FIXME: Protect DRV from garbage collection on MACHINE. ;; FIXME: Protect DRV from garbage collection on MACHINE.
(let ((pipe (remote-pipe machine OPEN_READ (let ((pipe (remote-pipe machine OPEN_READ
`("guix" "build" `("guix" "build"
;; FIXME: more options
,(format #f "--max-silent-time=~a" ,(format #f "--max-silent-time=~a"
max-silent-time) max-silent-time)
,@(if build-timeout
(list (format #f "--timeout=~a"
build-timeout))
'())
,(derivation-file-name drv))))) ,(derivation-file-name drv)))))
(let loop ((line (read-line pipe))) (let loop ((line (read-line pipe)))
(unless (eof-object? line) (unless (eof-object? line)
@ -284,7 +287,7 @@ there, and write the build log to LOG-PORT. Return the exit status."
(inputs '()) (inputs '())
(outputs '()) (outputs '())
(max-silent-time 3600) (max-silent-time 3600)
(build-timeout 7200) build-timeout
print-build-trace?) print-build-trace?)
"Offload DRV to MACHINE. Prior to the actual offloading, transfer all of "Offload DRV to MACHINE. Prior to the actual offloading, transfer all of
INPUTS to MACHINE; if building DRV succeeds, retrieve all of OUTPUTS from INPUTS to MACHINE; if building DRV succeeds, retrieve all of OUTPUTS from
@ -485,7 +488,7 @@ allowed on MACHINE."
(define* (process-request wants-local? system drv features (define* (process-request wants-local? system drv features
#:key #:key
print-build-trace? (max-silent-time 3600) print-build-trace? (max-silent-time 3600)
(build-timeout 7200)) build-timeout)
"Process a request to build DRV." "Process a request to build DRV."
(let* ((local? (and wants-local? (string=? system (%current-system)))) (let* ((local? (and wants-local? (string=? system (%current-system))))
(reqs (build-requirements (reqs (build-requirements