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

offload: Fix potential file descriptor and memory leak. 

The '%slots' list could grow indefinitely; in practice though,
guix-daemon is likely to restart 'guix offload' often enough.

* guix/scripts/offload.scm (%slots): Remove.
(choose-build-machine): Don't 'set!' %SLOTS.  Return the acquired slot
as a second value.
(process-request): Adjust accordingly.  Release the returned slot after
'transfer-and-offload'.
This commit is contained in:
Ludovic Courtès 2017-07-25 21:55:20 +02:00
parent 236cae0628
commit 84620dd0c4
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 25 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
guix/scripts/offload.scm
View File

@ -428,13 +428,9 @@ allowed on MACHINE. Return +∞ if MACHINE is unreachable."
"Return the name of the file used as a lock when choosing a build machine." "Return the name of the file used as a lock when choosing a build machine."
(string-append %state-directory "/offload/machine-choice.lock")) (string-append %state-directory "/offload/machine-choice.lock"))
(define %slots
;; List of acquired build slots (open ports).
'())
(define (choose-build-machine machines) (define (choose-build-machine machines)
"Return the best machine among MACHINES, or #f." "Return two values: the best machine among MACHINES and its build
slot (which must later be released with 'release-build-slot'), or #f and #f."
;; Proceed like this: ;; Proceed like this:
;; 1. Acquire the global machine-choice lock. ;; 1. Acquire the global machine-choice lock.
@ -481,14 +477,15 @@ allowed on MACHINE. Return +∞ if MACHINE is unreachable."
;; Release slots from the uninteresting machines. ;; Release slots from the uninteresting machines.
(for-each release-build-slot slots) (for-each release-build-slot slots)
;; Prevent SLOT from being GC'd. ;; The caller must keep SLOT to protect it from GC and to
(set! %slots (cons slot %slots)) ;; eventually release it.
best)) (values best slot)))
(begin (begin
;; BEST is overloaded, so try the next one. ;; BEST is overloaded, so try the next one.
(release-build-slot slot) (release-build-slot slot)
(loop others)))) (loop others))))
(() #f))))) (()
(values #f #f))))))
(define* (process-request wants-local? system drv features (define* (process-request wants-local? system drv features
#:key #:key
@ -506,19 +503,25 @@ allowed on MACHINE. Return +∞ if MACHINE is unreachable."
;; We'll never be able to match REQS. ;; We'll never be able to match REQS.
(display "# decline\n")) (display "# decline\n"))
((x ...) ((x ...)
(let ((machine (choose-build-machine candidates))) (let-values (((machine slot)
(choose-build-machine candidates)))
(if machine (if machine
(begin (dynamic-wind
;; Offload DRV to MACHINE. (const #f)
(display "# accept\n") (lambda ()
(let ((inputs (string-tokenize (read-line))) ;; Offload DRV to MACHINE.
(outputs (string-tokenize (read-line)))) (display "# accept\n")
(transfer-and-offload drv machine (let ((inputs (string-tokenize (read-line)))
#:inputs inputs (outputs (string-tokenize (read-line))))
#:outputs outputs (transfer-and-offload drv machine
#:max-silent-time max-silent-time #:inputs inputs
#:build-timeout build-timeout #:outputs outputs
#:print-build-trace? print-build-trace?))) #:max-silent-time max-silent-time
#:build-timeout build-timeout
#:print-build-trace?
print-build-trace?)))
(lambda ()
(release-build-slot slot)))
;; Not now, all the machines are busy. ;; Not now, all the machines are busy.
(display "# postpone\n"))))))) (display "# postpone\n")))))))