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:
parent
236cae0628
commit
84620dd0c4
@ -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")))))))
|
||||
|
Loading…
Reference in New Issue
Block a user