aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMathieu Othacehe <othacehe@gnu.org>2020-11-22 15:15:17 +0100
committerMathieu Othacehe <othacehe@gnu.org>2020-11-29 15:08:26 +0100
commit276e494b2a1fd87874d80e2bdc3aa1fb833b76f2 (patch)
tree852860bd1aea0bb32ca3946d58b5d3876c4ae260
parent375cc7dea20da7117c9459e4a4d15144095e015b (diff)
downloadguix-276e494b2a1fd87874d80e2bdc3aa1fb833b76f2.tar
guix-276e494b2a1fd87874d80e2bdc3aa1fb833b76f2.tar.gz
publish: Add advertising support.
* guix/scripts/publish.scm (%options): Add "--advertise" option. (show-help): Document it. (service-name): New procedure, (publish-service-type): new variable. (run-publish-server): Add "advertise?" and "port" parameters. Use them to publish the server using Avahi. (guix-publish): Pass the "advertise?" option to "run-publish-server". * gnu/services/base.scm (<guix-publish-configuration>): Add "advertise?" field. (guix-publish-shepherd-service): Honor it.
-rw-r--r--doc/guix.texi5
-rw-r--r--gnu/services/base.scm8
-rw-r--r--guix/scripts/publish.scm34
3 files changed, 43 insertions, 4 deletions
diff --git a/doc/guix.texi b/doc/guix.texi
index baf6e69039..8ca243004a 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -12159,6 +12159,11 @@ 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{--advertise} option is passed, the server advertises
+its availability on the local network using multicast DNS (mDNS) and DNS
+service discovery (DNS-SD), currently @i{via} Guile-Avahi (@pxref{Top,,,
+guile-avahi, Using Avahi in Guile Scheme Programs}).
+
The general syntax is:
@example
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 3fc4d5f885..e3b347293e 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -1744,6 +1744,8 @@ proxy of 'guix-daemon'...~%")
(default 80))
(host guix-publish-configuration-host ;string
(default "localhost"))
+ (advertise? guix-publish-advertise? ;boolean
+ (default #f))
(compression guix-publish-configuration-compression
(thunked)
(default (default-compression this-record
@@ -1790,7 +1792,8 @@ raise a deprecation warning if the 'compression-level' field was used."
lst))))
(match-record config <guix-publish-configuration>
- (guix port host nar-path cache workers ttl cache-bypass-threshold)
+ (guix port host nar-path cache workers ttl cache-bypass-threshold
+ advertise?)
(list (shepherd-service
(provision '(guix-publish))
(requirement '(guix-daemon))
@@ -1801,6 +1804,9 @@ raise a deprecation warning if the 'compression-level' field was used."
#$@(config->compression-options config)
(string-append "--nar-path=" #$nar-path)
(string-append "--listen=" #$host)
+ #$@(if advertise?
+ #~("--advertise")
+ #~())
#$@(if workers
#~((string-append "--workers="
#$(number->string
diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm
index 2a2185e2b9..4822ea55c0 100644
--- a/guix/scripts/publish.scm
+++ b/guix/scripts/publish.scm
@@ -42,6 +42,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)
@@ -70,6 +71,7 @@
signed-string
open-server-socket
+ publish-service-type
run-publish-server
guix-publish))
@@ -83,6 +85,8 @@ Publish ~a over HTTP.\n") %store-directory)
(display (G_ "
-u, --user=USER change privileges to USER as soon as possible"))
(display (G_ "
+ -a, --advertise advertise on the local network"))
+ (display (G_ "
-C, --compression[=METHOD:LEVEL]
compress archives with METHOD at LEVEL"))
(display (G_ "
@@ -157,6 +161,9 @@ usage."
(option '(#\V "version") #f #f
(lambda _
(show-version-and-exit "guix publish")))
+ (option '(#\a "advertise") #f #f
+ (lambda (opt name arg result)
+ (alist-cons 'advertise? #t result)))
(option '(#\u "user") #t #f
(lambda (opt name arg result)
(alist-cons 'user arg result)))
@@ -1069,11 +1076,29 @@ 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 publish-service-type
+ ;; Return the Avahi service type of the server.
+ "_guix_publish._tcp")
+
(define* (run-publish-server socket store
#:key
+ advertise? port
(compressions (list %no-compression))
(nar-path "nar") narinfo-ttl
cache pool)
+ (when advertise?
+ (let ((name (service-name)))
+ ;; XXX: Use a callback from Guile-Avahi here, as Avahi can pick a
+ ;; different name to avoid name clashes.
+ (info (G_ "Advertising ~a~%.") name)
+ (avahi-publish-service-thread name
+ #:type publish-service-type
+ #:port port)))
+
(run-server (make-request-handler store
#:cache cache
#:pool pool
@@ -1119,9 +1144,10 @@ methods, return the applicable compression."
(lambda (arg result)
(leave (G_ "~A: extraneous argument~%") arg))
%default-options))
- (user (assoc-ref opts 'user))
- (port (assoc-ref opts 'port))
- (ttl (assoc-ref opts 'narinfo-ttl))
+ (advertise? (assoc-ref opts 'advertise?))
+ (user (assoc-ref opts 'user))
+ (port (assoc-ref opts 'port))
+ (ttl (assoc-ref opts 'narinfo-ttl))
(compressions (match (filter-map (match-lambda
(('compression . compression)
compression)
@@ -1179,6 +1205,8 @@ consider using the '--user' option!~%")))
(with-store store
(run-publish-server socket store
+ #:advertise? advertise?
+ #:port port
#:cache cache
#:pool (and cache (make-pool workers
#:thread-name