http: turns out we do need to handle port number in host header, and client needs to send it but only for non-default ports, since sending it for the default port breaks Twitter's HTTP server (reported by John Benediktsson)

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 ;

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"

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* ;