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

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."
(string-append %state-directory "/offload/machine-choice.lock"))
(define %slots
;; List of acquired build slots (open ports).
'())
(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:
;; 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.
(for-each release-build-slot slots)
;; Prevent SLOT from being GC'd.
(set! %slots (cons slot %slots))
best))
;; The caller must keep SLOT to protect it from GC and to
;; eventually release it.
(values best slot)))
(begin
;; BEST is overloaded, so try the next one.
(release-build-slot slot)
(loop others))))
(() #f)))))
(()
(values #f #f))))))
(define* (process-request wants-local? system drv features
#:key
@ -506,19 +503,25 @@ allowed on MACHINE. Return +∞ if MACHINE is unreachable."
;; We'll never be able to match REQS.
(display "# decline\n"))
((x ...)
(let ((machine (choose-build-machine candidates)))
(let-values (((machine slot)
(choose-build-machine candidates)))
(if machine
(begin
;; Offload DRV to MACHINE.
(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?)))
(dynamic-wind
(const #f)
(lambda ()
;; Offload DRV to MACHINE.
(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?)))
(lambda ()
(release-build-slot slot)))
;; Not now, all the machines are busy.
(display "# postpone\n")))))))