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)))