http.server.requests: refactor the http.server vocabs request handling into its own vocab

basis/furnace/actions/actions-tests.factor

@@ -1,6 +1,6 @@
-USING: kernel furnace.actions validators
+USING: kernel furnace.actions validators tools.test math math.parser
-tools.test math math.parser multiline namespaces http
+multiline namespaces http io.streams.string http.server http.server.requests
-io.streams.string http.server sequences splitting accessors ;
+sequences splitting accessors ;
 IN: furnace.actions.tests
 
 <action>

basis/http/http-tests.factor

@@ -1,7 +1,7 @@
-USING: destructors http http.server http.client http.client.private tools.test
+USING: destructors http http.server http.server.requests http.client
-multiline fry io.streams.string io.encodings.utf8 io.encodings.8-bit
+http.client.private tools.test multiline fry io.streams.string io.encodings.utf8
-io.encodings.binary io.encodings.string io.encodings.ascii kernel
+io.encodings.8-bit io.encodings.binary io.encodings.string io.encodings.ascii
-arrays splitting sequences assocs io.sockets db db.sqlite make
+kernel arrays splitting sequences assocs io.sockets db db.sqlite make
 continuations urls hashtables accessors namespaces xml.data
 io.encodings.8-bit.latin1 random combinators.short-circuit ;
 IN: http.tests

basis/http/server/requests/requests-docs.factor

@@ -0,0 +1,11 @@
+USING: help.markup help.syntax http io ;
+IN: http.server.requests
+
+HELP: read-request
+{ $values { "request" request } }
+{ $description "Reads a HTTP requests from the input stream." } ;
+
+ARTICLE: "http.server.requests" "Deserializing HTTP requests"
+"The " { $vocab-link "http.server.requests" } " reads requests from the " { $link input-stream } " and creates " { $link request } " tuples." ;
+
+ABOUT: "http.server.requests"

basis/http/server/requests/requests-tests.factor

@@ -0,0 +1,63 @@
+USING: accessors assocs http http.server.requests io.streams.string kernel
+sequences tools.test urls ;
+IN: http.server.requests.tests
+
+! content-length in combination with POST
+{ "foo=bar" "7" } [
+    {
+        "POST / HTTP/1.1"
+        "connection: close"
+        "host: 127.0.0.1:55532"
+        "user-agent: Factor http.client"
+        "content-length: 7"
+        ""
+        "foo=bar"
+    } "\n" join [ read-request ] with-string-reader
+    [ post-data>> data>> ] [ header>> "content-length" of ] bi
+] unit-test
+
+{ f "0" } [
+    {
+        "POST / HTTP/1.1"
+        "connection: close"
+        "host: 127.0.0.1:55532"
+        "user-agent: Factor http.client"
+        "content-length: 0"
+        ""
+        ""
+    } "\n" join [ read-request ] with-string-reader
+    [ post-data>> data>> ] [ header>> "content-length" of ] bi
+] unit-test
+
+! RFC 2616: Section 4.1
+! In the interest of robustness, servers SHOULD ignore any empty
+! line(s) received where a Request-Line is expected. In other words, if
+! the server is reading the protocol stream at the beginning of a
+! message and receives a CRLF first, it should ignore the CRLF.
+[
+    T{ request
+        { method "GET" }
+        { url URL" /" }
+        { version "1.0" }
+        { header H{ } }
+        { cookies V{ } }
+        { redirects 10 }
+    }
+] [
+    "\r\n\r\n\r\nGET / HTTP/1.0\r\n\r\n"
+    [ read-request ] with-string-reader
+] unit-test
+
+! RFC 2616: Section 19.3
+! The line terminator for message-header fields is the sequence CRLF.
+! However, we recommend that applications, when parsing such headers,
+! recognize a single LF as a line terminator and ignore the leading CR.
+[ 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 ] same?
+] unit-test

basis/http/server/requests/requests.factor

@@ -0,0 +1,66 @@
+USING: accessors combinators http http.parsers io io.crlf io.encodings
+io.encodings.binary io.streams.limited kernel math.order math.parser
+namespaces sequences splitting urls urls.encoding ;
+FROM: mime.multipart => parse-multipart ;
+IN: http.server.requests
+
+ERROR: no-boundary ;
+
+: check-absolute ( url -- url )
+    dup path>> "/" head? [ "Bad request: URL" throw ] unless ; inline
+
+: read-request-line ( request -- request )
+    read-?crlf [ dup "" = ] [ drop read-?crlf ] while
+    parse-request-line first3
+    [ >>method ] [ >url check-absolute >>url ] [ >>version ] tri* ;
+
+: read-request-header ( request -- request )
+    read-header >>header ;
+
+SYMBOL: upload-limit
+
+upload-limit [ 200,000,000 ] initialize
+
+: parse-multipart-form-data ( string -- separator )
+    ";" split1 nip
+    "=" split1 nip [ no-boundary ] unless* ;
+
+: read-multipart-data ( request -- mime-parts )
+    [ "content-type" header ]
+    [ "content-length" header string>number ] bi
+    unlimited-input
+    upload-limit get [ min ] when* limited-input
+    binary decode-input
+    parse-multipart-form-data parse-multipart ;
+
+: read-content ( request -- bytes )
+    "content-length" header string>number read ;
+
+: parse-content ( request content-type -- post-data )
+    [ <post-data> swap ] keep {
+        { "multipart/form-data" [ read-multipart-data >>params ] }
+        { "application/x-www-form-urlencoded" [ read-content query>assoc >>params ] }
+        [ drop read-content >>data ]
+    } case ;
+
+: read-post-data ( request -- request )
+    dup method>> "POST" = [
+        dup dup "content-type" header
+        ";" split1 drop parse-content >>post-data
+    ] when ;
+
+: extract-host ( request -- request )
+    [ ] [ url>> ] [ "host" header parse-host ] tri
+    [ >>host ] [ >>port ] bi*
+    drop ;
+
+: extract-cookies ( request -- request )
+    dup "cookie" header [ parse-cookie >>cookies ] when* ;
+
+: read-request ( -- request )
+    <request>
+    read-request-line
+    read-request-header
+    read-post-data
+    extract-host
+    extract-cookies ;

basis/http/server/server-tests.factor

@@ -1,4 +1,4 @@
-USING: accessors continuations http http.server
+USING: accessors assocs continuations http http.server
 io.encodings.utf8 io.encodings.binary io.streams.string kernel
 math peg sequences tools.test urls ;
 IN: http.server.tests
@@ -29,7 +29,6 @@ IN: http.server.tests
     unparse-content-type
 ] unit-test
 
-
 ! RFC 2616: Section 19.3
 ! The line terminator for message-header fields is the sequence CRLF.
 ! However, we recommend that applications, when parsing such headers,

basis/http/server/server.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel accessors sequences arrays namespaces splitting
 vocabs.loader destructors assocs debugger continuations
-combinators combinators.short-circuit vocabs.refresh tools.time math math.parser
+combinators combinators.short-circuit vocabs.refresh tools.time math
 present vectors hashtables
 io
 io.sockets
@@ -18,10 +18,10 @@ io.streams.throwing
 io.servers
 io.timeouts
 io.crlf
-fry logging logging.insomniac calendar urls urls.encoding
+fry logging logging.insomniac calendar urls
 unicode.categories
 http
-http.parsers
+http.server.requests
 http.server.responses
 http.server.remapping
 html.templates
@@ -32,74 +32,8 @@ math.order
 peg
 xml.writer
 vocabs ;
-FROM: mime.multipart => parse-multipart ;
 IN: http.server
 
-: check-absolute ( url -- url )
-    dup path>> "/" head? [ "Bad request: URL" throw ] unless ; inline
-
-: read-request-line ( request -- request )
-    read-?crlf [ dup "" = ] [ drop read-?crlf ] while
-    parse-request-line first3
-    [ >>method ] [ >url check-absolute >>url ] [ >>version ] tri* ;
-
-: read-request-header ( request -- request )
-    read-header >>header ;
-
-ERROR: no-boundary ;
-
-: parse-multipart-form-data ( string -- separator )
-    ";" split1 nip
-    "=" split1 nip [ no-boundary ] unless* ;
-
-SYMBOL: request-limit
-
-request-limit [ 64 1024 * ] initialize
-
-SYMBOL: upload-limit
-
-upload-limit [ 200,000,000 ] initialize
-
-: read-multipart-data ( request -- mime-parts )
-    [ "content-type" header ]
-    [ "content-length" header string>number ] bi
-    unlimited-input
-    upload-limit get [ min ] when* limited-input
-    binary decode-input
-    parse-multipart-form-data parse-multipart ;
-
-: read-content ( request -- bytes )
-    "content-length" header string>number read ;
-
-: parse-content ( request content-type -- post-data )
-    [ <post-data> swap ] keep {
-        { "multipart/form-data" [ read-multipart-data >>params ] }
-        { "application/x-www-form-urlencoded" [ read-content query>assoc >>params ] }
-        [ drop read-content >>data ]
-    } case ;
-
-: read-post-data ( request -- request )
-    dup method>> "POST" = [
-        dup dup "content-type" header
-        ";" split1 drop parse-content >>post-data
-    ] when ;
-
-: extract-host ( request -- request )
-    [ ] [ url>> ] [ "host" header parse-host ] tri
-    [ >>host ] [ >>port ] bi*
-    drop ;
-
-: extract-cookies ( request -- request )
-    dup "cookie" header [ parse-cookie >>cookies ] when* ;
-
-: read-request ( -- request )
-    <request>
-    read-request-line
-    read-request-header
-    read-post-data
-    extract-host
-    extract-cookies ;
-
 GENERIC: write-response ( response -- )
 
 GENERIC: write-full-response ( request response -- )
@@ -286,6 +220,10 @@ LOG: httpd-benchmark DEBUG
 
 TUPLE: http-server < threaded-server ;
 
+SYMBOL: request-limit
+
+request-limit [ 64 1024 * ] initialize
+
 : handle-client-error ( error -- )
     dup { [ parse-error? ] [ got>> empty? ] } 1&& [ drop ] [ rethrow ] if ;