diff options
| -rw-r--r-- | doc/guix.texi | 5 | ||||
| -rw-r--r-- | gnu/services/base.scm | 8 | ||||
| -rw-r--r-- | guix/scripts/publish.scm | 34 |
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 |