! Copyright (C) 2003, 2010 Slava Pestov, Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays calendar combinators
-combinators.short-circuit concurrency.combinators
-concurrency.count-downs concurrency.flags
-concurrency.semaphores continuations debugger destructors fry
-io io.sockets io.sockets.secure io.streams.duplex io.styles
-io.timeouts kernel logging make math math.parser namespaces
-present prettyprint random sequences sets strings threads ;
+USING: accessors arrays calendar concurrency.flags
+concurrency.semaphores continuations destructors io io.sockets
+io.sockets.secure io.streams.duplex io.styles io.timeouts kernel
+logging make math namespaces present prettyprint random
+sequences sets strings threads ;
IN: io.servers
TUPLE: threaded-server < identity-tuple
<PRIVATE
-: must-be-running ( threaded-server -- threaded-server )
- dup running-servers get in? [ throw-server-not-running ] unless ;
+: add-running-server ( threaded-server running-servers -- )
+ dupd ?adjoin [ drop ] [ server-already-running ] if ;
-: must-not-be-running ( threaded-server -- threaded-server )
- dup running-servers get in? [ throw-server-already-running ] when ;
-
-: add-running-server ( threaded-server -- )
- must-not-be-running
- running-servers get adjoin ;
-
-: remove-running-server ( threaded-server -- )
- must-be-running
- running-servers get delete ;
+: remove-running-server ( threaded-server running-servers -- )
+ dupd ?delete [ drop ] [ server-not-running ] if ;
PRIVATE>
M: local >insecure 1array ;
M: integer >insecure internet-server 1array ;
M: string >insecure internet-server 1array ;
-M: array >insecure [ >insecure ] map ;
+M: array >insecure [ >insecure ] map concat ;
M: f >insecure ;
: >secure ( addrspec -- addrspec' )
- >insecure
- [ dup secure? [ <secure> ] unless ] map ;
+ >insecure [ dup secure? [ f <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 -- )
[
: log-connection ( remote local -- )
[ accepted-connection ]
- [ [ remote-address set ] [ local-address set ] bi* ]
+ [ [ remote-address namespaces:set ] [ local-address namespaces:set ] bi* ]
2bi ;
M: threaded-server handle-client* handler>> call( -- ) ;
[ ] [ name>> ] bi
[
set-servers
- dup add-running-server
+ dup running-servers get add-running-server
dup servers>>
[
[ '[ _ _ [ start-accept-loop ] with-disposal ] ]
: stop-server ( threaded-server -- )
dup server-running? [
- [ remove-running-server ]
+ [ running-servers get remove-running-server ]
[
[
[ secure-context>> [ &dispose drop ] when* ]
'[
[ _ threaded-server _ with-variable ]
[ _ stop-server ]
- [ ] cleanup
+ finally
] call ; inline
<PRIVATE
M: inet6 connect-addr [ "::1" ] dip port>> <inet6> ;
-M: secure connect-addr addrspec>> connect-addr <secure> ;
+M: secure connect-addr addrspec>> connect-addr f <secure> ;
M: local connect-addr ;