summaryrefslogtreecommitdiff
path: root/guix/scripts
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2014-03-08 11:29:52 +0100
committerLudovic Courtès <ludo@gnu.org>2014-03-08 11:29:52 +0100
commit178f5828ebcb5a5c7019b5463e4ecee5df48870b (patch)
tree95e4c1ec638af9a120f92342abc3e31f0b8c9f0a /guix/scripts
parentc7445833eb43ec621fb5a56f6bfbbf0a02a675c2 (diff)
offload: Generalize the machine lock mechanism.
* guix/scripts/offload.scm (lock-machine): Add 'hint' parameter. (unlock-machine): Remove 'machine' parameter. (with-machine-lock): Add 'hint' parameter, and pass it down. (process-request): Adjust uses of 'with-machine-lock' to pass the 'bandwidth hint.
Diffstat (limited to 'guix/scripts')
-rw-r--r--guix/scripts/offload.scm31
1 files changed, 16 insertions, 15 deletions
diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm
index 2c9ecafcb9..9b2ea72dc3 100644
--- a/guix/scripts/offload.scm
+++ b/guix/scripts/offload.scm
@@ -303,37 +303,38 @@ allowed on MACHINE."
(or (machine-less-loaded? m1 m2)
(machine-faster? m1 m2)))
-(define (machine-lock-file machine)
- "Return the name of MACHINE's lock file."
+(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) ".lock"))
+ (build-machine-name machine)
+ "." (symbol->string hint) ".lock"))
-(define (lock-machine machine)
- "Wait to acquire MACHINE's lock, and return the lock."
- (let ((file (machine-lock-file machine)))
+(define (lock-machine machine hint)
+ "Wait to acquire MACHINE's lock for HINT, and return the lock."
+ (let ((file (machine-lock-file machine hint)))
(mkdir-p (dirname file))
(let ((port (open-file file "w0")))
(fcntl-flock port 'write-lock)
port)))
-(define (unlock-machine machine lock)
- "Unlock LOCK, MACHINE's lock."
+(define (unlock-machine lock)
+ "Unlock LOCK."
(fcntl-flock lock 'unlock)
(close-port lock)
#t)
-(define-syntax-rule (with-machine-lock machine exp ...)
- "Wait to acquire MACHINE's exclusive lock, and evaluate EXP in that
+(define-syntax-rule (with-machine-lock machine hint exp ...)
+ "Wait to acquire MACHINE's exclusive lock for HINT, and evaluate EXP in that
context."
(let* ((m machine)
- (lock (lock-machine m)))
+ (lock (lock-machine m hint)))
(dynamic-wind
(lambda ()
#t)
(lambda ()
exp ...)
(lambda ()
- (unlock-machine m lock)))))
+ (unlock-machine lock)))))
(define (choose-build-machine requirements machines)
"Return the best machine among MACHINES fulfilling REQUIREMENTS, or #f."
@@ -365,7 +366,7 @@ context."
;; Acquire MACHINE's exclusive lock to serialize file transfers
;; to/from MACHINE in the presence of several 'offload' hook
;; instance.
- (when (with-machine-lock machine
+ (when (with-machine-lock machine 'bandwidth
(send-files (cons (derivation-file-name drv) inputs)
machine))
(let ((status (offload drv machine
@@ -375,7 +376,7 @@ context."
(if (zero? status)
(begin
;; Likewise (see above.)
- (with-machine-lock machine
+ (with-machine-lock machine 'bandwidth
(retrieve-files outputs machine))
(format (current-error-port)
"done with offloaded '~a'~%"
@@ -459,7 +460,7 @@ This tool is meant to be used internally by 'guix-daemon'.\n"))
(leave (_ "invalid arguments: ~{~s ~}~%") x))))
;;; Local Variables:
-;;; eval: (put 'with-machine-lock 'scheme-indent-function 1)
+;;; eval: (put 'with-machine-lock 'scheme-indent-function 2)
;;; End:
;;; offload.scm ends here