137 lines
5.2 KiB
Plaintext
137 lines
5.2 KiB
Plaintext
{ (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 DrRacket).
|
|
|
|
<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")}
|