]> gitweb.factorcode.org Git - factor.git/commitdiff
http: change client/server to support LF and CRLF delimited headers.
authorJohn Benediktsson <mrjbq7@gmail.com>
Wed, 12 Oct 2011 19:51:49 +0000 (12:51 -0700)
committerJohn Benediktsson <mrjbq7@gmail.com>
Wed, 12 Oct 2011 19:51:49 +0000 (12:51 -0700)
basis/http/client/client-tests.factor
basis/http/client/client.factor
basis/http/http.factor
basis/http/server/server-tests.factor
basis/http/server/server.factor

index 515189fbe38929cc76b695805373bf575c65c16e..0b2120d31abbeb6f8e45e213222ebcb6af0bf818 100644 (file)
@@ -1,5 +1,5 @@
-USING: accessors http.client http.client.private http tools.test
-namespaces urls ;
+USING: accessors http.client http.client.private http
+io.streams.string kernel namespaces sequences tools.test urls ;
 IN: http.client.tests
 
 [ "localhost" f ] [ "localhost" parse-host ] unit-test
@@ -43,3 +43,13 @@ IN: http.client.tests
 [ "TRACE" ] [ "http://concatenative.org" <trace-request> method>> ] unit-test
 [ "OPTIONS" ] [ "http://factorcode.org" <options-request> method>> ] unit-test
 
+[ t ] [
+    {
+        "HTTP/1.1 200 Document follows"
+        "connection: close"
+        "content-type: text/html; charset=UTF-8"
+        "date: Wed, 12 Oct 2011 18:57:49 GMT"
+        "server: Factor http.server"
+    } [ "\n" join ] [ "\r\n" join ] bi
+    [ [ read-response ] with-string-reader ] bi@ =
+] unit-test
index 4925f571012881d501db9e2bba89728e1e103281..86972626b7775fb416a459dda02dbc3200dc5930 100644 (file)
@@ -56,7 +56,7 @@ ERROR: too-many-redirects ;
     drop ;
 
 : read-response-line ( response -- response )
-    read-crlf parse-response-line first3
+    read-?crlf parse-response-line first3
     [ >>version ] [ >>code ] [ >>message ] tri* ;
 
 : detect-encoding ( response -- encoding )
@@ -98,14 +98,14 @@ SYMBOL: redirects
     ] [ too-many-redirects ] if ; inline recursive
 
 : read-chunk-size ( -- n )
-    read-crlf ";" split1 drop [ blank? ] trim-tail
+    read-?crlf ";" split1 drop [ blank? ] trim-tail
     hex> [ "Bad chunk size" throw ] unless* ;
 
 : read-chunked ( quot: ( chunk -- ) -- )
     read-chunk-size dup zero?
     [ 2drop ] [
         read [ swap call ] [ drop ] 2bi
-        read-crlf B{ } assert= read-chunked
+        read-?crlf B{ } assert= read-chunked
     ] if ; inline recursive
 
 : read-response-body ( quot response -- )
index 4efec508763218f19d9c148a02ea6244858fcda6..f7492d1a23597be5ca7512e984a1b6adec1e23b2 100644 (file)
@@ -11,7 +11,7 @@ IN: http
 CONSTANT: max-redirects 10
 
 : (read-header) ( -- alist )
-    [ read-crlf dup f like ] [ parse-header-line ] produce nip ;
+    [ read-?crlf dup f like ] [ parse-header-line ] produce nip ;
 
 : collect-headers ( assoc -- assoc' )
     H{ } clone [ '[ _ push-at ] assoc-each ] keep ;
index 00e8710c7067d97c53e93342734e6030e5eeabe6..f47662bc90b839055e91822fce73c50fab281e5a 100644 (file)
@@ -1,5 +1,6 @@
-USING: http http.server math sequences continuations tools.test
-io.encodings.utf8 io.encodings.binary accessors ;
+USING: accessors continuations http http.server
+io.encodings.utf8 io.encodings.binary io.streams.string kernel
+math sequences tools.test ;
 IN: http.server.tests
 
 [ t ] [ [ \ + first ] [ <500> ] recover response? ] unit-test
@@ -26,4 +27,14 @@ IN: http.server.tests
 [ "application/octet-stream" ] [
     <response>
     unparse-content-type
-] unit-test
\ No newline at end of file
+] unit-test
+
+[ t ] [
+    {
+        "GET / HTTP/1.1"
+        "connection: close"
+        "host: 127.0.0.1:55532"
+        "user-agent: Factor http.client"
+    } [ "\n" join ] [ "\r\n" join ] bi
+    [ [ read-request ] with-string-reader ] bi@ =
+] unit-test
index c5bc88f81f840724845d370708157246488fb3d6..3f129fecdc7d39c39ac666eba30a67973a52af1a 100644 (file)
@@ -37,7 +37,7 @@ IN: http.server
     dup path>> "/" head? [ "Bad request: URL" throw ] unless ; inline
 
 : read-request-line ( request -- request )
-    read-crlf parse-request-line first3
+    read-?crlf parse-request-line first3
     [ >>method ] [ >url check-absolute >>url ] [ >>version ] tri* ;
 
 : read-request-header ( request -- request )