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.

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