04/05: avahi: Resolve hosts for which name resolution fails.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit 248cf06149b4f09bfca4a21710bc8e1bd47f6e61
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Thu Jun 15 22:50:18 2023 +0200

    avahi: Resolve hosts for which name resolution fails.
    
    This avoids attempts to connect to hosts that went off-line.  This is
    particularly important for 'guix-daemon --discover', which would so far
    keep attempting to talk to LAN hosts after they vanished just because
    their mDNS record hasn't expired, leading to significant delays when
    fetching narinfos and substitutes.
    
    * guix/avahi.scm (avahi-browse-service-thread)[service-resolver-callback]:
    Add handler to RESOLVER-EVENT/FAILURE.
---
 guix/avahi.scm | 10 +++++++++-
 1 file changed, 9 insertions(+), 1 deletion(-)

diff --git a/guix/avahi.scm b/guix/avahi.scm
index 132e42f268..cb0c85f9f4 100644
--- a/guix/avahi.scm
+++ b/guix/avahi.scm
@@ -137,7 +137,15 @@ when STOP-LOOP? procedure returns true."
                                (port port)
                                (txt txt))))
                (hash-set! %known-hosts service-name service*)
-               (proc 'new-service service*)))))
+               (proc 'new-service service*))))
+          ((eq? event resolver-event/failure)
+           ;; Failure to resolve the host associated with a service.  This
+           ;; usually means that the mDNS record hasn't expired yet but that
+           ;; the host went off-line.
+           (let ((service (hash-ref %known-hosts service-name)))
+             (when service
+               (proc 'remove-service service)
+               (hash-remove! %known-hosts service-name)))))
     (free-service-resolver! resolver))
 
   (define (service-browser-callback browser interface protocol event