summaryrefslogtreecommitdiff
path: root/guix/scripts/publish.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2015-05-12 21:20:19 +0200
committerLudovic Courtès <ludo@gnu.org>2015-05-12 21:22:52 +0200
commit9e2292ef3d9e2626381f9726c72d71057160b7c3 (patch)
treefc88c4752788939402377a6076a50ddcf5b6e092 /guix/scripts/publish.scm
parent083b54b7c74a68958fe84b8f627123a030775d1e (diff)
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.
Diffstat (limited to 'guix/scripts/publish.scm')
-rw-r--r--guix/scripts/publish.scm58
1 files changed, 43 insertions, 15 deletions
diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm
index 86d3a754f3..7bad2619b9 100644
--- a/guix/scripts/publish.scm
+++ b/guix/scripts/publish.scm
@@ -51,6 +51,8 @@ Publish ~a over HTTP.\n") %store-directory)
(display (_ "
-p, --port=PORT listen on PORT"))
(display (_ "
+ --listen=HOST listen on the network interface for HOST"))
+ (display (_ "
-u, --user=USER change privileges to USER as soon as possible"))
(display (_ "
-r, --repl[=PORT] spawn REPL server on PORT"))
@@ -62,6 +64,15 @@ Publish ~a over HTTP.\n") %store-directory)
(newline)
(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
(list (option '(#\h "help") #f #f
(lambda _
@@ -76,6 +87,15 @@ Publish ~a over HTTP.\n") %store-directory)
(option '(#\p "port") #t #f
(lambda (opt name 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
(lambda (opt name arg result)
;; 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))))))
(define %default-options
- '((port . 8080)
+ `((port . 8080)
+ (address . ,(make-socket-address AF_INET INADDR_ANY 0))
(repl . #f)))
(define (lazy-read-file-sexp file)
@@ -230,11 +251,11 @@ example: \"/foo/bar\" yields '(\"foo\" \"bar\")."
'http
`(#:socket ,socket)))
-(define (open-server-socket addr port)
- "Return a TCP socket bound to ADDR and PORT."
- (let ((sock (socket PF_INET SOCK_STREAM 0)))
+(define (open-server-socket address)
+ "Return a TCP socket bound to ADDRESS, a socket address."
+ (let ((sock (socket (sockaddr:fam address) SOCK_STREAM 0)))
(setsockopt sock SOL_SOCKET SO_REUSEADDR 1)
- (bind sock AF_INET addr port)
+ (bind sock address)
sock))
(define (gather-user-privileges user)
@@ -256,15 +277,19 @@ example: \"/foo/bar\" yields '(\"foo\" \"bar\")."
(define (guix-publish . args)
(with-error-handling
- (let* ((opts (args-fold* args %options
- (lambda (opt name arg result)
- (leave (_ "~A: unrecognized option~%") name))
- (lambda (arg result)
- (leave (_ "~A: extraneuous argument~%") arg))
- %default-options))
- (port (assoc-ref opts 'port))
- (user (assoc-ref opts 'user))
- (socket (open-server-socket INADDR_ANY port))
+ (let* ((opts (args-fold* args %options
+ (lambda (opt name arg result)
+ (leave (_ "~A: unrecognized option~%") name))
+ (lambda (arg result)
+ (leave (_ "~A: extraneuous argument~%") arg))
+ %default-options))
+ (user (assoc-ref opts 'user))
+ (port (assoc-ref opts '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)))
;; 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.
@@ -279,7 +304,10 @@ example: \"/foo/bar\" yields '(\"foo\" \"bar\")."
(when (zero? (getuid))
(warning (_ "server running as root; \
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
(repl:spawn-server (repl:make-tcp-server-socket #:port repl-port)))
(with-store store