diff --git a/basis/io/servers/servers-docs.factor b/basis/io/servers/servers-docs.factor index 89d47ccc83..9f4855c171 100644 --- 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 } ". 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 947113326f..04004ea9b0 100644 --- 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 + "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 14d7645089..a2911b1f2c 100755 --- 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? [ ] unless ] map ; + >insecure [ dup 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 -- ) [