From ddefe10ba133c8397ddf46c15e2614c1748ddf99 Mon Sep 17 00:00:00 2001
From: Christine Lemmer-Webber <cwebber@dustycloud.org>
Date: Wed, 1 Jun 2022 19:27:52 -0400
Subject: ui: serve: Allow for setting the host explicitly.

Also update docs accordingly.
---
 doc/haunt.texi     | 11 ++++++++++-
 haunt/ui/serve.scm | 29 ++++++++++++++++++++++++++---
 2 files changed, 36 insertions(+), 4 deletions(-)

diff --git a/doc/haunt.texi b/doc/haunt.texi
index 0593681..2dd9b8f 100644
--- a/doc/haunt.texi
+++ b/doc/haunt.texi
@@ -348,7 +348,16 @@ Load the Haunt site declaration from @var{configuration-file}.
 @item --port=@var{port}
 @itemx -p @var{port}
 
-Listen for HTTP requests on @var{port}.
+Listen for HTTP requests on @var{port}.  Defaults to 8080.
+
+@item --host=@var{host}
+@itemx -p @var{host}
+
+Listen for HTTP requests on @var{host}.  Accepts an IP address (IPv4
+or IPv6), @code{localhost} or @code{loopback} to serve on the local
+loopback device (the default), or @code{any} to bind on all local
+available ports (useful if you want to show off your website to
+someone else on your LAN, or something.)
 
 @item --watch
 @itemx -w
diff --git a/haunt/ui/serve.scm b/haunt/ui/serve.scm
index 8abe0c6..be917ea 100644
--- a/haunt/ui/serve.scm
+++ b/haunt/ui/serve.scm
@@ -24,6 +24,7 @@
 
 (define-module (haunt ui serve)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-37)
   #:use-module (ice-9 match)
   #:use-module (ice-9 format)
@@ -44,6 +45,8 @@ Start an HTTP server for the current site.~%")
   (display "
   -p, --port             port to listen on")
   (display "
+  -h, --host             host address (IP address, \"localhost\", or \"any\")")
+  (display "
   -w, --watch            rebuild site when files change")
   (newline)
   (show-common-options-help)
@@ -65,14 +68,32 @@ Start an HTTP server for the current site.~%")
          (option '(#\p "port") #t #f
                  (lambda (opt name arg result)
                    (alist-cons 'port (string->number* arg) result)))
+         (option '(#\b "host") #t #f
+                 (lambda (opt name arg result)
+                   (define host-addr
+                     (match arg
+                       ((or "loopback" "localhost") INADDR_LOOPBACK)
+                       ("any"      INADDR_ANY)
+                       ;; lazy way of doing this...
+                       ;; "." or ":" indicates ipv4 or ipv6
+                       ((? (cut string-contains <> "."))
+                        (inet-pton AF_INET arg))
+                       ((? (cut string-contains <> ":"))
+                        (inet-pton AF_INET6 arg))
+                       (_
+                        (format #t "Unrecognized option for --host: ~a\n" arg)
+                        (display "Must be an IP address, \"localhost\", or \"any\".\n")
+                        (exit 1))))
+                   (alist-cons 'host host-addr result)))
          (option '(#\w "watch") #f #f
                  (lambda (opt name arg result)
                    (alist-cons 'watch? #t result)))
          %common-options))
 
 (define %default-options
-  (cons '(port . 8080)
-        %default-common-options))
+  (append `((port . 8080)
+            (host . ,INADDR_LOOPBACK))
+          %default-common-options))
 
 (define (call-with-error-handling thunk)
   (catch #t
@@ -198,6 +219,7 @@ site."
 (define (haunt-serve . args)
   (let* ((opts     (simple-args-fold args %options %default-options))
          (port     (assq-ref opts 'port))
+         (host     (assq-ref opts 'host))
          (watch?   (assq-ref opts 'watch?))
          (config   (assq-ref opts 'config))
          (site     (load-config config))
@@ -221,4 +243,5 @@ site."
                       (not
                        (string-prefix? build-dir dir))))
                   (site-file-filter site))))))
-    (serve doc-root #:open-params `(#:port ,port))))
+    (serve doc-root #:open-params `(#:port ,port
+                                    #:addr ,host))))
-- 
cgit v1.2.3