publish: Add '--listen'.

* guix/scripts/publish.scm (show-help, %options): Add --listen.
  (getaddrinfo*): New procedure.
  (%default-options): Add 'address'.
  (open-server-socket): Replace 'addr' and 'port' with 'address', a
  sockaddr.
  (guix-publish): Adjust accordingly.  Augment "publishing" message with
  the actual address.
* doc/guix.texi (Invoking guix publish): Document it.
This commit is contained in:
Ludovic Courtès 2015-05-12 21:20:19 +02:00
parent 083b54b7c7
commit 9e2292ef3d
2 changed files with 47 additions and 15 deletions

View File

@ -3687,6 +3687,10 @@ The following options are available:
@itemx -p @var{port} @itemx -p @var{port}
Listen for HTTP requests on @var{port}. Listen for HTTP requests on @var{port}.
@item --listen=@var{host}
Listen on the network interface for @var{host}. The default is to
accept connections from any interface.
@item --user=@var{user} @item --user=@var{user}
@itemx -u @var{user} @itemx -u @var{user}
Change privileges to @var{user} as soon as possible---i.e., once the Change privileges to @var{user} as soon as possible---i.e., once the

View File

@ -50,6 +50,8 @@
Publish ~a over HTTP.\n") %store-directory) Publish ~a over HTTP.\n") %store-directory)
(display (_ " (display (_ "
-p, --port=PORT listen on PORT")) -p, --port=PORT listen on PORT"))
(display (_ "
--listen=HOST listen on the network interface for HOST"))
(display (_ " (display (_ "
-u, --user=USER change privileges to USER as soon as possible")) -u, --user=USER change privileges to USER as soon as possible"))
(display (_ " (display (_ "
@ -62,6 +64,15 @@ Publish ~a over HTTP.\n") %store-directory)
(newline) (newline)
(show-bug-report-information)) (show-bug-report-information))
(define (getaddrinfo* host)
"Like 'getaddrinfo', but properly report errors."
(catch 'getaddrinfo-error
(lambda ()
(getaddrinfo host))
(lambda (key error)
(leave (_ "lookup of host '~a' failed: ~a~%")
host (gai-strerror error)))))
(define %options (define %options
(list (option '(#\h "help") #f #f (list (option '(#\h "help") #f #f
(lambda _ (lambda _
@ -76,6 +87,15 @@ Publish ~a over HTTP.\n") %store-directory)
(option '(#\p "port") #t #f (option '(#\p "port") #t #f
(lambda (opt name arg result) (lambda (opt name arg result)
(alist-cons 'port (string->number* arg) result))) (alist-cons 'port (string->number* arg) result)))
(option '("listen") #t #f
(lambda (opt name arg result)
(match (getaddrinfo* arg)
((info _ ...)
(alist-cons 'address (addrinfo:addr info)
result))
(()
(leave (_ "lookup of host '~a' returned nothing")
name)))))
(option '(#\r "repl") #f #t (option '(#\r "repl") #f #t
(lambda (opt name arg result) (lambda (opt name arg result)
;; If port unspecified, use default Guile REPL port. ;; If port unspecified, use default Guile REPL port.
@ -83,7 +103,8 @@ Publish ~a over HTTP.\n") %store-directory)
(alist-cons 'repl (or port 37146) result)))))) (alist-cons 'repl (or port 37146) result))))))
(define %default-options (define %default-options
'((port . 8080) `((port . 8080)
(address . ,(make-socket-address AF_INET INADDR_ANY 0))
(repl . #f))) (repl . #f)))
(define (lazy-read-file-sexp file) (define (lazy-read-file-sexp file)
@ -230,11 +251,11 @@ example: \"/foo/bar\" yields '(\"foo\" \"bar\")."
'http 'http
`(#:socket ,socket))) `(#:socket ,socket)))
(define (open-server-socket addr port) (define (open-server-socket address)
"Return a TCP socket bound to ADDR and PORT." "Return a TCP socket bound to ADDRESS, a socket address."
(let ((sock (socket PF_INET SOCK_STREAM 0))) (let ((sock (socket (sockaddr:fam address) SOCK_STREAM 0)))
(setsockopt sock SOL_SOCKET SO_REUSEADDR 1) (setsockopt sock SOL_SOCKET SO_REUSEADDR 1)
(bind sock AF_INET addr port) (bind sock address)
sock)) sock))
(define (gather-user-privileges user) (define (gather-user-privileges user)
@ -256,15 +277,19 @@ example: \"/foo/bar\" yields '(\"foo\" \"bar\")."
(define (guix-publish . args) (define (guix-publish . args)
(with-error-handling (with-error-handling
(let* ((opts (args-fold* args %options (let* ((opts (args-fold* args %options
(lambda (opt name arg result) (lambda (opt name arg result)
(leave (_ "~A: unrecognized option~%") name)) (leave (_ "~A: unrecognized option~%") name))
(lambda (arg result) (lambda (arg result)
(leave (_ "~A: extraneuous argument~%") arg)) (leave (_ "~A: extraneuous argument~%") arg))
%default-options)) %default-options))
(port (assoc-ref opts 'port)) (user (assoc-ref opts 'user))
(user (assoc-ref opts 'user)) (port (assoc-ref opts 'port))
(socket (open-server-socket INADDR_ANY port)) (address (let ((addr (assoc-ref opts 'address)))
(make-socket-address (sockaddr:fam addr)
(sockaddr:addr addr)
port)))
(socket (open-server-socket address))
(repl-port (assoc-ref opts 'repl))) (repl-port (assoc-ref opts 'repl)))
;; Read the key right away so that (1) we fail early on if we can't ;; Read the key right away so that (1) we fail early on if we can't
;; access them, and (2) we can then drop privileges. ;; access them, and (2) we can then drop privileges.
@ -279,7 +304,10 @@ example: \"/foo/bar\" yields '(\"foo\" \"bar\")."
(when (zero? (getuid)) (when (zero? (getuid))
(warning (_ "server running as root; \ (warning (_ "server running as root; \
consider using the '--user' option!~%"))) consider using the '--user' option!~%")))
(format #t (_ "publishing ~a on port ~d~%") %store-directory port) (format #t (_ "publishing ~a on ~a, port ~d~%")
%store-directory
(inet-ntop (sockaddr:fam address) (sockaddr:addr address))
(sockaddr:port address))
(when repl-port (when repl-port
(repl:spawn-server (repl:make-tcp-server-socket #:port repl-port))) (repl:spawn-server (repl:make-tcp-server-socket #:port repl-port)))
(with-store store (with-store store