1 USING: http http.server http.client http.client.private tools.test
2 multiline io.streams.string io.encodings.utf8 io.encodings.8-bit
3 io.encodings.binary io.encodings.string io.encodings.ascii kernel
4 arrays splitting sequences assocs io.sockets db db.sqlite
5 continuations urls hashtables accessors namespaces xml.data
6 io.encodings.8-bit.latin1 random ;
9 [ "text/plain" "UTF-8" ] [ "text/plain" parse-content-type ] unit-test
11 [ "text/html" "ASCII" ] [ "text/html; charset=ASCII" parse-content-type ] unit-test
13 [ "text/html" "utf-8" ] [ "text/html; charset=\"utf-8\"" parse-content-type ] unit-test
15 [ "application/octet-stream" f ] [ "application/octet-stream" parse-content-type ] unit-test
17 [ "localhost" f ] [ "localhost" parse-host ] unit-test
18 [ "localhost" 8888 ] [ "localhost:8888" parse-host ] unit-test
20 [ "localhost" ] [ T{ url { protocol "http" } { host "localhost" } } unparse-host ] unit-test
21 [ "localhost" ] [ T{ url { protocol "http" } { host "localhost" } { port 80 } } unparse-host ] unit-test
22 [ "localhost" ] [ T{ url { protocol "https" } { host "localhost" } { port 443 } } unparse-host ] unit-test
23 [ "localhost:8080" ] [ T{ url { protocol "http" } { host "localhost" } { port 8080 } } unparse-host ] unit-test
24 [ "localhost:8443" ] [ T{ url { protocol "https" } { host "localhost" } { port 8443 } } unparse-host ] unit-test
26 : lf>crlf ( string -- string' ) "\n" split "\r\n" join ;
28 STRING: read-request-test-1
33 Content-type: application/octet-stream
40 { url T{ url { path "/bar" } } }
43 { header H{ { "some-header" "1; 2" } { "content-length" "4" } { "content-type" "application/octet-stream" } } }
44 { post-data T{ post-data { data "blah" } { content-type "application/octet-stream" } } }
49 read-request-test-1 lf>crlf [
54 STRING: read-request-test-1'
57 content-type: application/octet-stream
63 read-request-test-1' 1array [
64 read-request-test-1 lf>crlf
65 [ read-request ] with-string-reader
66 [ write-request ] with-string-writer
68 string-lines "\n" join
71 STRING: read-request-test-2
79 { url T{ url { host "www.sex.com" } { path "/bar" } } }
82 { header H{ { "host" "www.sex.com" } } }
87 read-request-test-2 lf>crlf [
92 STRING: read-request-test-2'
100 { url T{ url { host "www.sex.com" } { port 101 } { path "/bar" } } }
103 { header H{ { "host" "www.sex.com:101" } } }
108 read-request-test-2' lf>crlf [
113 STRING: read-request-test-3
118 STRING: read-request-test-4
120 Host: "www.amazon.com"
125 read-request-test-4 lf>crlf [ read-request ] with-string-reader
129 STRING: read-response-test-1
130 HTTP/1.1 404 not found
131 Content-Type: text/html; charset=UTF-8
140 { message "not found" }
141 { header H{ { "content-type" "text/html; charset=UTF-8" } } }
143 { content-type "text/html" }
144 { content-charset "UTF-8" }
145 { content-encoding utf8 }
148 read-response-test-1 lf>crlf
149 [ read-response ] with-string-reader
153 STRING: read-response-test-1'
154 HTTP/1.1 404 not found
155 content-type: text/html; charset=UTF-8
160 read-response-test-1' 1array [
161 URL" http://localhost/" url set
162 read-response-test-1 lf>crlf
163 [ read-response ] with-string-reader
164 [ write-response ] with-string-writer
166 string-lines "\n" join
170 "rmid=732423sdfs73242; path=/; domain=.example.net; expires=Fri, 31-Dec-2010 23:59:59 GMT"
171 dup parse-set-cookie first unparse-set-cookie =
176 dup parse-set-cookie first unparse-set-cookie =
179 STRING: read-response-test-2
180 HTTP/1.1 200 Content follows
181 Set-Cookie: oo="bar; a=b"; httponly=yes; sid=123456
187 read-response-test-2 lf>crlf
188 [ read-response ] with-string-reader
192 STRING: read-response-test-3
193 HTTP/1.1 200 Content follows
194 Set-Cookie: oo="bar; a=b"; comment="your mom"; httponly=yes
200 read-response-test-3 lf>crlf
201 [ read-response ] with-string-reader
206 USING: http.server.static furnace.sessions furnace.alloy
207 furnace.actions furnace.auth furnace.auth.login furnace.db
208 io.servers.connection io.files io.files.temp io.directories io
210 http.server.responses http.server.redirection furnace.redirection
211 http.server.dispatchers db.tuples ;
213 : add-quit-action ( responder -- responder )
215 [ stop-this-server "Goodbye" "text/html" <content> ] >>display
216 "quit" add-responder ;
218 : test-db-file ( -- path ) "test.db" temp-file ;
220 : test-db ( -- db ) test-db-file <sqlite-db> ;
222 [ test-db-file delete-file ] ignore-errors
228 : test-httpd ( responder -- )
235 servers>> random addr>> port>>
236 ] with-scope "port" set ;
242 "vocab:http/test" <static> >>default
243 "nested" add-responder
245 [ URL" redirect-loop" <temporary-redirect> ] >>display
246 "redirect-loop" add-responder
251 : add-port ( url -- url' )
252 >url clone "port" get >>port ;
255 "vocab:http/test/foo.html" ascii file-contents
256 "http://localhost/nested/foo.html" add-port http-get nip =
259 [ "http://localhost/redirect-loop" add-port http-get nip ]
260 [ too-many-redirects? ] must-fail-with
263 "http://localhost/quit" add-port http-get nip
266 ! HTTP client redirect bug
270 <action> [ "quit" <temporary-redirect> ] >>display
271 "redirect" add-responder
277 "http://localhost/redirect" add-port http-get nip
282 [ "http://localhost/quit" add-port http-get 2drop ] ignore-errors
294 <action> "" add-responder
296 test-db <db-persistence>
301 : 404? ( response -- ? ) [ download-failed? ] [ response>> code>> 404 = ] bi and ;
303 ! This should give a 404 not an infinite redirect loop
304 [ "http://localhost/d/blah" add-port http-get nip ] [ 404? ] must-fail-with
306 ! This should give a 404 not an infinite redirect loop
307 [ "http://localhost/blah/" add-port http-get nip ] [ 404? ] must-fail-with
309 [ "Goodbye" ] [ "http://localhost/quit" add-port http-get nip ] unit-test
313 <action> [ [ "Hi" write ] "text/plain" <content> ] >>display
318 test-db <db-persistence>
323 [ "Hi" ] [ "http://localhost/" add-port http-get nip ] unit-test
325 [ "Goodbye" ] [ "http://localhost/quit" add-port http-get nip ] unit-test
327 USING: html.components html.forms
328 xml xml.traversal validators
329 furnace furnace.conversations ;
336 [ a get-global "a" set-value ] >>init
337 [ [ "<html>" write "a" <field> render "</html>" write ] "text/html" <content> ] >>display
338 [ { { "a" [ v-integer ] } } validate-params ] >>validate
339 [ "a" value a set-global URL" " <redirect> ] >>submit
344 test-db <db-persistence>
351 : test-a ( xml -- value )
352 string>xml body>> "input" deep-tag-named "value" attr ;
355 "http://localhost/" add-port http-get
356 swap dup cookies>> "cookies" set session-id-key get-cookie
357 value>> "session-id" set test-a
363 "http://localhost" add-port "__u" set
364 "session-id" get session-id-key set
366 "http://localhost/" add-port <post-request> "cookies" get >>cookies http-request nip test-a
369 [ 4 ] [ a get-global ] unit-test
375 "http://localhost" add-port "__u" set
376 "session-id" get session-id-key set
378 "http://localhost/" add-port <post-request> "cookies" get >>cookies http-request nip test-a
381 [ 4 ] [ a get-global ] unit-test
383 [ "Goodbye" ] [ "http://localhost/quit" add-port http-get nip ] unit-test
386 [ f ] [ <404> dup clone "b" "a" set-header drop "a" header ] unit-test
387 [ f ] [ <404> dup clone "b" "a" <cookie> put-cookie drop "a" get-cookie ] unit-test
390 [ "Basic QWxhZGRpbjpvcGVuIHNlc2FtZQ==" ] [ <request> "Aladdin" "open sesame" set-basic-auth "Authorization" header ] unit-test
392 ! Test a corner case with static responder
396 "vocab:http/test/foo.html" <static> >>default
401 "http://localhost/" add-port http-get nip
402 "vocab:http/test/foo.html" ascii file-contents =
405 [ ] [ "http://localhost/quit" add-port http-get 2drop ] unit-test
407 ! Check behavior of 307 redirect (reported by Chris Double)
412 [ "b" <temporary-redirect> ] >>submit
416 request get post-data>> data>> "data" =
417 [ "OK" "text/plain" <content> ] [ "OOPS" throw ] if
423 [ "OK" ] [ "data" "http://localhost/a" add-port http-post nip ] unit-test
425 ! Check that download throws errors (reported by Chris Double)
428 "http://localhost/tweet_my_twat" add-port download
432 [ ] [ "http://localhost/quit" add-port http-get 2drop ] unit-test