/
websy.r
289 lines (264 loc) · 6.77 KB
/
websy.r
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
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
REBOL [
Title: "Websy - a tiny HTTP/1.0 404-Error server"
Author: "Ingo Hohmann"
About: {A small server serving 404 errors over http/1.0.
As an added bonus it is relatively easy to change the handlers
to return something more interesting.
}
]
websy: object [
this: self ;store away self
config: object [
port: 8080
quiet: false
]
listen-port: none ; for internal use, to be able to close the port again
code-map: make map! [200 "OK" 400 "Forbidden" 404 "Not Found" 410 "Gone"
500 "Internal Server Error" 501 "Not Implemented"]
mime-map: make map! [html "text/html" jpg "image/jpeg" r "text/plain"
txt "text/plain" js "application/javascript" json "application/json"
css "text/css"
]
template-error: trim/auto {
<html><head><title>$code $text</title></head>
<body><h1>$text</h1>
<h2>Info</h2>
<p>$info</p>
<h2>Request:</h2>
<pre>$request</pre>
<hr>
<i>websy.r</i>
on <a href="http://www.rebol.com/rebol3/">REBOL 3</a> $r3
</body></html>
}
template-page: trim/auto {
<html><head><title>$title</title></head>
<body>
$content
</body></html>
}
crlf2x: join crlf crlf
crlf2xb: to-binary crlf2x
build-error-response: function [
"Create a block containing return-code(code), mime-type(html), and html content (error, containin request info(molded))"
status-code [integer!] "http status code"
request [string!] "request string"
info [string!] "additional error information"
][
r3: system/version
req: reduce [request newline newline mold parse-request request "***"]
reduce [
status-code mime-map/html
reword template-error compose [
code (status-code) text (code-map/:status-code)
info (info)
request (reduce [request newline newline mold parse-request request "***"]) r3 (system/version)
]
]
]
build-success-response: function [
"Create a block containing return-code(200), mime-type(html), and html content"
type "unused"
title [string!] "page title"
html [string!] "page text"
][
reduce [
200 mime-map/html
reword template-page compose [
title (title) content (html)
]
]
]
build-header: function [
"Build response header"
code [integer!] "http response code"
type [word! string!] "file ending as word, e.g. 'html, 'css, to be looked up."
][
?? type
probe ajoin [
"HTTP/1.0 " code " " code-map/:code crlf
"Content-type: " mime-map/:type crlf2x
]
]
deurl: function [
"decode an url encoded string"
s [string!]
][
dbg/log s
dehex replace/all s #"+" #" "
]
parse-request: function [
{parse request and return a map! with header-names as keys
(standard headers are words, others are strings) }
request [string!]
][
name-char: complement charset ":"
query-split-char: charset "&="
req: make map! []
parse request [
copy method: to #" " skip
copy path: to #" " skip
copy version: to newline newline
(
req/method: method
req/version: version
path: dehex path
set [path: query-string:] split path #"?"
req/path: path
req/path-elements: next split path #"/"
req/file-name: last req/path-elements
either pos: find/last req/file-name #"." [
req/file-base: copy/part req/file-name pos
req/file-type: copy next pos
][
req/file-base: req/file-name
req/file-type: ""
]
either query-string [
req/query-string: query-string
req/query: map split query-string query-split-char
][
req/query-string: ""
req/query: []
]
)
any [
copy name [some name-char] 2 skip copy data to newline
(name: to-word name
req/:name: data)
newline
]
newline
copy content-string to end
(
req/content-string: content-string
req/content: map split content-string query-split-char
)
]
req
]
;
; all handle-xxx function have to return a block, containg
; http return code [integer!]
; mime/type [word!]
; page content [string!]
;
handle-get: function [
"Handle a get request, to be implemented by the user of this library"
request [string!]
][
;print 'handle-get-default
build-error-response 404 request "HTTP GET default handler"
]
handle-post: function [
"Handle a post request, to be implemented by the user of this library"
request [string!]
][
;print 'handle-post-default
build-error-response 404 request "HTTP POST default Handler"
]
handle-put: function [
"Handle a put request, to be implemented by the user of this library"
request [string!]
][
;print 'handle-put-default
build-error-response 404 request "HTTP PUT default Handler"
]
handle-delete: function [
"Handle a delete request, to be implemented by the user of this library"
request [string!]
][
;print 'handle-delete-default
build-error-response 410 request "HTTP DELETE default Handler"
]
send-answer: function [
"Send an answer to the client"
port [port!] "port to send the datat to"
data [block!] "http return code, mime-type, page-body"
][
;print 'send-answer
set [ code type body] data
chunk: 32000
write port build-header code type
until [
write port copy/part body chunk
tail? body: skip body chunk
]
]
handle-request: function [
"build answer to the client"
request [binary!]
/local reply
][
;print 'handle-request
req: to-string request
method: copy/part req find req #" "
set/any 'reply switch method [
"GET" [handle-get req]
"POST" [handle-post req]
"PUT" [handle-put req]
"DELETE" [handle-delete req]
]
either all [value? 'reply block? reply][
;either all [3 = length? reply integer? reply/1 word? reply/2 string? reply/3][
either parse reply [ integer! word! string! opt string! ][
reply
][
build-error-response 500 req "Sorry, we've got an error, that's purely me doing something wrong."
]
][
build-error-response 404 req "The resource you are searching can't be found."
]
]
awake-client-connection: function [
"The client has sent a request"
event
][
port: event/port
switch event/type [
read [
either find port/data crlf2xb [
send-answer port handle-request port/data
][
read port
]
]
wrote [close port]
close [close port]
]
]
awake-server-dispatch: function [
"A client wants to connect"
event [object!]
][
if event/type = 'accept [
connection: first event/port
connection/awake: :awake-client-connection
read connection
]
]
extend: function [
"extend websy with the following definitions"
code [block!]
][
do bind code this
]
start: function [
"Start listening"
/extern listen-port
][
if not config/quiet [
print join "Websy starting on localhost:" config/port
]
this/listen-port: open join tcp://: config/port
this/listen-port/awake: :awake-server-dispatch
wait this/listen-port
]
stop: function [
"Stop listening"
/extern listen-port
][
close this/listen-port
]
]
;websy/start