1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
|
<html>
<head>
<title>Teachpack : Scheme Web Servlets</title>
</head>
<body bgcolor="#ffffff" text="#000000"
link="#009900" vlink="#007700" alink="#cc0000">
<a href="index.html">Teachpacks for How to Design Programs</a>
<h1>Scheme Web Servlets</h1>
<hr> <h3><a name="servlet.ss">servlet.ss</a></h3> <!-- DOCNOTE="teach=servlet.ss" -->
<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><a name="build-suspender">build-suspender</a> :
(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><a name="send/suspend">send/suspend</a> : Suspender -> Request</code> <br />
sends the suspender's page to the browser and waits for the browser's request.
<li><code><a name="send/finish">send/finish</a> : Response -> Void</code> <br />
sends the response to the browser and terminates the servlet (and the
REPL, when used inside of DrScheme).
<li><code><a name="initial-request">initial-request</a> : Request</code> <br /> a fictitious request
that looks like a browser initially requested the servlet's URL.
<li><code><a name="extract-binding/single">extract-binding/single</a> : 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><a name="extract-bindings">extract-bindings</a> : Symbol Env -> (listof String)</code>
<br /> consumes a symbol and a bindings environment. It produces all the
values associated with that symbol.
<li><code><a name="extract-string">extract-string</a> : String Env -> (listof String)</code>
<br /> consumes a string and a bindings environment. It produces all the
values associated with that string.
<li><code><a name="exists-binding?">exists-binding?</a> : 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><a name="extract-user-pass">extract-user-pass</a> : 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>
<br>
<br>
</body>
</html>
|
