nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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'.
This commit is contained in:
Ludovic Courtès 2014-03-08 12:07:57 +01:00
parent 178f5828eb
commit 4bf1eb4f88
1 changed files with 18 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
guix/scripts/offload.scm
View File

@ -309,32 +309,35 @@ allowed on MACHINE."
(build-machine-name machine) (build-machine-name machine)
"." (symbol->string hint) ".lock")) "." (symbol->string hint) ".lock"))
(define (lock-machine machine hint) (define (lock-file file)
"Wait to acquire MACHINE's lock for HINT, and return the lock." "Wait and acquire an exclusive lock on FILE. Return an open port."
(let ((file (machine-lock-file machine hint))) (mkdir-p (dirname file))
(mkdir-p (dirname file)) (let ((port (open-file file "w0")))
(let ((port (open-file file "w0"))) (fcntl-flock port 'write-lock)
(fcntl-flock port 'write-lock) port))
port)))
(define (unlock-machine lock) (define (unlock-file lock)
"Unlock LOCK." "Unlock LOCK."
(fcntl-flock lock 'unlock) (fcntl-flock lock 'unlock)
(close-port lock) (close-port lock)
#t) #t)
(define-syntax-rule (with-machine-lock machine hint exp ...) (define-syntax-rule (with-file-lock file exp ...)
"Wait to acquire MACHINE's exclusive lock for HINT, and evaluate EXP in that "Wait to acquire a lock on FILE and evaluate EXP in that context."
context." (let ((port (lock-file file)))
(let* ((m machine)
(lock (lock-machine m hint)))
(dynamic-wind (dynamic-wind
(lambda () (lambda ()
#t) #t)
(lambda () (lambda ()
exp ...) exp ...)
(lambda () (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) (define (choose-build-machine requirements machines)
"Return the best machine among MACHINES fulfilling REQUIREMENTS, or #f." "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: ;;; Local Variables:
;;; eval: (put 'with-machine-lock 'scheme-indent-function 2) ;;; eval: (put 'with-machine-lock 'scheme-indent-function 2)
;;; eval: (put 'with-file-lock 'scheme-indent-function 1)
;;; End: ;;; End:
;;; offload.scm ends here ;;; offload.scm ends here