From 32f447d7960d960dc1c2e5c53f1bcc46f6b55294 Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Sun, 3 Oct 2010 03:39:30 -0500
Subject: [PATCH] Since ip4/ip6 services can run on different ports, we must
 include which version of ip we're using instead of just a port.  Make URL
 objects store an inet4/i nt6/inet object with host/port slots instead of
 storing host/port slots separately. Stricter error checking on inet4/inet6
 tuple creation.  Update lots of code related to the URL change.

---
 .../distributed/distributed-tests.factor      |  2 +-
 basis/ftp/client/client.factor                |  4 +-
 basis/ftp/server/server-tests.factor          |  6 +-
 basis/furnace/utilities/utilities.factor      |  6 +-
 basis/http/client/client-tests.factor         |  6 +-
 basis/http/client/client.factor               | 10 +--
 basis/http/http-tests.factor                  | 65 ++++++++--------
 .../redirection/redirection-tests.factor      |  6 +-
 .../server/remapping/remapping-docs.factor    |  2 +-
 basis/http/server/remapping/remapping.factor  |  6 +-
 basis/http/server/server.factor               | 12 ++-
 basis/io/servers/servers-docs.factor          | 12 +--
 basis/io/servers/servers-tests.factor         |  2 +-
 basis/io/servers/servers.factor               | 22 ++----
 basis/io/sockets/sockets-docs.factor          | 10 +--
 basis/io/sockets/sockets-tests.factor         | 14 +++-
 basis/io/sockets/sockets.factor               | 46 ++++++++---
 basis/urls/urls-docs.factor                   |  8 +-
 basis/urls/urls-tests.factor                  | 46 +++++------
 basis/urls/urls.factor                        | 76 ++++++++++---------
 20 files changed, 192 insertions(+), 169 deletions(-)

diff --git a/basis/concurrency/distributed/distributed-tests.factor b/basis/concurrency/distributed/distributed-tests.factor
index ebe5bc5da2..c0ae33150e 100644
--- a/basis/concurrency/distributed/distributed-tests.factor
+++ b/basis/concurrency/distributed/distributed-tests.factor
@@ -16,7 +16,7 @@ CONSTANT: test-ip "127.0.0.1"
 : test-node-client ( -- addrspec )
     {
         { [ os unix? ] [ "distributed-concurrency-test" temp-file <local> ] }
-        { [ os windows? ] [ test-ip insecure-port <inet4> ] }
+        { [ os windows? ] [ insecure-addr ] }
     } cond ;
 
     
diff --git a/basis/ftp/client/client.factor b/basis/ftp/client/client.factor
index 9d51ba259e..47f5e23ab9 100644
--- a/basis/ftp/client/client.factor
+++ b/basis/ftp/client/client.factor
@@ -61,7 +61,7 @@ ERROR: ftp-error got expected ;
     strings>> first "|" split 2 tail* first string>number ;
 
 : open-passive-client ( url protocol -- stream )
-    [ host>> ftp-epsv parse-epsv <inet> ] dip <client> drop ;
+    [ addr>> ftp-epsv parse-epsv with-port ] dip <client> drop ;
 
 : list ( url -- ftp-response )
     utf8 open-passive-client
@@ -84,7 +84,7 @@ ERROR: ftp-error got expected ;
     ftp-set-binary 200 ftp-assert ;
 
 : ftp-connect ( url -- stream )
-    [ host>> ] [ port>> ] bi <inet> utf8 <client> drop ;
+    addr>> utf8 <client> drop ;
 
 : with-ftp-client ( url quot -- )
     [ [ ftp-connect ] keep ] dip
diff --git a/basis/ftp/server/server-tests.factor b/basis/ftp/server/server-tests.factor
index fa6afa30cc..458c92a8a1 100644
--- a/basis/ftp/server/server-tests.factor
+++ b/basis/ftp/server/server-tests.factor
@@ -17,11 +17,9 @@ CONSTANT: test-file-contents "Files are so boring anymore."
     '[
         current-temporary-directory get
         0 <ftp-server> [
-            insecure-port
-            <url>
-                swap >>port
+            insecure-addr
+            >url
                 "ftp" >>protocol
-                "localhost" >>host
                 create-test-file >>path
                 @
         ] with-threaded-server
diff --git a/basis/furnace/utilities/utilities.factor b/basis/furnace/utilities/utilities.factor
index 94762d7591..154dbe36f2 100644
--- a/basis/furnace/utilities/utilities.factor
+++ b/basis/furnace/utilities/utilities.factor
@@ -96,7 +96,7 @@ CONSTANT: nested-forms-key "__n"
 : referrer ( -- referrer/f )
     #! Typo is intentional, it's in the HTTP spec!
     "referer" request get header>> at
-    dup [ >url ensure-port [ remap-port ] change-port ] when ;
+    dup [ >url ensure-port [ remap-addr ] change-addr ] when ;
 
 : user-agent ( -- user-agent )
     "user-agent" request get header>> at "" or ;
@@ -105,9 +105,7 @@ CONSTANT: nested-forms-key "__n"
     dup [
         url get [
             [ protocol>> ]
-            [ host>> ]
-            [ port>> remap-port ]
-            tri 3array
+            [ addr>> remap-addr ] bi 2array
         ] bi@ =
     ] when ;
 
diff --git a/basis/http/client/client-tests.factor b/basis/http/client/client-tests.factor
index 7a7fcffc74..2dda877a01 100644
--- a/basis/http/client/client-tests.factor
+++ b/basis/http/client/client-tests.factor
@@ -1,5 +1,5 @@
 USING: http.client http.client.private http tools.test
