run-server.ss
#lang scheme/base

(require scheme/contract
         web-server/web-server
         web-server/http/request-structs
         web-server/http/response-structs
         web-server/private/connection-manager)

; Utilities --------------------------------------

;  integer
;  (U string #f)
;  (connection request -> void)
; ->
;  stop-server-thunk
(define (run-server port listen-ip dispatcher)
  (begin0 (serve #:dispatch dispatcher #:port port #:listen-ip listen-ip)
          (printf "Web server started on port ~a\n" port)
          (printf "Listening on IP address: ~a\n" (or listen-ip "all addresses"))))

; (-> stop-server-thunk) -> void
(define (console-loop run-server)
  (define (display-usage)
    (printf "Type \"stop\" to stop the server and exit.\n")
    (printf "Type \"restart\" to restart the server.\n"))
  (let ([stop-server (run-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)
             (console-loop run-server)]
            [else (printf "Don't know what to do with ~s. Try again.\n" cmd)
                  (display-usage)
                  (loop (read))]))))

; Provide statements -----------------------------

(provide/contract
 [run-server   (-> natural-number/c
                   (or/c string? false/c)
                   (-> connection? request? any)
                   procedure?)]
 [console-loop (-> (-> procedure?) void?)])