aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2018-12-26 17:42:02 +0100
committerLudovic Courtès <ludo@gnu.org>2018-12-26 18:40:49 +0100
commit0ef595b99689a4d80521abd87fa893695c7f75df (patch)
treecbc267a1621b728a7f03e21640cb682331aa923f
parent7f4d102c2fff9ff60cd7bc69f5e7eb694274baae (diff)
downloadgnu-guix-0ef595b99689a4d80521abd87fa893695c7f75df.tar
gnu-guix-0ef595b99689a4d80521abd87fa893695c7f75df.tar.gz
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'.
-rw-r--r--guix/scripts/offload.scm50
1 files changed, 19 insertions, 31 deletions
diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm
index f90f9e92fa..30fe69ad6d 100644
--- a/guix/scripts/offload.scm
+++ b/guix/scripts/offload.scm
@@ -260,13 +260,6 @@ instead of '~a' of type '~a'~%")
(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.
@@ -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
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)))))
+
+ ;; When several 'guix offload' processes run in parallel, there's a race
+ ;; among them, but since they try the slots in the same order, we're fine.
+ (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'."
@@ -447,12 +442,6 @@ of free disk space on '~a'~%")
normalized)
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)
(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))))
;;; Local Variables:
-;;; eval: (put 'with-machine-lock 'scheme-indent-function 2)
;;; eval: (put 'with-file-lock 'scheme-indent-function 1)
;;; eval: (put 'with-error-to-port 'scheme-indent-function 1)
;;; eval: (put 'with-timeout 'scheme-indent-function 2)