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

Make secure-context persist longer than a millisecond when a server gets started.

db4
Doug Coleman 2010-09-27 18:57:14 -05:00
parent 546b81b697
commit b03268f047
1 changed files with 38 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

68
basis/io/servers/connection/connection.factor
View File

@ -22,7 +22,8 @@ semaphore
timeout timeout
encoding encoding
handler handler
server-stopped ; server-stopped
secure-context ;
SYMBOL: running-servers SYMBOL: running-servers
running-servers [ HS{ } clone ] initialize running-servers [ HS{ } clone ] initialize
@ -131,14 +132,24 @@ M: threaded-server handle-client* handler>> call( -- ) ;
[ (accept-connection) ] [ (accept-connection) ]
if* ; if* ;
: with-existing-secure-context ( threaded-server quot -- )
[ secure-context>> secure-context ] dip with-variable ; inline
: accept-loop ( server -- ) : accept-loop ( server -- )
[ accept-connection ] [ accept-loop ] bi ; [ accept-connection ] [ accept-loop ] bi ;
: start-accept-loop ( server -- ) accept-loop ; : start-accept-loop ( threaded-server server -- )
'[ _ accept-loop ] with-existing-secure-context ;
\ start-accept-loop NOTICE add-error-logging \ start-accept-loop NOTICE add-error-logging
: create-secure-context ( threaded-server -- threaded-server )
dup secure>> [
dup secure-config>> <secure-context> >>secure-context
] when ;
: init-server ( threaded-server -- threaded-server ) : init-server ( threaded-server -- threaded-server )
create-secure-context
<flag> >>server-stopped <flag> >>server-stopped
dup semaphore>> [ dup semaphore>> [
dup max-connections>> [ dup max-connections>> [
@ -153,48 +164,45 @@ ERROR: no-ports-configured threaded-server ;
'[ [ _ <server> |dispose ] map ] with-destructors ; '[ [ _ <server> |dispose ] map ] with-destructors ;
: set-servers ( threaded-server -- threaded-server ) : set-servers ( threaded-server -- threaded-server )
dup dup listen-on [ no-ports-configured ] [ (make-servers) ] if-empty dup [
>>servers ; dup dup listen-on [ no-ports-configured ] [ (make-servers) ] if-empty
>>servers
] with-existing-secure-context ;
: server-thread-name ( threaded-server addrspec -- string ) : server-thread-name ( threaded-server addrspec -- string )
[ name>> ] [ addr>> present ] bi* " server on " glue ; [ name>> ] [ addr>> present ] bi* " server on " glue ;
: (start-server) ( threaded-server -- )
init-server
dup threaded-server [
[ ] [ name>> ] bi
[
set-servers
dup add-running-server
dup servers>>
[
[ nip '[ _ [ start-accept-loop ] with-disposal ] ]
[ server-thread-name ] 2bi spawn drop
] with each
] with-logging
] with-variable ;
PRIVATE> PRIVATE>
: start-server ( threaded-server -- threaded-server ) : start-server ( threaded-server -- threaded-server )
#! Only create a secure-context if we want to listen on init-server
#! a secure port, otherwise start-server won't work at [
#! all if SSL is not available. dup threaded-server [
dup dup secure>> [ [ ] [ name>> ] bi
dup secure-config>> [ [
(start-server) set-servers
] with-secure-context dup add-running-server
] [ dup servers>>
(start-server) [
] if ; [ '[ _ _ [ start-accept-loop ] with-disposal ] ]
[ server-thread-name ] 2bi spawn drop
] with each
] with-logging
] with-variable
] keep ;
: server-running? ( threaded-server -- ? ) : server-running? ( threaded-server -- ? )
server-stopped>> [ value>> not ] [ f ] if* ; server-stopped>> [ value>> not ] [ f ] if* ;
: stop-server ( threaded-server -- ) : stop-server ( threaded-server -- )
dup server-running? [ dup server-running? [
[ [ f ] change-servers drop dispose-each ]
[ remove-running-server ] [ remove-running-server ]
[
[
[ secure-context>> [ &dispose drop ] when* ]
[ [ f ] change-servers drop dispose-each ] bi
] with-destructors
]
[ server-stopped>> raise-flag ] tri [ server-stopped>> raise-flag ] tri
] [ ] [
drop drop