@@ -75,50 +75,60 @@ CACHE-DIRECTORY."
(define %publish-file
(make-parameter (publish-file %state-directory)))
+;; XXX: Copied from (system base compile).
+(define (call-once thunk)
+ (let ((entered #f))
+ (dynamic-wind
+ (lambda ()
+ (when entered
+ (error "thunk may only be entered once: ~a" thunk))
+ (set! entered #t))
+ thunk
+ (lambda () #t))))
+
+(define* (call-with-output-file/atomic filename proc #:optional reference)
+ (let* ((template (string-append filename ".XXXXXX"))
+ (tmp (mkstemp! template "wb")))
+ (call-once
+ (lambda ()
+ (with-throw-handler #t
+ (lambda ()
+ (proc tmp)
+ ;; Chmodding by name instead of by port allows this chmod to
+ ;; work on systems without fchmod, like MinGW.
+ (let ((perms (or (false-if-exception (stat:perms (stat reference)))
+ (lognot (umask)))))
+ (chmod template (logand #o0666 perms)))
+ (close-port tmp)
+ (rename-file template filename))
+ (lambda args
+ (close-port tmp)
+ (delete-file template)))))))
+
(define* (write-publish-file #:key (file (%publish-file)))
"Dump the content of %PUBLISH-SERVICES hash table into FILE. Use a write
lock on FILE to synchronize with any potential readers."
- (with-file-lock file
- (call-with-output-file file
- (lambda (port)
- (hash-for-each
- (lambda (name service)
- (format port "http://~a:~a~%"
- (avahi-service-address service)
- (avahi-service-port service)))
- %publish-services)))
- (chmod file #o644)))
-
-(define (call-with-read-file-lock file thunk)
- "Call THUNK with a read lock on FILE."
- (let ((port #f))
- (dynamic-wind
- (lambda ()
- (set! port
- (let ((port (open-file file "r0")))
- (fcntl-flock port 'read-lock)
- port)))
- thunk
- (lambda ()
- (when port
- (unlock-file port))))))
-
-(define-syntax-rule (with-read-file-lock file exp ...)
- "Wait to acquire a read lock on FILE and evaluate EXP in that context."
- (call-with-read-file-lock file (lambda () exp ...)))
+ (call-with-output-file/atomic file
+ (lambda (port)
+ (hash-for-each
+ (lambda (name service)
+ (format port "http://~a:~a~%"
+ (avahi-service-address service)
+ (avahi-service-port service)))
+ %publish-services)))
+ (chmod file #o644))
(define* (read-substitute-urls #:key (file (%publish-file)))
"Read substitute urls list from FILE and return it. Use a read lock on FILE
to synchronize with the writer."
(if (file-exists? file)
- (with-read-file-lock file
- (call-with-input-file file
- (lambda (port)
- (let loop ((url (read-line port))
- (urls '()))
- (if (eof-object? url)
- urls
- (loop (read-line port) (cons url urls)))))))
+ (call-with-input-file file
+ (lambda (port)
+ (let loop ((url (read-line port))
+ (urls '()))
+ (if (eof-object? url)
+ urls
+ (loop (read-line port) (cons url urls))))))
'()))
@@ -158,7 +168,3 @@ to synchronize with the writer."
(mkdir-p (dirname publish-file))
(avahi-browse-service-thread service-proc
#:types %services)))))
-
-;;; Local Variables:
-;;; eval: (put 'with-read-file-lock 'scheme-indent-function 1)
-;;; End: