instaweb.ss
;;;
;;; Time-stamp: <2007-11-16 15:49:16 us>
;;;
;;; Copyright (C) 2005 by Noel Welsh.
;;;

;;; This library is free software; you can redistribute it
;;; and/or modify it under the terms of the GNU Lesser
;;; General Public License as published by the Free Software
;;; Foundation; either version 2.1 of the License, or (at
;;; your option) any later version.

;;; This library is distributed in the hope that it will be
;;; useful, but WITHOUT ANY WARRANTY; without even the
;;; implied warranty of MERCHANTABILITY or FITNESS FOR A
;;; PARTICULAR PURPOSE.  See the GNU Lesser General Public
;;; License for more details.

;;; You should have received a copy of the GNU Lesser
;;; General Public License along with this library; if not,
;;; write to the Free Software Foundation, Inc., 59 Temple
;;; Place, Suite 330, Boston, MA 02111-1307 USA

;;; Author: Noel Welsh <noelwelsh@yahoo.com>
;;
;;
;; Commentary:

(module instaweb mzscheme

  (require (lib "kw.ss")
           (lib "etc.ss")
           (lib "web-server.ss" "web-server"))

  (require (file "dispatcher.ss"))
  
  (provide instaweb
           instaweb-here)

  ;; syntax instaweb-here : servlet [port] [ip-address]
  (define-syntax instaweb-here
    (syntax-rules ()
      [(instaweb/here arg ...)
       (parameterize
         [(current-directory (this-expression-source-directory))]
         (instaweb arg ...))]))
    
  ;; instaweb : [#:port integer] [#listen-ip (U string #f)] [#:any any] ... -> void
  (define instaweb
    (lambda/kw (#:key [port 8765]
                      [listen-ip "127.0.0.1"]
                #:other-keys dispatch-args)

      (define dispatcher (apply make dispatch-args))

      (define (run-server)
        (serve #:dispatch dispatcher
               #:port port
               #:listen-ip listen-ip))
      
      (define (display-usage)
        (printf "Web server started on port ~a\n" port)
        (printf "Listening on IP address: ~a\n"
                (if listen-ip listen-ip "all addresses"))
        (printf "Type stop to stop the server and exit\n")
        (printf "Type restart to restart the server\n"))

      (define (server-loop stop-server)
        (display-usage)
        (let loop ((cmd (read)))
          (cond
           [(eof-object? cmd)
            (printf "Instaweb: Received EOF from input port.  Will not read further\n")
            (thread-wait (current-thread))]
           [(eq? cmd 'stop) (stop-server)]
           [(eq? cmd 'restart)
            (stop-server)
            (server-loop (run-server))]
           [else (printf "Don't know what to do with ~a.  Try again.\n" cmd)
                 (display-usage)
                 (loop (read))])))
      
      (parameterize
          ([print-hash-table #t]
           [print-struct #t]
           [error-print-width 1024]
           [error-print-context-length 50])
        (server-loop (run-server)))))

  )