offload: Move macro definitions before use.
* guix/scripts/offload.scm (lock-file, unlock-file, with-file-lock, with-machine-lock, machine-slot-file, acquire-build-slot, release-build-slot): Move definitions above their first use.
This commit is contained in:
Ludovic Courtès
parent
2a51db7d8d
commit
59f704dff6
|
|
@ -174,6 +174,86 @@ determined."
|
||||||
%lshg-command (strerror (system-error-errno args)))
|
%lshg-command (strerror (system-error-errno args)))
|
||||||
#f)))
|
#f)))
|
||||||
|
|
||||||
|
|
||||||
|
;;;
|
||||||
|
;;; Synchronization.
|
||||||
|
;;;
|
||||||
|
|
||||||
|
(define (lock-file file)
|
||||||
|
"Wait and acquire an exclusive lock on FILE. Return an open port."
|
||||||
|
(mkdir-p (dirname file))
|
||||||
|
(let ((port (open-file file "w0")))
|
||||||
|
(fcntl-flock port 'write-lock)
|
||||||
|
port))
|
||||||
|
|
||||||
|
(define (unlock-file lock)
|
||||||
|
"Unlock LOCK."
|
||||||
|
(fcntl-flock lock 'unlock)
|
||||||
|
(close-port lock)
|
||||||
|
#t)
|
||||||
|
|
||||||
|
(define-syntax-rule (with-file-lock file exp ...)
|
||||||
|
"Wait to acquire a lock on FILE and evaluate EXP in that context."
|
||||||
|
(let ((port (lock-file file)))
|
||||||
|
(dynamic-wind
|
||||||
|
(lambda ()
|
||||||
|
#t)
|
||||||
|
(lambda ()
|
||||||
|
exp ...)
|
||||||
|
(lambda ()
|
||||||
|
(unlock-file port)))))
|
||||||
|
|
||||||
|
(define-syntax-rule (with-machine-lock machine hint exp ...)
|
||||||
|
"Wait to acquire MACHINE's exclusive lock for HINT, and evaluate EXP in that
|
||||||
|
context."
|
||||||
|
(with-file-lock (machine-lock-file machine hint)
|
||||||
|
exp ...))
|
||||||
|
|
||||||
|
|
||||||
|
(define (machine-slot-file machine slot)
|
||||||
|
"Return the file name of MACHINE's file for SLOT."
|
||||||
|
;; For each machine we have a bunch of files representing each build slot.
|
||||||
|
;; When choosing a build machine, we attempt to get an exclusive lock on one
|
||||||
|
;; of these; if we fail, that means all the build slots are already taken.
|
||||||
|
;; Inspired by Nix's build-remote.pl.
|
||||||
|
(string-append (string-append %state-directory "/offload/"
|
||||||
|
(build-machine-name machine)
|
||||||
|
"/" (number->string slot))))
|
||||||
|
|
||||||
|
(define (acquire-build-slot machine)
|
||||||
|
"Attempt to acquire a build slot on MACHINE. Return the port representing
|
||||||
|
the slot, or #f if none is available.
|
||||||
|
|
||||||
|
This mechanism allows us to set a hard limit on the number of simultaneous
|
||||||
|
connections allowed to MACHINE."
|
||||||
|
(mkdir-p (dirname (machine-slot-file machine 0)))
|
||||||
|
(with-machine-lock machine 'slots
|
||||||
|
(any (lambda (slot)
|
||||||
|
(let ((port (open-file (machine-slot-file machine slot)
|
||||||
|
"w0")))
|
||||||
|
(catch 'flock-error
|
||||||
|
(lambda ()
|
||||||
|
(fcntl-flock port 'write-lock #:wait? #f)
|
||||||
|
;; Got it!
|
||||||
|
(format (current-error-port)
|
||||||
|
"process ~a acquired build slot '~a'~%"
|
||||||
|
(getpid) (port-filename port))
|
||||||
|
port)
|
||||||
|
(lambda args
|
||||||
|
;; PORT is already locked by another process.
|
||||||
|
(close-port port)
|
||||||
|
#f))))
|
||||||
|
(iota (build-machine-parallel-builds machine)))))
|
||||||
|
|
||||||
|
(define (release-build-slot slot)
|
||||||
|
"Release SLOT, a build slot as returned as by 'acquire-build-slot'."
|
||||||
|
(close-port slot))
|
||||||
|
|
||||||
|
|
||||||
|
;;;
|
||||||
|
;;; Offloading.
|
||||||
|
;;;
|
||||||
|
|
||||||
(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 7200) (log-port (current-output-port)))
|
||||||
|
|
@ -299,6 +379,11 @@ success, #f otherwise."
|
||||||
|
|
||||||
(zero? (close-pipe pipe)))))))
|
(zero? (close-pipe pipe)))))))
|
||||||
|
|
||||||
|
|
||||||
|
;;;
|
||||||
|
;;; Scheduling.
|
||||||
|
;;;
|
||||||
|
|
||||||
(define (machine-matches? machine requirements)
|
(define (machine-matches? machine requirements)
|
||||||
"Return #t if MACHINE matches REQUIREMENTS."
|
"Return #t if MACHINE matches REQUIREMENTS."
|
||||||
(and (string=? (build-requirements-system requirements)
|
(and (string=? (build-requirements-system requirements)
|
||||||
|
|
@ -350,75 +435,6 @@ allowed on MACHINE."
|
||||||
"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 (lock-file file)
|
|
||||||
"Wait and acquire an exclusive lock on FILE. Return an open port."
|
|
||||||
(mkdir-p (dirname file))
|
|
||||||
(let ((port (open-file file "w0")))
|
|
||||||
(fcntl-flock port 'write-lock)
|
|
||||||
port))
|
|
||||||
|
|
||||||
(define (unlock-file lock)
|
|
||||||
"Unlock LOCK."
|
|
||||||
(fcntl-flock lock 'unlock)
|
|
||||||
(close-port lock)
|
|
||||||
#t)
|
|
||||||
|
|
||||||
(define-syntax-rule (with-file-lock file exp ...)
|
|
||||||
"Wait to acquire a lock on FILE and evaluate EXP in that context."
|
|
||||||
(let ((port (lock-file file)))
|
|
||||||
(dynamic-wind
|
|
||||||
(lambda ()
|
|
||||||
#t)
|
|
||||||
(lambda ()
|
|
||||||
exp ...)
|
|
||||||
(lambda ()
|
|
||||||
(unlock-file port)))))
|
|
||||||
|
|
||||||
(define-syntax-rule (with-machine-lock machine hint exp ...)
|
|
||||||
"Wait to acquire MACHINE's exclusive lock for HINT, and evaluate EXP in that
|
|
||||||
context."
|
|
||||||
(with-file-lock (machine-lock-file machine hint)
|
|
||||||
exp ...))
|
|
||||||
|
|
||||||
|
|
||||||
(define (machine-slot-file machine slot)
|
|
||||||
"Return the file name of MACHINE's file for SLOT."
|
|
||||||
;; For each machine we have a bunch of files representing each build slot.
|
|
||||||
;; When choosing a build machine, we attempt to get an exclusive lock on one
|
|
||||||
;; of these; if we fail, that means all the build slots are already taken.
|
|
||||||
;; Inspired by Nix's build-remote.pl.
|
|
||||||
(string-append (string-append %state-directory "/offload/"
|
|
||||||
(build-machine-name machine)
|
|
||||||
"/" (number->string slot))))
|
|
||||||
|
|
||||||
(define (acquire-build-slot machine)
|
|
||||||
"Attempt to acquire a build slot on MACHINE. Return the port representing
|
|
||||||
the slot, or #f if none is available.
|
|
||||||
|
|
||||||
This mechanism allows us to set a hard limit on the number of simultaneous
|
|
||||||
connections allowed to MACHINE."
|
|
||||||
(mkdir-p (dirname (machine-slot-file machine 0)))
|
|
||||||
(with-machine-lock machine 'slots
|
|
||||||
(any (lambda (slot)
|
|
||||||
(let ((port (open-file (machine-slot-file machine slot)
|
|
||||||
"w0")))
|
|
||||||
(catch 'flock-error
|
|
||||||
(lambda ()
|
|
||||||
(fcntl-flock port 'write-lock #:wait? #f)
|
|
||||||
;; Got it!
|
|
||||||
(format (current-error-port)
|
|
||||||
"process ~a acquired build slot '~a'~%"
|
|
||||||
(getpid) (port-filename port))
|
|
||||||
port)
|
|
||||||
(lambda args
|
|
||||||
;; PORT is already locked by another process.
|
|
||||||
(close-port port)
|
|
||||||
#f))))
|
|
||||||
(iota (build-machine-parallel-builds machine)))))
|
|
||||||
|
|
||||||
(define (release-build-slot slot)
|
|
||||||
"Release SLOT, a build slot as returned as by 'acquire-build-slot'."
|
|
||||||
(close-port slot))
|
|
||||||
|
|
||||||
(define %slots
|
(define %slots
|
||||||
;; List of acquired build slots (open ports).
|
;; List of acquired build slots (open ports).
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue