steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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.
db4
Björn Lindqvist 2015-10-08 15:05:13 +02:00
parent 75cec0be1f
commit 75b8b4a408
3 changed files with 22 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
basis/io/servers/servers-docs.factor
View File

@ -1,5 +1,6 @@
USING: calendar classes concurrency.semaphores help.markup USING: calendar classes concurrency.semaphores help.markup help.syntax
help.syntax io io.sockets io.sockets.secure math quotations ; io io.servers.private io.sockets io.sockets.secure quotations
sequences ;
IN: io.servers IN: io.servers
ARTICLE: "server-config" "Threaded server configuration" ARTICLE: "server-config" "Threaded server configuration"
@ -84,6 +85,10 @@ ARTICLE: "io.servers" "Threaded servers"
ABOUT: "io.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 HELP: threaded-server
{ $var-description "In client handlers, stores the current threaded server instance." } { $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." } ; { $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." } ;

9
basis/io/servers/servers-tests.factor
View File

@ -44,3 +44,12 @@ IN: io.servers
0 >>insecure 0 >>insecure
start-server [ '[ _ wait-for-server ] in-thread ] [ stop-server ] bi start-server [ '[ _ wait-for-server ] in-thread ] [ stop-server ] bi
] unit-test ] unit-test
ipv6-supported? [
{ f } [
ascii <threaded-server>
"localhost" 1234 inet boa >>insecure
listen-on
[ inet6? ] any?
] unit-test
] unless

11
basis/io/servers/servers.factor
View File

@ -81,14 +81,15 @@ M: array >insecure [ >insecure ] map ;
M: f >insecure ; M: f >insecure ;
: >secure ( addrspec -- addrspec' ) : >secure ( addrspec -- addrspec' )
>insecure >insecure [ dup secure? [ <secure> ] unless ] map ;
[ dup secure? [ <secure> ] unless ] map ;
: configurable-addrspecs ( addrspecs -- addrspecs' )
[ inet6? not ipv6-supported? or ] filter ;
: listen-on ( threaded-server -- addrspecs ) : listen-on ( threaded-server -- addrspecs )
[ secure>> ssl-supported? [ >secure ] [ drop { } ] if ] [ secure>> ssl-supported? [ >secure ] [ drop { } ] if ]
[ insecure>> >insecure ] [ insecure>> >insecure ] bi append
bi append [ resolve-host ] map concat configurable-addrspecs ;
[ resolve-host ] map concat ;
: accepted-connection ( remote local -- ) : accepted-connection ( remote local -- )
[ [