Overview
| Comment: | Added exception handler around file open for lock files to fix the server-start.lock |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | v1.65 |
| Files: | files | file ages | folders |
| SHA1: |
ec5345e6ecc7783dee188df0d4eae343 |
| User & Date: | jmoon18 on 2019-08-23 12:52:15 |
| Other Links: | branch diff | manifest | tags |
Context
|
2019-08-23
| ||
| 14:15 | Updated version to 1.65/34 check-in: ffaeb9b692 user: jmoon18 tags: v1.65, v1.6534 | |
| 12:52 | Added exception handler around file open for lock files to fix the server-start.lock check-in: ec5345e6ec user: jmoon18 tags: v1.65 | |
| 12:49 | Changed kill-rerun and a few other options to use get-target so they will support reqtarg option check-in: 731033a46a user: jmoon18 tags: v1.65 | |
Changes
Modified common.scm from [5d7bb2a291] to [98185b83db].
| ︙ | ︙ | |||
641 642 643 644 645 646 647 | (read (open-input-string (z3:decode-buffer (base64:base64-decode instr)))))) ;; dot-locking egg seems not to work, using this for now ;; if lock is older than expire-time then remove it and try again ;; to get the lock ;; (define (common:simple-file-lock fname #!key (expire-time 300)) | < < < > > | | | | < < | 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 |
(read (open-input-string (z3:decode-buffer (base64:base64-decode instr))))))
;; dot-locking egg seems not to work, using this for now
;; if lock is older than expire-time then remove it and try again
;; to get the lock
;;
(define (common:simple-file-lock fname #!key (expire-time 300))
(if (common:file-exists? fname)
(if (> (- (current-seconds)(file-modification-time fname)) expire-time)
(begin
(delete-file* fname)
(common:simple-file-lock fname expire-time: expire-time))
#f)
(let ((key-string (conc (get-host-name) "-" (current-process-id))))
(with-output-to-file fname
(lambda ()
(print key-string)))
(thread-sleep! 0.25)
(if (common:file-exists? fname)
(handle-exceptions exn
#f
(with-input-from-file fname
(lambda ()
(equal? key-string (read-line)))))
#f))))
(define (common:simple-file-lock-and-wait fname #!key (expire-time 300))
(let ((end-time (+ expire-time (current-seconds))))
(let loop ((got-lock (common:simple-file-lock fname expire-time: expire-time)))
(if got-lock
#t
(if (> end-time (current-seconds))
|
| ︙ | ︙ |