offload: Remove unnecessary locking on machine slots.
This extra level of locking turned out to be unnecessary. * guix/scripts/offload.scm (with-machine-lock): Remove. (machine-lock-file): Remove. (acquire-build-slot): Remove surrounding 'with-machine-lock'.
This commit is contained in:
parent
7f4d102c2f
commit
0ef595b996
@ -260,13 +260,6 @@ instead of '~a' of type '~a'~%")
|
|||||||
(lambda ()
|
(lambda ()
|
||||||
(unlock-file port)))))
|
(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)
|
(define (machine-slot-file machine slot)
|
||||||
"Return the file name of MACHINE's file for SLOT."
|
"Return the file name of MACHINE's file for SLOT."
|
||||||
;; For each machine we have a bunch of files representing each build slot.
|
;; For each machine we have a bunch of files representing each build slot.
|
||||||
@ -284,23 +277,25 @@ the slot, or #f if none is available.
|
|||||||
This mechanism allows us to set a hard limit on the number of simultaneous
|
This mechanism allows us to set a hard limit on the number of simultaneous
|
||||||
connections allowed to MACHINE."
|
connections allowed to MACHINE."
|
||||||
(mkdir-p (dirname (machine-slot-file machine 0)))
|
(mkdir-p (dirname (machine-slot-file machine 0)))
|
||||||
(with-machine-lock machine 'slots
|
|
||||||
(any (lambda (slot)
|
;; When several 'guix offload' processes run in parallel, there's a race
|
||||||
(let ((port (open-file (machine-slot-file machine slot)
|
;; among them, but since they try the slots in the same order, we're fine.
|
||||||
"w0")))
|
(any (lambda (slot)
|
||||||
(catch 'flock-error
|
(let ((port (open-file (machine-slot-file machine slot)
|
||||||
(lambda ()
|
"w0")))
|
||||||
(fcntl-flock port 'write-lock #:wait? #f)
|
(catch 'flock-error
|
||||||
;; Got it!
|
(lambda ()
|
||||||
(format (current-error-port)
|
(fcntl-flock port 'write-lock #:wait? #f)
|
||||||
"process ~a acquired build slot '~a'~%"
|
;; Got it!
|
||||||
(getpid) (port-filename port))
|
(format (current-error-port)
|
||||||
port)
|
"process ~a acquired build slot '~a'~%"
|
||||||
(lambda args
|
(getpid) (port-filename port))
|
||||||
;; PORT is already locked by another process.
|
port)
|
||||||
(close-port port)
|
(lambda args
|
||||||
#f))))
|
;; PORT is already locked by another process.
|
||||||
(iota (build-machine-parallel-builds machine)))))
|
(close-port port)
|
||||||
|
#f))))
|
||||||
|
(iota (build-machine-parallel-builds machine))))
|
||||||
|
|
||||||
(define (release-build-slot slot)
|
(define (release-build-slot slot)
|
||||||
"Release SLOT, a build slot as returned as by 'acquire-build-slot'."
|
"Release SLOT, a build slot as returned as by 'acquire-build-slot'."
|
||||||
@ -447,12 +442,6 @@ of free disk space on '~a'~%")
|
|||||||
normalized)
|
normalized)
|
||||||
load))
|
load))
|
||||||
|
|
||||||
(define (machine-lock-file machine hint)
|
|
||||||
"Return the name of MACHINE's lock file for HINT."
|
|
||||||
(string-append %state-directory "/offload/"
|
|
||||||
(build-machine-name machine)
|
|
||||||
"." (symbol->string hint) ".lock"))
|
|
||||||
|
|
||||||
(define (random-seed)
|
(define (random-seed)
|
||||||
(logxor (getpid) (car (gettimeofday))))
|
(logxor (getpid) (car (gettimeofday))))
|
||||||
|
|
||||||
@ -827,7 +816,6 @@ This tool is meant to be used internally by 'guix-daemon'.\n"))
|
|||||||
(leave (G_ "invalid arguments: ~{~s ~}~%") x))))
|
(leave (G_ "invalid arguments: ~{~s ~}~%") x))))
|
||||||
|
|
||||||
;;; Local Variables:
|
;;; Local Variables:
|
||||||
;;; eval: (put 'with-machine-lock 'scheme-indent-function 2)
|
|
||||||
;;; eval: (put 'with-file-lock 'scheme-indent-function 1)
|
;;; eval: (put 'with-file-lock 'scheme-indent-function 1)
|
||||||
;;; eval: (put 'with-error-to-port 'scheme-indent-function 1)
|
;;; eval: (put 'with-error-to-port 'scheme-indent-function 1)
|
||||||
;;; eval: (put 'with-timeout 'scheme-indent-function 2)
|
;;; eval: (put 'with-timeout 'scheme-indent-function 2)
|
||||||
|
Loading…
Reference in New Issue
Block a user