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
673
674
675
|
(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))
; (handle-exceptions
; exn
; #f ;; don't really care what went wrong right now. NOTE: I have not seen this one actually fail.
(with-input-from-file fname
(lambda ()
(equal? key-string (read-line))))
#f)))
; )
)
|
<
<
<
>
>
|
|
|
|
<
<
|
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))
|