io.servers: filter the list of addrspecs in listen-on so that only

usable ones remains

"localhost" resolve-host can return unusable ipv6 addresses on hosts not
supporting ipv6. So a filtering step is needed in listen-on.

diff --git a/basis/io/servers/servers-docs.factor b/basis/io/servers/servers-docs.factor
index 89d47ccc832deb36fb9280f89e553b4d5cf5b9d0..9f4855c1710eb13d00bf2974c7a79b4897ead22a 100644 (file)
--- a/basis/io/servers/servers-docs.factor
+++ b/basis/io/servers/servers-docs.factor
@@ -1,5 +1,6 @@
-USING: calendar classes concurrency.semaphores help.markup
-help.syntax io io.sockets io.sockets.secure math quotations ;
+USING: calendar classes concurrency.semaphores help.markup help.syntax
+io io.servers.private io.sockets io.sockets.secure quotations
+sequences ;
 IN: io.servers
 
 ARTICLE: "server-config" "Threaded server configuration"
@@ -84,6 +85,10 @@ ARTICLE: "io.servers" "Threaded servers"
 
 ABOUT: "io.servers"
 
+HELP: configurable-addrspecs
+{ $values { "addrspecs" sequence } { "addrspecs'" sequence } }
+{ $description "Filter the list of addrspecs so that only those that are supported by the host system remains." } ;
+
 HELP: threaded-server
 { $var-description "In client handlers, stores the current threaded server instance." }
 { $class-description "The class of threaded servers. New instances are created with " { $link <threaded-server> } ". This class may be subclassed, and instances of subclasses should be created with " { $link new-threaded-server } ". See " { $link "server-config" } " for slot documentation." } ;

diff --git a/basis/io/servers/servers-tests.factor b/basis/io/servers/servers-tests.factor
index 947113326f1345126b5945e93ee41c1129326ed2..04004ea9b031583a8641bded632704b9948cab1c 100644 (file)
--- a/basis/io/servers/servers-tests.factor
+++ b/basis/io/servers/servers-tests.factor
@@ -44,3 +44,12 @@ IN: io.servers
         0 >>insecure
     start-server [ '[ _ wait-for-server ] in-thread ] [ stop-server ] bi
 ] unit-test
+
+ipv6-supported? [
+    { f } [
+        ascii <threaded-server>
+            "localhost" 1234 inet boa >>insecure
+        listen-on
+        [ inet6? ] any?
+    ] unit-test
+] unless

diff --git a/basis/io/servers/servers.factor b/basis/io/servers/servers.factor
index 14d764508975f830ad330ce610ae43997655cfa2..a2911b1f2cb5496e89ae6bbcc5f480273bbef423 100755 (executable)
--- a/basis/io/servers/servers.factor
+++ b/basis/io/servers/servers.factor
@@ -81,14 +81,15 @@ M: array >insecure [ >insecure ] map ;
 M: f >insecure ;
 
 : >secure ( addrspec -- addrspec' )
-    >insecure
-    [ dup secure? [ <secure> ] unless ] map ;
+    >insecure [ dup secure? [ <secure> ] unless ] map ;
+
+: configurable-addrspecs ( addrspecs -- addrspecs' )
+    [ inet6? not ipv6-supported? or ] filter ;
 
 : listen-on ( threaded-server -- addrspecs )
     [ secure>> ssl-supported? [ >secure ] [ drop { } ] if ]
-    [ insecure>> >insecure ]
-    bi append
-    [ resolve-host ] map concat ;
+    [ insecure>> >insecure ] bi append
+    [ resolve-host ] map concat configurable-addrspecs ;
 
 : accepted-connection ( remote local -- )
     [