WEBSITE: added 'localonly option for address binding

part-cw · Sep 4, 2020 · 14765a1 · 14765a1
1 parent 631a14e
commit 14765a1
Show file tree

Hide file tree

Showing 2 changed files with 5 additions and 5 deletions.
diff --git a/apps/DemoHybridApp/main.scm b/apps/DemoHybridApp/main.scm
@@ -132,7 +132,7 @@ EOJS
             ;; Include Javascript here, inside the body
             (script (@ (type "text/javascript")) ,index-js)))))))))
 
-(website-serve #f 8080)
+(website-serve #f 8080 'localonly)
 
 ;; Back-end respond to GET here
 (website-addhook #f "/calculate-rect.cgi" (lambda (x)

diff --git a/modules/website/website.scm b/modules/website/website.scm
@@ -124,8 +124,8 @@ SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
     (else "application/force-download")
   ))
 
-(define (website:server db port)
-  (let ((accept-port (open-tcp-server (list server-address: "*" port-number: port reuse-address: #t))))
+(define (website:server db port address)
+  (let ((accept-port (open-tcp-server (list server-address: address port-number: port reuse-address: #t))))
     (let loop () (let ((connection (read accept-port)))
         (if (not (eof-object? connection))
             (begin (thread-start! (make-safe-thread (lambda ()
@@ -267,9 +267,9 @@ SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 (define website:db (make-table))
 (define (website-getdb) website:db)
 
-(define (website-serve db port) (thread-start! (make-safe-thread (lambda ()
+(define (website-serve db port . bind) (thread-start! (make-safe-thread (lambda ()
   (current-exception-handler log:exception-handler)
-  (website:server (if db db website:db) port)))))
+  (website:server (if db db website:db) port (if (or (null? bind) (not (eq? (car bind) 'localonly))) "*" "127.0.0.1"))))))
 
 (define (website-addhook db document proc)
   (table-set! (if db db website:db)