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:
Ludovic Courtès 2018-12-26 17:42:02 +01:00
parent 7f4d102c2f
commit 0ef595b996
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5

View File

@ -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)