-namespaces urls ;
+namespaces urls io.sockets ;
 IN: http.client.tests
 
 [ "localhost" f ] [ "localhost" parse-host ] unit-test
@@ -12,7 +12,7 @@ IN: http.client.tests
 
 [
     T{ request
-        { url T{ url { protocol "http" } { host "www.apple.com" } { port 80 } { path "/index.html" } } }
+        { url T{ url { protocol "http" } { addr T{ inet f "www.apple.com" 80 } } { path "/index.html" } } }
         { method "GET" }
         { version "1.1" }
         { cookies V{ } }
@@ -26,7 +26,7 @@ IN: http.client.tests
 
 [
     T{ request
-        { url T{ url { protocol "https" } { host "www.amazon.com" } { port 443 } { path "/index.html" } } }
+        { url T{ url { protocol "https" } { addr T{ inet f "www.amazon.com" 443 } } { path "/index.html" } } }
         { method "GET" }
         { version "1.1" }
         { cookies V{ } }
diff --git a/basis/http/client/client.factor b/basis/http/client/client.factor
index 69e84001be..b1aa0e963c 100644
--- a/basis/http/client/client.factor
+++ b/basis/http/client/client.factor
@@ -24,13 +24,13 @@ ERROR: too-many-redirects ;
 
 : default-port? ( url -- ? )
     {
-        [ port>> not ]
-        [ [ port>> ] [ protocol>> protocol-port ] bi = ]
+        [ addr>> port>> not ]
+        [ [ addr>> port>> ] [ protocol>> protocol-port ] bi = ]
     } 1|| ;
 
 : unparse-host ( url -- string )
-    dup default-port? [ host>> ] [
-        [ host>> ] [ port>> number>string ] bi ":" glue
+    dup default-port? [ addr>> host>> ] [
+        [ addr>> host>> ] [ addr>> port>> number>string ] bi ":" glue
     ] if ;
 
 : set-host-header ( request header -- request header )
@@ -41,7 +41,7 @@ ERROR: too-many-redirects ;
 
 : write-request-header ( request -- request )
     dup header>> >hashtable
-    over url>> host>> [ set-host-header ] when
+    over url>> addr>> host>> [ set-host-header ] when
     over post-data>> [ set-post-data-headers ] when*
     over cookies>> [ set-cookie-header ] unless-empty
     write-header ;
diff --git a/basis/http/http-tests.factor b/basis/http/http-tests.factor
index ed146d98de..13e369d863 100644
--- a/basis/http/http-tests.factor
+++ b/basis/http/http-tests.factor
@@ -17,11 +17,11 @@ IN: http.tests
 [ "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
+[ "localhost" ] [ T{ url { protocol "http" } { addr T{ inet f "localhost" } } } unparse-host ] unit-test
+[ "localhost" ] [ T{ url { protocol "http" } { addr T{ inet f "localhost" 80 } } } unparse-host ] unit-test
+[ "localhost" ] [ T{ url { protocol "https" } { addr T{ inet f "localhost" 443 } } } unparse-host ] unit-test
+[ "localhost:8080" ] [ T{ url { protocol "http" } { addr T{ inet f "localhost" 8080 } } } unparse-host ] unit-test
+[ "localhost:8443" ] [ T{ url { protocol "https" } { addr T{ inet f "localhost" 8443 } } } unparse-host ] unit-test
 
 : lf>crlf ( string -- string' ) "\n" split "\r\n" join ;
 
@@ -37,7 +37,7 @@ blah
 
 [
     T{ request
-        { url T{ url { path "/bar" } } }
+        { url T{ url { path "/bar" } { addr T{ inet } } } }
         { method "POST" }
         { version "1.1" }
         { header H{ { "some-header" "1; 2" } { "content-length" "4" } { "content-type" "application/octet-stream" } } }
@@ -76,7 +76,7 @@ Host: www.sex.com
 
 [
     T{ request
-        { url T{ url { host "www.sex.com" } { path "/bar" } } }
+        { url T{ url { addr T{ inet f "www.sex.com" } } { path "/bar" } } }
         { method "HEAD" }
         { version "1.1" }
         { header H{ { "host" "www.sex.com" } } }
@@ -97,7 +97,7 @@ Host: www.sex.com:101
 
 [
     T{ request
-        { url T{ url { host "www.sex.com" } { port 101 } { path "/bar" } } }
+        { url T{ url { addr T{ inet f "www.sex.com" 101 } } { path "/bar" } } }
         { method "HEAD" }
         { version "1.1" }
         { header H{ { "host" "www.sex.com:101" } } }
@@ -232,14 +232,14 @@ test-db [
             0 >>insecure
             f >>secure
         start-server
-        servers>> random addr>> port>>
-    ] with-scope "port" set ;
+        servers>> random addr>>
+    ] with-scope "addr" set ;
 
-: add-port ( url -- url' )
-    >url clone "port" get >>port ;
+: add-addr ( url -- url' )
+    >url clone "addr" get >>addr ;
 
 : stop-test-httpd ( -- )
-    "http://localhost/quit" add-port http-get nip
+    "http://localhost/quit" add-addr http-get nip
     "Goodbye" assert= ;
 
 [ ] [
@@ -257,14 +257,14 @@ test-db [
 
 [ t ] [
     "vocab:http/test/foo.html" ascii file-contents
-    "http://localhost/nested/foo.html" add-port http-get nip =
+    "http://localhost/nested/foo.html" add-addr http-get nip =
 ] unit-test
 
-[ "http://localhost/redirect-loop" add-port http-get nip ]
+[ "http://localhost/redirect-loop" add-addr http-get nip ]
 [ too-many-redirects? ] must-fail-with
 
 [ "Goodbye" ] [
-    "http://localhost/quit" add-port http-get nip
+    "http://localhost/quit" add-addr http-get nip
 ] unit-test
 
 ! HTTP client redirect bug
@@ -278,10 +278,9 @@ test-db [
 ] unit-test
 
 [ "Goodbye" ] [
-    "http://localhost/redirect" add-port http-get nip
+    "http://localhost/redirect" add-addr http-get nip
 ] unit-test
 
-
 [ ] [
     [ stop-test-httpd ] ignore-errors
 ] unit-test
@@ -305,12 +304,12 @@ test-db [
 : 404? ( response -- ? ) [ download-failed? ] [ response>> code>> 404 = ] bi and ;
 
 ! This should give a 404 not an infinite redirect loop
-[ "http://localhost/d/blah" add-port http-get nip ] [ 404? ] must-fail-with
+[ "http://localhost/d/blah" add-addr http-get nip ] [ 404? ] must-fail-with
 
 ! This should give a 404 not an infinite redirect loop
-[ "http://localhost/blah/" add-port http-get nip ] [ 404? ] must-fail-with
+[ "http://localhost/blah/" add-addr http-get nip ] [ 404? ] must-fail-with
 
-[ "Goodbye" ] [ "http://localhost/quit" add-port http-get nip ] unit-test
+[ "Goodbye" ] [ "http://localhost/quit" add-addr http-get nip ] unit-test
 
 [ ] [
     <dispatcher>
@@ -324,9 +323,9 @@ test-db [
     test-httpd
 ] unit-test
 
-[ "Hi" ] [ "http://localhost/" add-port http-get nip ] unit-test
+[ "Hi" ] [ "http://localhost/" add-addr http-get nip ] unit-test
 
-[ "Goodbye" ] [ "http://localhost/quit" add-port http-get nip ] unit-test
+[ "Goodbye" ] [ "http://localhost/quit" add-addr http-get nip ] unit-test
 
 USING: html.components html.forms
 xml xml.traversal validators
@@ -356,7 +355,7 @@ SYMBOL: a
     string>xml body>> "input" deep-tag-named "value" attr ;
 
 [ "3" ] [
-    "http://localhost/" add-port http-get
+    "http://localhost/" add-addr http-get
     swap dup cookies>> "cookies" set session-id-key get-cookie
     value>> "session-id" set test-a
 ] unit-test
@@ -364,10 +363,10 @@ SYMBOL: a
 [ "4" ] [
     [
         "4" "a" set
-        "http://localhost" add-port "__u" set
+        "http://localhost" add-addr "__u" set
         "session-id" get session-id-key set
     ] H{ } make-assoc
-    "http://localhost/" add-port <post-request> "cookies" get >>cookies http-request nip test-a
+    "http://localhost/" add-addr <post-request> "cookies" get >>cookies http-request nip test-a
 ] unit-test
 
 [ 4 ] [ a get-global ] unit-test
@@ -376,15 +375,15 @@ SYMBOL: a
 [ "xyz" ] [
     [
         "xyz" "a" set
-        "http://localhost" add-port "__u" set
+        "http://localhost" add-addr "__u" set
         "session-id" get session-id-key set
     ] H{ } make-assoc
-    "http://localhost/" add-port <post-request> "cookies" get >>cookies http-request nip test-a
+    "http://localhost/" add-addr <post-request> "cookies" get >>cookies http-request nip test-a
 ] unit-test
 
 [ 4 ] [ a get-global ] unit-test
 
-[ "Goodbye" ] [ "http://localhost/quit" add-port http-get nip ] unit-test
+[ "Goodbye" ] [ "http://localhost/quit" add-addr http-get nip ] unit-test
 
 ! Test cloning
 [ f ] [ <404> dup clone "b" "a" set-header drop "a" header ] unit-test
@@ -402,7 +401,7 @@ SYMBOL: a
 ] unit-test
 
 [ t ] [
-    "http://localhost/" add-port http-get nip
+    "http://localhost/" add-addr http-get nip
     "vocab:http/test/foo.html" ascii file-contents =
 ] unit-test
 
@@ -424,12 +423,12 @@ SYMBOL: a
     test-httpd
 ] unit-test
 
-[ "OK" ] [ "data" "http://localhost/a" add-port http-post nip ] unit-test
+[ "OK" ] [ "data" "http://localhost/a" add-addr http-post nip ] unit-test
 
 ! Check that download throws errors (reported by Chris Double)
 [
     "resource:temp" [
-        "http://localhost/tweet_my_twat" add-port download
+        "http://localhost/tweet_my_twat" add-addr download
     ] with-directory
 ] must-fail
 
@@ -443,6 +442,6 @@ SYMBOL: a
     test-httpd
 ] unit-test
 
-[ "OK\n\n" ] [ "http://localhost/" add-port http-get nip ] unit-test
+[ "OK\n\n" ] [ "http://localhost/" add-addr http-get nip ] unit-test
 
 [ ] [ stop-test-httpd ] unit-test
diff --git a/basis/http/server/redirection/redirection-tests.factor b/basis/http/server/redirection/redirection-tests.factor
index d502de75b0..34509386e1 100644
--- a/basis/http/server/redirection/redirection-tests.factor
+++ b/basis/http/server/redirection/redirection-tests.factor
@@ -1,12 +1,12 @@
-USING: http http.server.redirection urls accessors
-namespaces tools.test present kernel ;
+USING: accessors http http.server.redirection io.sockets kernel
+namespaces present tools.test urls ;
 IN: http.server.redirection.tests
 
 [
     <request>
         <url>
             "http" >>protocol
-            "www.apple.com" >>host
+            T{ inet f "www.apple.com" } >>addr
             "/xxx/bar" >>path
             { { "a" "b" } } >>query
         dup url set
diff --git a/basis/http/server/remapping/remapping-docs.factor b/basis/http/server/remapping/remapping-docs.factor
index 7531dbef85..4cebfb5bb3 100644
--- a/basis/http/server/remapping/remapping-docs.factor
+++ b/basis/http/server/remapping/remapping-docs.factor
@@ -18,7 +18,7 @@ $nl
 { $subsections port-remapping }
 "For example, with the above setup, we would set it as follows:"
 { $code
-    "{ { 8080 80 } { 8443 443 } } port-remapping set-global"
+    "{ { T{ inet4 f f 8080 } T{ inet4 f f 80 } } { T{ inet4 f f 8443 } T{ inet4 f f 443 } } } port-remapping set-global"
 } ;
 
 ABOUT: "http.server.remapping"
diff --git a/basis/http/server/remapping/remapping.factor b/basis/http/server/remapping/remapping.factor
index 6eed900acc..4eff340204 100644
--- a/basis/http/server/remapping/remapping.factor
+++ b/basis/http/server/remapping/remapping.factor
@@ -5,8 +5,8 @@ IN: http.server.remapping
 
 SYMBOL: port-remapping
 
-: remap-port ( n -- n' )
+: remap-addr ( addr -- addr' )
     [ port-remapping get at ] keep or ;
 
-: secure-http-port ( -- n )
-    secure-port remap-port ;
+: secure-http-port ( -- addr )
+    secure-addr remap-addr ;
diff --git a/basis/http/server/server.factor b/basis/http/server/server.factor
index c5bc88f81f..60c3cdc963 100644
--- a/basis/http/server/server.factor
+++ b/basis/http/server/server.factor
@@ -82,8 +82,7 @@ upload-limit [ 200,000,000 ] initialize
     ] when ;
 
 : extract-host ( request -- request )
-    [ ] [ url>> ] [ "host" header parse-host ] tri
-    [ >>host ] [ >>port ] bi*
+    [ ] [ url>> ] [ "host" header parse-host <inet> >>addr ] tri
     drop ;
 
 : extract-cookies ( request -- request )
@@ -116,7 +115,7 @@ GENERIC: write-full-response ( request response -- )
 
 : ensure-domain ( cookie -- cookie )
     [
-        url get host>> dup "localhost" =
+        url get addr>> host>> dup "localhost" =
         [ drop ] [ or ] if
     ] change-domain ;
 
@@ -251,13 +250,12 @@ SYMBOL: params
     [
         local-address get
         [ secure? "https" "http" ? >>protocol ]
-        [ port>> remap-port '[ _ or ] change-port ]
-        bi
+        [ remap-addr '[ _ or ] change-addr ] bi
     ] change-url drop ;
 
 : valid-request? ( request -- ? )
-    url>> port>> remap-port
-    local-address get port>> remap-port = ;
+    url>> addr>> remap-addr
+    local-address get remap-addr = ;
 
 : do-request ( request -- response )
     '[
diff --git a/basis/io/servers/servers-docs.factor b/basis/io/servers/servers-docs.factor
index 051dfad975..1add7abdef 100644
--- a/basis/io/servers/servers-docs.factor
+++ b/basis/io/servers/servers-docs.factor
@@ -76,8 +76,8 @@ ARTICLE: "io.servers" "Threaded servers"
 "From within the dynamic scope of a client handler, several words can be used to interact with the threaded server:"
 { $subsections
     stop-this-server
-    secure-port
-    insecure-port
+    secure-addr
+    insecure-addr
 }
 "Additionally, the " { $link local-address } " and "
 { $subsections remote-address } " variables are set, as in " { $link with-client } "." ;
@@ -125,12 +125,12 @@ HELP: with-threaded-server
 }
 { $description "Runs a server and calls a quotation, stopping the server once the quotation returns." } ;
 
-HELP: secure-port
-{ $values { "n/f" { $maybe integer } } }
+HELP: secure-addr
+{ $values { "inet/f" { $maybe inet } } }
 { $description "Outputs one of the port numbers on which the current threaded server accepts secure socket connections. Outputs " { $link f } " if the current threaded server does not accept secure socket connections." }
 { $notes "Can only be used from the dynamic scope of a " { $link handle-client* } " call." } ;
 
-HELP: insecure-port
-{ $values { "n/f" { $maybe integer } } }
+HELP: insecure-addr
+{ $values { "inet/f" { $maybe inet } } }
 { $description "Outputs one of the port numbers on which the current threaded server accepts ordinary socket connections. Outputs " { $link f } " if the current threaded server does not accept ordinary socket connections." }
 { $notes "Can only be used from the dynamic scope of a " { $link handle-client* } " call." } ;
diff --git a/basis/io/servers/servers-tests.factor b/basis/io/servers/servers-tests.factor
index bcba7f7d90..e081b655d3 100644
--- a/basis/io/servers/servers-tests.factor
+++ b/basis/io/servers/servers-tests.factor
@@ -34,7 +34,7 @@ IN: io.servers
         0 >>insecure
         [ "Hello world." write stop-this-server ] >>handler
     [
-        "localhost" insecure-port <inet> ascii <client> drop stream-contents
+        insecure-addr ascii <client> drop stream-contents
     ] with-threaded-server
 ] unit-test
 
diff --git a/basis/io/servers/servers.factor b/basis/io/servers/servers.factor
index 66d0112561..917d572c93 100644
--- a/basis/io/servers/servers.factor
+++ b/basis/io/servers/servers.factor
@@ -219,23 +219,13 @@ PRIVATE>
         [ ] cleanup
     ] call ; inline
 
-<PRIVATE
+: secure-addr ( -- inet/f )
+    threaded-server get servers>>
+    [ addr>> ] map [ secure? ] filter random ;
 
-: first-port ( quot -- n/f )
-    [ threaded-server get servers>> ] dip
-    filter [ f ] [ first addr>> port>> ] if-empty ; inline
-
-PRIVATE>
-
-: secure-port ( -- n/f ) [ addr>> secure? ] first-port ;
-
-: insecure-port ( -- n/f ) [ addr>> secure? not ] first-port ;
-
-: secure-addr ( -- inet )
-    threaded-server get servers>> [ addr>> secure? ] filter random ;
-
-: insecure-addr ( -- inet )
-    threaded-server get servers>> [ addr>> secure? not ] filter random addr>> ;
+: insecure-addr ( -- inet/f )
+    threaded-server get servers>>
+    [ addr>> ] map [ secure? not ] filter random ;
     
 : server. ( threaded-server -- )
     [ [ "=== " write name>> ] [ ] bi write-object nl ]
diff --git a/basis/io/sockets/sockets-docs.factor b/basis/io/sockets/sockets-docs.factor
index 95ad57a46d..afd0ae1c44 100644
--- a/basis/io/sockets/sockets-docs.factor
+++ b/basis/io/sockets/sockets-docs.factor
@@ -118,10 +118,10 @@ HELP: inet
 
 HELP: <inet>
 { $values { "host" "a host name" } { "port" "a port number" } { "inet" inet } }
-{ $description "Creates a new " { $link inet } " address specifier." } ;
+{ $description "Creates a new " { $link inet } " address specifier. If the host is an IPv4 address, an " { $link inet4 } " tuple will be returned; likewise for " { $link inet6 } "." } ;
 
 HELP: inet4
-{ $class-description "IPv4 address/port number specifier for TCP/IP and UDP/IP connections. The " { $snippet "host" } " and " { $snippet "port" } " slots hold the IPv4 address and port number, respectively. New instances are created by calling " { $link <inet4> } "." }
+{ $class-description "IPv4 address/port number specifier for TCP/IP and UDP/IP connections. The " { $snippet "host" } " and " { $snippet "port" } " slots hold the IPv4 address and port number, respectively. New instances are created by calling " { $link <inet4> } ". A host of " { $link f } " refers to localhost, and a port of " { $link f } " defers the port choice until later." }
 { $notes "Most applications do not operate on IPv4 addresses directly, and instead should use the " { $link inet } " address specifier, or call " { $link resolve-host } "." }
 { $examples
     { $code "\"127.0.0.1\" 8080 <inet4>" }
@@ -129,10 +129,10 @@ HELP: inet4
 
 HELP: <inet4>
 { $values { "host" "an IPv4 address" } { "port" "a port number" } { "inet4" inet4 } }
-{ $description "Creates a new " { $link inet4 } " address specifier." } ;
+{ $description "Creates a new " { $link inet4 } " address specifier. A value of " { $link f } " as the host refers to localhost, while " { $link f } " as the port defers the port choice until a later time." } ;
 
 HELP: inet6
-{ $class-description "IPv6 address/port number specifier for TCP/IP and UDP/IP connections. The " { $snippet "host" } " and " { $snippet "port" } " slots hold the IPv6 address and port number, respectively. New instances are created by calling " { $link <inet6> } "." }
+{ $class-description "IPv6 address/port number specifier for TCP/IP and UDP/IP connections. The " { $snippet "host" } " and " { $snippet "port" } " slots hold the IPv6 address and port number, respectively. New instances are created by calling " { $link <inet6> } ". A host of " { $link f } " refers to localhost, and a port of " { $link f } " defers the port choice until later." }
 { $notes "Most applications do not operate on IPv6 addresses directly, and instead should use the " { $link inet } " address specifier, or call " { $link resolve-host } "." }
 { $examples
     { $code "\"::1\" 8080 <inet6>" }
@@ -140,7 +140,7 @@ HELP: inet6
 
 HELP: <inet6>
 { $values { "host" "an IPv6 address" } { "port" "a port number" } { "inet6" inet6 } }
-{ $description "Creates a new " { $link inet6 } " address specifier." } ;
+{ $description "Creates a new " { $link inet6 } " address specifier. A value of " { $link f } " as the host refers to localhost, while " { $link f } " as the port defers the port choice until a later time." } ;
 
 HELP: <client>
 { $values { "remote" "an address specifier" } { "encoding" "an encding descriptor" } { "stream" "a bidirectional stream" } { "local" "an address specifier" } }
diff --git a/basis/io/sockets/sockets-tests.factor b/basis/io/sockets/sockets-tests.factor
index 56939f484f..f5bffc5dc8 100644
--- a/basis/io/sockets/sockets-tests.factor
+++ b/basis/io/sockets/sockets-tests.factor
@@ -1,8 +1,17 @@
-IN: io.sockets.tests
 USING: io.sockets io.sockets.private sequences math tools.test
 namespaces accessors kernel destructors calendar io.timeouts
 io.encodings.utf8 io concurrency.promises threads
 io.streams.string ;
+IN: io.sockets.tests
+
+[ T{ inet4 f f 0 } ] [ f 0 <inet4> ] unit-test
+[ T{ inet6 f f 0 } ] [ f 0 <inet6> ] unit-test
+
+[ T{ inet f "google.com" f } ] [ "google.com" f <inet> ] unit-test
+
+[ T{ inet f "google.com" 0 } ] [ "google.com" 0 <inet> ] unit-test
+[ T{ inet4 f "8.8.8.8" 0 } ] [ "8.8.8.8" 0 <inet> ] unit-test
+[ T{ inet6 f "5:5:5:5:6:6:6:6" 0 } ] [ "5:5:5:5:6:6:6:6" 0 <inet> ] unit-test
 
 [ B{ 1 2 3 4 } ]
 [ "1.2.3.4" T{ inet4 } inet-pton ] unit-test
@@ -25,6 +34,8 @@ io.streams.string ;
 [ B{ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 } ]
 [ "::" T{ inet6 } inet-pton ] unit-test
 
+[ f T{ inet6 } inet-pton ] [ reason>> empty-ipv6? ] must-fail-with
+
 [ "0:0:0:0:0:0:0:0" ]
 [ B{ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 } T{ inet6 } inet-ntop ] unit-test
 
@@ -132,3 +143,4 @@ io.streams.string ;
 
 ! Binding to all interfaces should work
 [ ] [ f 0 <inet4> <datagram> dispose ] unit-test
+[ ] [ f 0 <inet6> <datagram> dispose ] unit-test
diff --git a/basis/io/sockets/sockets.factor b/basis/io/sockets/sockets.factor
index a48e6ffc95..07c64c7e44 100644
--- a/basis/io/sockets/sockets.factor
+++ b/basis/io/sockets/sockets.factor
@@ -37,8 +37,6 @@ GENERIC: inet-ntop ( data addrspec -- str )
 
 GENERIC: inet-pton ( str addrspec -- data )
 
-GENERIC# with-port 1 ( addrspec port -- addrspec )
-
 : make-sockaddr/size ( addrspec -- sockaddr size )
     [ make-sockaddr ] [ sockaddr-size ] bi ;
 
@@ -55,6 +53,8 @@ HOOK: addrspec-of-family os ( af -- addrspec )
 
 PRIVATE>
 
+GENERIC# with-port 1 ( addrspec port -- addrspec )
+
 TUPLE: local { path read-only } ;
 
 : <local> ( path -- addrspec )
@@ -113,7 +113,18 @@ M: ipv4 parse-sockaddr ( sockaddr-in addrspec -- newaddrspec )
 
 TUPLE: inet4 < ipv4 { port integer read-only } ;
 
-C: <inet4> inet4
+: inet-string? ( string exemplar -- ? )
+    '[ _ _ inet-pton drop t ] [ drop f ] recover ;
+
+: inet4-string? ( string -- ? ) T{ inet4 } inet-string? ;
+
+ERROR: invalid-inet4 string ;
+
+: ensure-inet4-string ( string -- string )
+    dup [ dup inet4-string? [ invalid-inet4 ] unless ] when ;
+
+: <inet4> ( host port -- inet4 )
+    [ ensure-inet4-string ] dip inet4 boa ;
 
 M: ipv4 with-port [ host>> ] dip <inet4> ;
 
@@ -165,11 +176,13 @@ ERROR: more-than-8-components ;
 
 PRIVATE>
 
+ERROR: empty-ipv6 ;
+
 M: ipv6 inet-pton ( str addrspec -- data )
-    drop
-    [ "::" split1 [ parse-ipv6 ] bi@ pad-ipv6 ipv6-bytes ]
-    [ invalid-ipv6 ]
-    recover ;
+    drop [
+        [ empty-ipv6 ]
+        [ "::" split1 [ parse-ipv6 ] bi@ pad-ipv6 ipv6-bytes ] if-empty
+    ] [ invalid-ipv6 ] recover ;
 
 M: ipv6 address-size drop 16 ;
 
@@ -192,7 +205,15 @@ M: ipv6 parse-sockaddr
 
 TUPLE: inet6 < ipv6 { port integer read-only } ;
 
-C: <inet6> inet6
+: inet6-string? ( string -- ? ) T{ inet6 } inet-string? ;
+
+ERROR: invalid-inet6 string ;
+
+: ensure-inet6-string ( string -- string )
+    dup [ dup inet6-string? [ invalid-inet6 ] unless ] when ;
+
+: <inet6> ( host port -- inet6 )
+    [ ensure-inet6-string ] dip inet6 boa ;
 
 M: ipv6 with-port [ host>> ] dip <inet6> ;
 
@@ -365,7 +386,14 @@ TUPLE: inet < hostname port ;
 M: inet present
     [ host>> ] [ port>> number>string ] bi ":" glue ;
 
-C: <inet> inet
+: <inet> ( host port -- inet )
+    {
+        { [ over inet4-string? ] [ inet4 boa ] }
+        { [ over inet6-string? ] [ inet6 boa ] }
+        [ inet boa ]
+    } cond ;
+
+M: inet with-port [ host>> ] dip <inet> ;
 
 M: string resolve-host
     f prepare-addrinfo f <void*>
diff --git a/basis/urls/urls-docs.factor b/basis/urls/urls-docs.factor
index a66ba14694..b6faa15f43 100644
--- a/basis/urls/urls-docs.factor
+++ b/basis/urls/urls-docs.factor
@@ -24,7 +24,7 @@ HELP: >url
     "We can examine the URL object:"
     { $example
         "USING: accessors io urls ;"
-        "\"http://www.apple.com\" >url host>> print"
+        "\"http://www.apple.com\" >url addr>> host>> print"
         "www.apple.com"
     }
     "A relative URL does not have a protocol, host or port:"
@@ -41,7 +41,7 @@ HELP: URL"
 { $examples
     { $example
         "USING: accessors prettyprint urls ;"
-        "URL\" http://factorcode.org:80\" port>> ."
+        "URL\" http://factorcode.org:80\" addr>> port>> ."
         "80"
     }
 } ;
@@ -70,13 +70,13 @@ HELP: ensure-port
 { $examples
     { $example
         "USING: accessors prettyprint urls ;"
-        "URL\" https://concatenative.org\" ensure-port port>> ."
+        "URL\" https://concatenative.org\" ensure-port addr>> port>> ."
         "443"
     }
 } ;
 
 HELP: parse-host
-{ $values { "string" string } { "host" string } { "port" { $maybe integer } } }
+{ $values { "string" string } { "host/f" string } { "port/f" { $maybe integer } } }
 { $description "Splits a string of the form " { $snippet "host:port" } " into a host and a port number. If the port number is not specified, outputs " { $link f } "." }
 { $notes "This word is used by " { $link >url } ". It can also be used directly to parse " { $snippet "host:port" } " strings which are not full URLs." }
 { $examples
diff --git a/basis/urls/urls-tests.factor b/basis/urls/urls-tests.factor
index f2ecd6ec69..2790c71043 100644
--- a/basis/urls/urls-tests.factor
+++ b/basis/urls/urls-tests.factor
@@ -1,14 +1,13 @@
+USING: accessors arrays assocs io.sockets kernel present
+prettyprint tools.test urls urls.private ;
 IN: urls.tests
-USING: urls urls.private tools.test prettyprint
-arrays kernel assocs present accessors ;
 
 CONSTANT: urls
     {
         {
             T{ url
                 { protocol "http" }
-                { host "www.apple.com" }
-                { port 1234 }
+                { addr T{ inet f "www.apple.com" 1234 } }
                 { path "/a/path" }
                 { query H{ { "a" "b" } } }
                 { anchor "foo" }
@@ -18,7 +17,7 @@ CONSTANT: urls
         {
             T{ url
                 { protocol "http" }
-                { host "www.apple.com" }
+                { addr T{ inet f "www.apple.com" } }
                 { path "/a/path" }
                 { query H{ { "a" "b" } } }
                 { anchor "foo" }
@@ -28,8 +27,7 @@ CONSTANT: urls
         {
             T{ url
                 { protocol "http" }
-                { host "www.apple.com" }
-                { port 1234 }
+                { addr T{ inet f "www.apple.com" 1234 } }
                 { path "/another/fine/path" }
                 { anchor "foo" }
             }
@@ -64,7 +62,7 @@ CONSTANT: urls
         {
             T{ url
                 { protocol "ftp" }
-                { host "ftp.kernel.org" }
+                { addr T{ inet f "ftp.kernel.org" } }
                 { username "slava" }
                 { path "/" }
             }
@@ -73,7 +71,7 @@ CONSTANT: urls
         {
             T{ url
                 { protocol "ftp" }
-                { host "ftp.kernel.org" }
+                { addr T{ inet f "ftp.kernel.org" } }
                 { username "slava" }
                 { password "secret" }
                 { path "/" }
@@ -83,7 +81,7 @@ CONSTANT: urls
         {
             T{ url
                { protocol "http" }
-               { host "foo.com" }
+               { addr T{ inet f "foo.com" } }
                { path "/" }
                { query H{ { "a" f } } }
             }
@@ -114,15 +112,13 @@ urls [
 [
     T{ url
         { protocol "http" }
-        { host "www.apple.com" }
-        { port 1234 }
+        { addr T{ inet f "www.apple.com" 1234 } }
         { path "/a/path" }
     }
 ] [
     T{ url
         { protocol "http" }
-        { host "www.apple.com" }
-        { port 1234 }
+        { addr T{ inet f "www.apple.com" 1234 } }
         { path "/foo" }
     }
 
@@ -136,8 +132,7 @@ urls [
 [
     T{ url
         { protocol "http" }
-        { host "www.apple.com" }
-        { port 1234 }
+        { addr T{ inet f "www.apple.com" 1234 } }
         { path "/a/path/relative/path" }
         { query H{ { "a" "b" } } }
         { anchor "foo" }
@@ -145,8 +140,7 @@ urls [
 ] [
     T{ url
         { protocol "http" }
-        { host "www.apple.com" }
-        { port 1234 }
+        { addr T{ inet f "www.apple.com" 1234 } }
         { path "/a/path/" }
     }
 
@@ -162,8 +156,7 @@ urls [
 [
     T{ url
         { protocol "http" }
-        { host "www.apple.com" }
-        { port 1234 }
+        { addr T{ inet f "www.apple.com" 1234 } }
         { path "/a/path/relative/path" }
         { query H{ { "a" "b" } } }
         { anchor "foo" }
@@ -171,8 +164,7 @@ urls [
 ] [
     T{ url
         { protocol "http" }
-        { host "www.apple.com" }
-        { port 1234 }
+        { addr T{ inet f "www.apple.com" 1234 } }
         { path "/a/path/" }
     }
 
@@ -188,13 +180,13 @@ urls [
 [
     T{ url
         { protocol "http" }
-        { host "www.apple.com" }
+        { addr T{ inet f "www.apple.com" } }
         { path "/xxx/baz" }
     }
 ] [
     T{ url
         { protocol "http" }
-        { host "www.apple.com" }
+        { addr T{ inet f "www.apple.com" } }
         { path "/xxx/bar" }
     }
 
@@ -218,7 +210,7 @@ urls [
 [
     T{ url
         { protocol "http" }
-        { host "localhost" }
+        { addr T{ inet f "localhost" } }
         { query H{ { "foo" "bar" } } }
         { path "/" }
     }
@@ -228,7 +220,7 @@ urls [
 [
     T{ url
         { protocol "http" }
-        { host "localhost" }
+        { addr T{ inet f "localhost" } }
         { query H{ { "foo" "bar" } } }
         { path "/" }
     }
@@ -237,4 +229,4 @@ urls [
 
 [ "/" ] [ "http://www.jedit.org" >url path>> ] unit-test
 
-[ "USING: urls ;\nURL\" foo\"" ] [ URL" foo" unparse-use ] unit-test
\ No newline at end of file
+[ "USING: urls ;\nURL\" foo\"" ] [ URL" foo" unparse-use ] unit-test
diff --git a/basis/urls/urls.factor b/basis/urls/urls.factor
index 0f89ba0d9f..e44a1dd756 100644
--- a/basis/urls/urls.factor
+++ b/basis/urls/urls.factor
@@ -1,13 +1,13 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel ascii combinators combinators.short-circuit
-sequences splitting fry namespaces make assocs arrays strings
-io.sockets io.encodings.string io.encodings.utf8 math
-math.parser accessors parser strings.parser lexer
-hashtables present peg.ebnf urls.encoding ;
+USING: accessors arrays ascii assocs classes combinators
+combinators.short-circuit fry hashtables io.encodings.string
+io.encodings.utf8 io.sockets kernel lexer make math math.parser
+namespaces parser peg.ebnf present sequences splitting strings
+strings.parser urls.encoding ;
 IN: urls
 
-TUPLE: url protocol username password host port path query anchor ;
+TUPLE: url protocol username password addr path query anchor ;
 
 : <url> ( -- url ) url new ;
 
@@ -24,14 +24,12 @@ TUPLE: url protocol username password host port path query anchor ;
         nip delete-query-param
     ] if ;
 
-: parse-host ( string -- host port )
+ERROR: malformed-port ;
+
+: parse-host ( string -- host/f port/f )
     [
-        ":" split1 [ url-decode ] [
-            dup [
-                string>number
-                dup [ "Invalid port" throw ] unless
-            ] when
-        ] bi*
+        ":" split1-last [ url-decode ]
+        [ dup [ string>number [ malformed-port ] unless* ] when ] bi*
     ] [ f f ] if* ;
 
 GENERIC: >url ( obj -- url )
@@ -68,23 +66,33 @@ url      = ((protocol "://")        => [[ first ]] auth hostname)?
 PRIVATE>
 
 M: string >url
+    [ <url> ] dip
     parse-url {
         [
             first [
-                [ first ] ! protocol
+                [ first >>protocol ]
                 [
                     second
-                    [ first [ first2 ] [ f f ] if* ] ! username, password
-                    [ second parse-host ] ! host, port
-                    bi
+                    [ first [ first2 [ >>username ] [ >>password ] bi* ] when* ]
+                    [ second parse-host <inet> >>addr ] bi
                 ] bi
-            ] [ f f f f f ] if*
+            ] when*
         ]
-        [ second ] ! pathname
-        [ third ] ! query
-        [ fourth ] ! anchor
-    } cleave url boa
-    dup host>> [ [ "/" or ] change-path ] when ;
+        [ second >>path ]
+        [ third >>query ]
+        [ fourth >>anchor ]
+    } cleave
+    dup addr>> [ [ "/" or ] change-path ] when ;
+
+<PRIVATE
+
+: inet>url ( inet -- url ) [ <url> ] dip >>addr ;
+
+PRIVATE>
+
+M: inet >url inet>url ;
+M: inet4 >url inet>url ;
+M: inet6 >url inet>url ;
 
 : protocol-port ( protocol -- port )
     {
@@ -102,7 +110,9 @@ M: string >url
     ] [ 2drop ] if ;
 
 : url-port ( url -- port/f )
-    [ port>> ] [ port>> ] [ protocol>> protocol-port ] tri =
+    [ addr>> port>> ]
+    [ addr>> port>> ]
+    [ protocol>> protocol-port ] tri =
     [ drop f ] when ;
 
 : unparse-host-part ( url protocol -- )
@@ -110,7 +120,7 @@ M: string >url
     "://" %
     {
         [ unparse-username-password ]
-        [ host>> url-encode % ]
+        [ addr>> host>> url-encode % ]
         [ url-port [ ":" % # ] when* ]
         [ path>> "/" head? [ "/" % ] unless ]
     } cleave ;
@@ -143,8 +153,7 @@ PRIVATE>
         [ [ protocol>>  ] either? >>protocol ]
         [ [ username>>  ] either? >>username ]
         [ [ password>>  ] either? >>password ]
-        [ [ host>>      ] either? >>host ]
-        [ [ port>>      ] either? >>port ]
+        [ [ addr>>      ] either? >>addr ]
         [ [ path>>      ] bi@ swap url-append-path >>path ]
         [ [ query>>     ] either? >>query ]
         [ [ anchor>>    ] either? >>anchor ]
@@ -153,8 +162,7 @@ PRIVATE>
 : relative-url ( url -- url' )
     clone
         f >>protocol
-        f >>host
-        f >>port ;
+        f >>addr ;
 
 : relative-url? ( url -- ? ) protocol>> not ;
 
@@ -170,15 +178,15 @@ PRIVATE>
 
 : url-addr ( url -- addr )
     [
-        [ host>> ]
-        [ port>> ]
-        [ protocol>> protocol-port ]
-        tri or <inet>
+        [ addr>> ]
+        [ [ addr>> port>> ] [ protocol>> protocol-port ] bi or ] bi with-port
     ] [ protocol>> ] bi
     secure-protocol? [ >secure-addr ] when ;
 
 : ensure-port ( url -- url' )
-    clone dup protocol>> '[ _ protocol-port or ] change-port ;
+    clone dup protocol>> '[
+        dup port>> _ protocol-port or with-port
+    ] change-addr ;
 
 ! Literal syntax
 SYNTAX: URL" lexer get skip-blank parse-string >url suffix! ;