[bug#44801] [PATCH 2/2] publish: Add avahi support.

[Mathieu Othacehe]

* guix/scripts/publish.scm (%options): Add "--enable-avahi" option.
(show-help): Document it.
(service-name): New procedure,
(service-type): new variable.
(run-publish-server): Add "avahi?" and "port" parameters. Use them to publish
the server using Avahi.
(guix-publish): Pass the "avahi?" option to "run-publish-server".
---
 doc/guix.texi            |  4 ++++
 guix/scripts/publish.scm | 23 +++++++++++++++++++++++
 2 files changed, 27 insertions(+)

diff --git a/doc/guix.texi b/doc/guix.texi
index e2361c25e3..cfbf495cbc 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -12151,6 +12151,10 @@ The signing key pair must be generated before 
@command{guix publish} is
 launched, using @command{guix archive --generate-key} (@pxref{Invoking
 guix archive}).
 
+When the @option{--enable-avahi} option is passed, the publish server is
+advertised on the local network as an Avahi service, using Guile-Avahi
+bindings.
+
 The general syntax is:
 
 @example
diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm
index a12abf5b4d..34fcb682b5 100644
--- a/guix/scripts/publish.scm
+++ b/guix/scripts/publish.scm
@@ -41,6 +41,7 @@
   #:use-module (web server)
   #:use-module (web uri)
   #:autoload   (sxml simple) (sxml->xml)
+  #:use-module (guix avahi)
   #:use-module (guix base32)
   #:use-module (guix base64)
   #:use-module (guix config)
@@ -82,6 +83,8 @@ Publish ~a over HTTP.\n") %store-directory)
   (display (G_ "
   -u, --user=USER        change privileges to USER as soon as possible"))
   (display (G_ "
+  -a, --enable-avahi     enable Avahi based discovery"))
+  (display (G_ "
   -C, --compression[=METHOD:LEVEL]
                          compress archives with METHOD at LEVEL"))
   (display (G_ "
@@ -156,6 +159,9 @@ usage."
         (option '(#\V "version") #f #f
                 (lambda _
                   (show-version-and-exit "guix publish")))
+        (option '(#\a "enable-avahi") #f #f
+                (lambda (opt name arg result)
+                  (alist-cons 'enable-avahi? #t result)))
         (option '(#\u "user") #t #f
                 (lambda (opt name arg result)
                   (alist-cons 'user arg result)))
@@ -1043,11 +1049,25 @@ methods, return the applicable compression."
           (x (not-found request)))
         (not-found request))))
 
+(define (service-name)
+  "Return the Avahi service name of the server."
+  (string-append "guix-publish-" (gethostname)))
+
+(define service-type
+  ;; Return the Avahi service type of the server.
+  "_guix_publish._tcp")
+
 (define* (run-publish-server socket store
                              #:key
+                             avahi? port
                              (compressions (list %no-compression))
                              (nar-path "nar") narinfo-ttl
                              cache pool)
+  (when avahi?
+    (avahi-publish-service-thread (service-name)
+                                  #:type service-type
+                                  #:port port))
+
   (run-server (make-request-handler store
                                     #:cache cache
                                     #:pool pool
@@ -1092,6 +1112,7 @@ methods, return the applicable compression."
                                 (lambda (arg result)
                                   (leave (G_ "~A: extraneous argument~%") arg))
                                 %default-options))
+           (avahi?  (assoc-ref opts 'enable-avahi?))
            (user    (assoc-ref opts 'user))
            (port    (assoc-ref opts 'port))
            (ttl     (assoc-ref opts 'narinfo-ttl))
@@ -1152,6 +1173,8 @@ consider using the '--user' option!~%")))
 
         (with-store store
           (run-publish-server socket store
+                              #:avahi? avahi?
+                              #:port port
                               #:cache cache
                               #:pool (and cache (make-pool workers
                                                            #:thread-name
-- 
2.29.2