add managed-server to extra/

db4
Doug Coleman 2009-05-29 11:20:40 -05:00
parent 553fd8aa15
commit 4d882f25cd
4 changed files with 88 additions and 0 deletions

View File

@ -0,0 +1 @@
Doug Coleman

View File

@ -0,0 +1 @@
Doug Coleman

View File

@ -0,0 +1,23 @@
! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs fry io kernel managed-server
namespaces sequences ;
IN: managed-server.chat
TUPLE: chat-server < managed-server ;
: <chat-server> ( port -- managed-server )
"chat-server" chat-server new-managed-server ;
M: chat-server handle-managed-client*
clients>>
readln dup empty? [
2drop
] [
'[
nip output-stream>>
[
client get username>> ": " _ 3append print flush
] with-output-stream*
] assoc-each
] if ;

View File

@ -0,0 +1,63 @@
! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs calendar continuations io
io.encodings.binary io.servers.connection io.sockets
io.streams.duplex kernel locals math math.ranges multiline
namespaces prettyprint random sequences sets splitting threads
tools.continuations ;
IN: managed-server
SYMBOL: client
TUPLE: managed-server < threaded-server clients ;
TUPLE: managed-client input-stream output-stream local-address
remote-address username ;
GENERIC: login ( managed-server -- username )
GENERIC: handle-managed-client* ( threaded-server -- )
ERROR: already-logged-in username ;
ERROR: bad-login username ;
<PRIVATE
: <managed-client> ( username -- managed-client )
managed-client new
swap >>username
input-stream get >>input-stream
output-stream get >>output-stream
local-address get >>local-address
remote-address get >>remote-address ;
: check-logged-in ( username -- username )
dup threaded-server get clients>> key? [ already-logged-in ] when ;
: add-managed-client ( managed-client -- )
dup username>>
threaded-server get clients>> set-at ;
: delete-managed-client ( -- )
client get username>>
threaded-server get clients>> delete-at ;
: handle-managed-client ( -- )
[ [ threaded-server get handle-managed-client* t ] loop ]
[ delete-managed-client ]
[ ] cleanup ;
PRIVATE>
M: managed-server login drop readln ;
M: managed-server handle-client*
login <managed-client>
[ client set ] [ add-managed-client ] bi
handle-managed-client ;
: new-managed-server ( port name class -- server )
new-threaded-server
swap >>name
swap >>insecure
f >>timeout
H{ } clone >>clients ; inline