diff options
Diffstat (limited to 'guix/scripts')
-rw-r--r-- | guix/scripts/offload.scm | 31 |
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 |