The Server [full code]



(module server mzscheme 
  
  (provide 
   ;; Request = (cons String [Listof String])
   
   ;; Response [a type]
   ;; Mime is one of: "text/html" or "text/text" or false
   
   create-response ;; Nat String String Mime [Listof String] -> Response 
   ;; create a response from the given values 
   
   server ;; (Request -> Response) -> Empty
   ;; given a function that produces responses for requests, 
   ;; _server_ responds to connections on port CSU211-SERVER 
   )

  (require (lib "etc.ss") (lib "list.ss") "io.ss")


;; Responses (define-struct response (code msg date mime content) (make-inspector)) ;; Response = (make-response Nat[200-800] String String String [Listof String]) (define (create-response code msg date mime content) (cond [(and (number? code) (<= 200 code 800) (string? msg) (string? date) (or (and (boolean? mime) (boolean=? mime false)) (and (string? mime) (or (string=? "text/html" mime) (string=? "text/text" mime)))) (list? content) (andmap string? content)) (make-response code msg date mime content)] [else (error 'create-response "bad values for creating a response")]))
;; The Server (define CSU211-SERVER 4005) (define (server response-produce) (local (;; serve-connection : Listener -> true ;; generative recursion: run forever (define (serve-connection l) (local ((define-values (ip op) (tcp-accept l)) (define request (request-read ip)) (define response (response-produce request)) (define header (response->header response)) (define body (response-content response))) (print-all op (append header (list "\r\n") body)) (close-output-port op) (serve-connection l)))) (serve-connection (tcp-listen CSU211-SERVER 30 true)))) ;; InputPort -> [Listof String] ;; read all lines from a port until it is closed ;; or returns a line with a single char (\r) (define (request-read ip) (local ((define next (read-line ip))) (cond [(eof-object? next) empty] [(= (string-length next) 1) empty] [else (cons (substring next 0 (- (string-length next) 1)) (request-read ip))]))) ;; Response -> [Listof String] ;; create a header from a response (would include date usually) (define (response->header r) (list (string-append "HTTP/1.0 " (number->string (response-code r)) " " (response-msg r)) (string-append "Date: " (response-date r)) "Server: The CSU 211 Server" (string-append "Content-type: "(response-mime r)))) )