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
							parent
							
								
									75cec0be1f
								
							
						
					
					
						commit
						75b8b4a408
					
				| 
						 | 
				
			
			@ -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." } ;
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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 -- )
 | 
			
		||||
    [
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue