diff --git a/basis/http/client/client.factor b/basis/http/client/client.factor index 496754ba77..69e84001be 100644 --- a/basis/http/client/client.factor +++ b/basis/http/client/client.factor @@ -1,13 +1,14 @@ ! Copyright (C) 2005, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: assocs kernel math math.parser namespaces make -sequences strings splitting calendar continuations accessors vectors -math.order hashtables byte-arrays destructors -io io.sockets io.streams.string io.files io.timeouts -io.pathnames io.encodings io.encodings.string io.encodings.ascii -io.encodings.utf8 io.encodings.binary io.encodings.iana io.crlf -io.streams.duplex fry ascii urls urls.encoding present locals -http http.parsers http.client.post-data mime.types ; +USING: assocs combinators.short-circuit kernel math math.parser +namespaces make sequences strings splitting calendar +continuations accessors vectors math.order hashtables +byte-arrays destructors io io.sockets io.streams.string io.files +io.timeouts io.pathnames io.encodings io.encodings.string +io.encodings.ascii io.encodings.utf8 io.encodings.binary +io.encodings.iana io.crlf io.streams.duplex fry ascii urls +urls.encoding present locals http http.parsers +http.client.post-data mime.types ; IN: http.client ERROR: too-many-redirects ; @@ -21,8 +22,19 @@ ERROR: too-many-redirects ; [ "HTTP/" write version>> write crlf ] tri ; +: default-port? ( url -- ? ) + { + [ port>> not ] + [ [ port>> ] [ protocol>> protocol-port ] bi = ] + } 1|| ; + +: unparse-host ( url -- string ) + dup default-port? [ host>> ] [ + [ host>> ] [ port>> number>string ] bi ":" glue + ] if ; + : set-host-header ( request header -- request header ) - over url>> host>> "host" pick set-at ; + over url>> unparse-host "host" pick set-at ; : set-cookie-header ( header cookies -- header ) unparse-cookie "cookie" pick set-at ; diff --git a/basis/http/http-tests.factor b/basis/http/http-tests.factor index 0c396ff4e9..8bbc72257d 100644 --- a/basis/http/http-tests.factor +++ b/basis/http/http-tests.factor @@ -14,6 +14,15 @@ IN: http.tests [ "application/octet-stream" f ] [ "application/octet-stream" parse-content-type ] unit-test +[ "localhost" f ] [ "localhost" parse-host ] unit-test +[ "localhost" 8888 ] [ "localhost:8888" parse-host ] unit-test + +[ "localhost" ] [ T{ url { protocol "http" } { host "localhost" } } unparse-host ] unit-test +[ "localhost" ] [ T{ url { protocol "http" } { host "localhost" } { port 80 } } unparse-host ] unit-test +[ "localhost" ] [ T{ url { protocol "https" } { host "localhost" } { port 443 } } unparse-host ] unit-test +[ "localhost:8080" ] [ T{ url { protocol "http" } { host "localhost" } { port 8080 } } unparse-host ] unit-test +[ "localhost:8443" ] [ T{ url { protocol "https" } { host "localhost" } { port 8443 } } unparse-host ] unit-test + : lf>crlf ( string -- string' ) "\n" split "\r\n" join ; STRING: read-request-test-1 @@ -80,15 +89,32 @@ Host: www.sex.com ] with-string-reader ] unit-test +STRING: read-request-test-2' +HEAD /bar HTTP/1.1 +Host: www.sex.com:101 + +; + +[ + T{ request + { url T{ url { host "www.sex.com" } { port 101 } { path "/bar" } } } + { method "HEAD" } + { version "1.1" } + { header H{ { "host" "www.sex.com:101" } } } + { cookies V{ } } + { redirects 10 } + } +] [ + read-request-test-2' lf>crlf [ + read-request + ] with-string-reader +] unit-test + STRING: read-request-test-3 GET nested HTTP/1.0 ; -[ read-request-test-3 lf>crlf [ read-request ] with-string-reader ] -[ "Bad request: URL" = ] -must-fail-with - STRING: read-request-test-4 GET /blah HTTP/1.0 Host: "www.amazon.com" diff --git a/basis/http/server/server.factor b/basis/http/server/server.factor index 942142883a..ca838cb7fb 100644 --- a/basis/http/server/server.factor +++ b/basis/http/server/server.factor @@ -75,8 +75,9 @@ SYMBOL: upload-limit ] when ; : extract-host ( request -- request ) - [ ] [ url>> ] [ "host" header dup [ url-decode ] when ] tri - >>host drop ; + [ ] [ url>> ] [ "host" header parse-host ] tri + [ >>host ] [ >>port ] bi* + drop ; : extract-cookies ( request -- request ) dup "cookie" header [ parse-cookie >>cookies ] when* ;