link="#009900" vlink="#007700" alink="#cc0000"> Teachpacks for How to Design Programs

Scheme Web Servlets

servlet.ss

The teachpack servlet.ss provides structures and functions for building Web servlets in Scheme. The data definitions represent HTTP requests and Web page responses using these two structures:

 
  (define-struct request (method uri headers bindings host-ip client-ip))

  (define-struct response/full (code message seconds mime extras body))

constrained as follows:

 
  Env      = (listof (cons Symbol String))
  Request  = (make-request (union 'get 'post) URL Env Env String String)
    ;; (search for "net" in Help Desk)
  Response =
   (union 
     X-expression ;; represent XHTML (search for "XML" in help-desk)
     (cons String (listof String))
       ;; where the first string is the mime type from RFC 2822, often
       ;; "text/html", and the rest of the strings provide the document's
       ;; content.
     (make-response/full N String N String Env (listof String))
       ;; where the fields are interpreted as follows: 
       ;;   code indicates the HTTP response code.
       ;;   message describes the code in human language.
       ;;   seconds indicates the origination time of the
       ;;   response. Use (current-seconds) for dynamically created responses. 
       ;;   mime indicates the response type.
       ;;   extras is an environment with extra headers for redirects, authentication, or cookies.
       ;;   body is the message body.
  Suspender = String -> Response



The following functions empower servlets to interact with a Web browser: 


  build-suspender : 
         (listof X-expr[HTML]) (listof X-expr[HTML]) [Env] [Env] -> Suspender
    
builds a suspender from lists of X-expressions for the head and the
    body of a Web page. The body is put into a form context. The function 
    optionally consumes attributes for the head and
    body tags of the constructed page. 

  
send/suspend : Suspender -> Request 

  sends the suspender's page to the browser and waits for the browser's request.

  
send/finish : Response -> Void 

  sends the response to the browser and terminates the servlet (and the
  REPL,  when used inside of DrScheme).

  
initial-request : Request 
 a fictitious request
  that looks like a browser initially requested the servlet's URL.

  
extract-binding/single : Symbol Env -> string

  consumes the symbol of an HTML form field and a bindings environment.  It
  returns the only value associated with the given symbol.  It raises an
  exception when zero or more than one input is provided for a single symbol.

  
extract-bindings : Symbol Env -> (listof String)
  
 consumes a symbol and a bindings environment.  It produces all the
  values associated with that symbol.

  
extract-string : String Env -> (listof String)
  
 consumes a string and a bindings environment.  It produces all the
  values associated with that string.

  
exists-binding? : Symbol Env -> Boolean 

  consumes a symbol and a bindings environment.  It produces true when the
  symbol is bound.  This is useful for checkboxes.

  
extract-user-pass : Env -> (union false (cons string string))
  
extracts the username and the password from the HTTP headers environment,
  if provided.
  Servlets may use this function to implement password based
  authentication. 


Here is a sample script that permits consumers to login to a site: 


; Request -> Request 
(define (get-login-information request0)
  (let* ([bindings (request-bindings request0)]
         [name (extract-bindings 'Name bindings)]
         [form '((input ([type "text"][name "Name"][value ""]))
                 (br)
                 (input ([type "password"][name "Passwd"]))
                 (br)
                 (input ([type "submit"][value "Login"])))])
    (if (null? name)
        (send/suspend
         (build-suspender 
          '("Login")
          form))
        (send/suspend 
         (build-suspender 
          '("Repeat Login")
          `(("Dear "
             ,(car name)
             " your username didn't match your password. Please try again."
             (br))
            ,@form))))))
            
; Request -> Void
(define (check-login-information request)
  (let* ([bindings (request-bindings request)]
         [name     (extract-binding/single 'Name bindings)]
         [passwd   (extract-binding/single 'Passwd bindings)])
    (if (and (string=? "Paul" name) (string=? "Portland" passwd))
        request
        (check-login-information (get-login-information request)))))

; Request -> Void
(define (welcome request)
  (let ([bindings (request-bindings request)])
    (send/finish
     `(html 
       ,(extract-binding/single 'Name bindings)
       " Thanks for using our service."
       " We're glad you recalled that your password is "
       ,(extract-binding/single 'Passwd bindings)))))

; RUN: 
(welcome
 (check-login-information
  (get-login-information initial-request)))