164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
|
(hash-table-ref/default cfgdat section '()))
;; 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))
(let ((fmod-time (handle-exceptions
ext
(current-seconds)
(file-modification-time fname))))
(if (file-exists? fname) ;; (common:file-exists? fname)
|
>
>
>
|
|
|
|
|
>
|
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
|
(hash-table-ref/default cfgdat section '()))
;; 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))
(let* ((lock-exists (file-exists? fname))
(fmod-time (if lock-exists
(current-seconds)
(handle-exceptions
ext
(current-seconds)
(file-modification-time fname)))))
(if lock-exists
(if (> (- (current-seconds) fmod-time) expire-time)
(begin
(debug:print-info 1 *default-log-port* "Removing stale lock "fname)
(handle-exceptions exn #f (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)))
|