diff options
author | Ludovic Courtès <ludo@gnu.org> | 2014-03-08 12:07:57 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2014-03-08 12:07:57 +0100 |
commit | 4bf1eb4f88f2d2b0596fe8a4b98490fc277f323b (patch) | |
tree | 1a4152102d8265e8d00095c3779e5cedf4b9d1b3 /guix | |
parent | 178f5828ebcb5a5c7019b5463e4ecee5df48870b (diff) |
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'.
Diffstat (limited to 'guix')
-rw-r--r-- | guix/scripts/offload.scm | 34 |
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 |