{ (define LIBNAME "Scheme Web Servlets")
  (include "head.tinc") }

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

<pre>
 <code>
  (define-struct request (method uri headers bindings host-ip client-ip))

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

constrained as follows:

<pre>
  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
</pre>

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

<ul>
  <li><code>{(idx build-suspender)} :
         (listof X-expr[HTML]) (listof X-expr[HTML]) [Env] [Env] -> Suspender</code>
    <br>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 <code>head</code> and
    <code>body</code> tags of the constructed page.

  <li><code>{(idx send/suspend)} : Suspender -> Request</code> <br />
  sends the suspender's page to the browser and waits for the browser's request.

  <li><code>{(idx send/finish)} : Response -> Void</code> <br />
  sends the response to the browser and terminates the servlet (and the
  REPL,  when used inside of DrScheme).

  <li><code>{(idx initial-request)} : Request</code> <br /> a fictitious request
  that looks like a browser initially requested the servlet's URL.

  <li><code>{(idx extract-binding/single)} : Symbol Env -> string</code><br>
  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.

  <li><code>{(idx extract-bindings)} : Symbol Env -> (listof String)</code>
  <br /> consumes a symbol and a bindings environment.  It produces all the
  values associated with that symbol.

  <li><code>{(idx extract-string)} : String Env -> (listof String)</code>
  <br /> consumes a string and a bindings environment.  It produces all the
  values associated with that string.

  <li><code>{(idx exists-binding?)} : Symbol Env -> Boolean</code> <br>
  consumes a symbol and a bindings environment.  It produces true when the
  symbol is bound.  This is useful for checkboxes.

  <li><code>{(idx extract-user-pass)} : Env -> (union false (cons string string))</code>
  <br>extracts the username and the password from the HTTP headers environment,
  if provided.
  Servlets may use this function to implement password based
  authentication.
</ul>

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

<pre>
; Request -> Request
(define (get-login-information request0)
  (let* ([bindings (request-bindings request0)]
         [name (extract-bindings 'Name bindings)]
         [form '((input ([type "text"][name "Name"][value "<Last Name>"]))
                 (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)))
</pre>

{(include "foot.tinc")}