mirror of
https://git.savannah.gnu.org/git/guix.git
synced 2025-01-19 05:57:04 +01:00
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.
This commit is contained in:
parent
375cc7dea2
commit
276e494b2a
3 changed files with 43 additions and 4 deletions
|
@ -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
|
||||
|
|
|
@ -1744,6 +1744,8 @@ (define-record-type* <guix-publish-configuration>
|
|||
(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 @@ (define (config->compression-options config)
|
|||
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 @@ (define (config->compression-options config)
|
|||
#$@(config->compression-options config)
|
||||
(string-append "--nar-path=" #$nar-path)
|
||||
(string-append "--listen=" #$host)
|
||||
#$@(if advertise?
|
||||
#~("--advertise")
|
||||
#~())
|
||||
#$@(if workers
|
||||
#~((string-append "--workers="
|
||||
#$(number->string
|
||||
|
|
|
@ -42,6 +42,7 @@ (define-module (guix scripts publish)
|
|||
#: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 @@ (define-module (guix scripts publish)
|
|||
signed-string
|
||||
|
||||
open-server-socket
|
||||
publish-service-type
|
||||
run-publish-server
|
||||
guix-publish))
|
||||
|
||||
|
@ -83,6 +85,8 @@ (define (show-help)
|
|||
(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 @@ (define %options
|
|||
(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 @@ (define nar-path?
|
|||
(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 @@ (define-command (guix-publish . args)
|
|||
(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 @@ (define-command (guix-publish . args)
|
|||
|
||||
(with-store store
|
||||
(run-publish-server socket store
|
||||
#:advertise? advertise?
|
||||
#:port port
|
||||
#:cache cache
|
||||
#:pool (and cache (make-pool workers
|
||||
#:thread-name
|
||||
|
|
Loading…
Reference in a new issue