scripts: discover: Remove file locks.

* guix/scripts/discover.scm (call-with-read-file-lock, with-read-file-lock):
Remove them.
(write-publish-file): Use "with-atomic-file-output" instead of
"with-file-lock".
(read-substitute-urls): Remove file lock.
This commit is contained in:
Mathieu Othacehe 2020-12-07 14:12:06 +01:00
parent 90db72d225
commit 1f49ab6ee2
No known key found for this signature in database
GPG key ID: 8354763531769CA6

View file

@ -21,6 +21,7 @@ (define-module (guix scripts discover)
#:use-module (guix config)
#:use-module (guix scripts)
#:use-module (guix ui)
#:use-module (guix utils)
#:use-module (guix build syscalls)
#:use-module (guix build utils)
#:use-module (guix scripts publish)
@ -78,8 +79,7 @@ (define %publish-file
(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
(with-atomic-file-output file
(lambda (port)
(hash-for-each
(lambda (name service)
@ -87,38 +87,19 @@ (define* (write-publish-file #:key (file (%publish-file)))
(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 ...)))
(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)))))))
(loop (read-line port) (cons url urls))))))
'()))
@ -158,7 +139,3 @@ (define-command (guix-discover . args)
(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: