From 178f5828ebcb5a5c7019b5463e4ecee5df48870b Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 8 Mar 2014 11:29:52 +0100 Subject: 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. --- guix/scripts/offload.scm | 31 ++++++++++++++++--------------- 1 file changed, 16 insertions(+), 15 deletions(-) (limited to 'guix/scripts/offload.scm') 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 @@ (define (machine-less-loaded-or-faster? m1 m2) (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 @@ (define* (process-request wants-local? system drv features ;; 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 @@ (define* (process-request wants-local? system drv features (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 @@ (define not-coma (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 -- cgit v1.2.3