Subject: [PATCH] cuirass: Add --listen command line option.
From: Jan Nieuwenhuizen <[email-masked]>
To: [email-masked]
Date: Mon, 18 Sep 2017 22:02:07 +0200
List-Id: <debbugs-submit.debbugs.gnu.org>

* bin/cuirass.in (show-help): Add help for --listen option.
(%options): Add listen option.
(main): Pass host to run-cuirass-server.
* doc/cuirass.texi (Invocation): Add --listen option.
* src/cuirass/http.scm (run-cuirass-server): Add named #:host parameter.
---
 bin/cuirass.in       |  5 ++++-
 doc/cuirass.texi     |  4 ++++
 src/cuirass/http.scm | 15 +++++++++------
 3 files changed, 17 insertions(+), 7 deletions(-)

diff --git a/bin/cuirass.in b/bin/cuirass.in
index 18edf1e..0da5c06 100644
--- a/bin/cuirass.in
+++ b/bin/cuirass.in
@@ -41,6 +41,7 @@ exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" "$@"
                             Add specifications from SPECFILE to database.
   -D  --database=DB         Use DB to store build results.
   -p  --port=NUM            Port of the HTTP server.
+      --listen=HOST         Listen on the network interface for HOST
   -I, --interval=N          Wait N seconds between each poll
       --use-substitutes     Allow usage of pre-built substitutes
   -V, --version             Display version
@@ -55,6 +56,7 @@ exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" "$@"
     (specifications (single-char #\S) (value #t))
     (database       (single-char #\D) (value #t))
     (port           (single-char #\p) (value #t))
+    (listen                           (value #t))
     (interval       (single-char #\I) (value #t))
     (use-substitutes                  (value #f))
     (fallback                         (value #f))
@@ -87,6 +89,7 @@ exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" "$@"
        (else
         (let ((one-shot? (option-ref opts 'one-shot #f))
               (port      (string->number (option-ref opts 'port "8080")))
+              (host      (option-ref opts 'listen "localhost"))
               (interval  (string->number (option-ref opts 'interval "10")))
               (specfile  (option-ref opts 'specifications #f)))
           (with-database db
@@ -105,4 +108,4 @@ exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" "$@"
                      (while #t
                        (process-specs db (db-get-specifications db))
                        (sleep interval))))
-                  (run-cuirass-server db #:port port))))))))))
+                  (run-cuirass-server db #:host host #:port port))))))))))
diff --git a/doc/cuirass.texi b/doc/cuirass.texi
index 7f944ca..159b13b 100644
--- a/doc/cuirass.texi
+++ b/doc/cuirass.texi
@@ -186,6 +186,10 @@ be created.
 Make the HTTP interface listen on port @var{num}.  Use port 8080 by
 default.
 
+@item --listen=@var{host}
+Make the HTTP interface listen on network interface for @var{host}.  Use
+localhost by default.
+
 @item --interval=@var{n}
 @itemx -I @var{n}
 Wait @var{n} seconds between each poll.
diff --git a/src/cuirass/http.scm b/src/cuirass/http.scm
index 23c3ad7..7434429 100644
--- a/src/cuirass/http.scm
+++ b/src/cuirass/http.scm
@@ -166,9 +166,12 @@
               #:body (string-append "Resource not found: "
                                     (uri->string (request-uri request)))))))
 
-(define* (run-cuirass-server db #:key (port 8080))
-  (format (current-error-port) "listening on port ~A~%" port)
-  (run-server url-handler
-              'http
-              `(#:port ,port)
-              db))
+(define* (run-cuirass-server db #:key (host "localhost") (port 8080))
+  (let* ((host-info (gethostbyname host))
+         (address (inet-ntop (hostent:addrtype host-info)
+                             (car (hostent:addr-list host-info)))))
+    (format (current-error-port) "listening on ~A:~A~%" address port)
+    (run-server url-handler
+                'http
+                `(#:host ,address #:port ,port)
+                db)))
-- 
Jan Nieuwenhuizen <[email-masked]> | GNU LilyPond http://lilypond.org
Freelance IT http://JoyofSource.com | Avatar® http://AvatarAcademy.com