summary refs log tree commit diff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2014-03-08 12:07:57 +0100
committerLudovic Courtès <ludo@gnu.org>2014-03-08 12:07:57 +0100
commit4bf1eb4f88f2d2b0596fe8a4b98490fc277f323b (patch)
tree1a4152102d8265e8d00095c3779e5cedf4b9d1b3
parent178f5828ebcb5a5c7019b5463e4ecee5df48870b (diff)
downloadguix-4bf1eb4f88f2d2b0596fe8a4b98490fc277f323b.tar.gz
offload: Further generalize lock files.
* guix/scripts/offload.scm (lock-machine, unlock-machine): Remove.
  (lock-file, unlock-file): New procedures.
  (with-file-lock): New macro.
  (with-machine-lock): Rewrite in terms of 'with-file-lock'.
-rw-r--r--guix/scripts/offload.scm34
1 files changed, 19 insertions, 15 deletions
diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm
index 9b2ea72dc3..fb5d178109 100644
--- a/guix/scripts/offload.scm
+++ b/guix/scripts/offload.scm
@@ -309,32 +309,35 @@ allowed on MACHINE."
                  (build-machine-name machine)
                  "." (symbol->string hint) ".lock"))
 
-(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 lock)
+(define (lock-file file)
+  "Wait and acquire an exclusive lock on FILE.  Return an open port."
+  (mkdir-p (dirname file))
+  (let ((port (open-file file "w0")))
+    (fcntl-flock port 'write-lock)
+    port))
+
+(define (unlock-file lock)
   "Unlock LOCK."
   (fcntl-flock lock 'unlock)
   (close-port lock)
   #t)
 
-(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 hint)))
+(define-syntax-rule (with-file-lock file exp ...)
+  "Wait to acquire a lock on FILE and evaluate EXP in that context."
+  (let ((port (lock-file file)))
     (dynamic-wind
       (lambda ()
         #t)
       (lambda ()
         exp ...)
       (lambda ()
-        (unlock-machine lock)))))
+        (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 (choose-build-machine requirements machines)
   "Return the best machine among MACHINES fulfilling REQUIREMENTS, or #f."
@@ -461,6 +464,7 @@ This tool is meant to be used internally by 'guix-daemon'.\n"))
 
 ;;; Local Variables:
 ;;; eval: (put 'with-machine-lock 'scheme-indent-function 2)
+;;; eval: (put 'with-file-lock 'scheme-indent-function 1)
 ;;; End:
 
 ;;; offload.scm ends here