~ruther/guix-local

4bf1eb4f88f2d2b0596fe8a4b98490fc277f323b — Ludovic Courtès 12 years ago 178f582
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'.
1 files changed, 19 insertions(+), 15 deletions(-)

M guix/scripts/offload.scm
M guix/scripts/offload.scm => guix/scripts/offload.scm +19 -15
@@ 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