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

change threaded-server and managed-server to take an encoding

db4
Doug Coleman 2009-05-30 19:15:53 -05:00
parent 3df3ffc416
commit 50e6fac013
12 changed files with 27 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
basis/concurrency/distributed/distributed.factor
View File

@ -13,9 +13,8 @@ SYMBOL: local-node
[ first2 get-process send ] [ stop-this-server ] if* ; [ first2 get-process send ] [ stop-this-server ] if* ;
: <node-server> ( addrspec -- threaded-server ) : <node-server> ( addrspec -- threaded-server )
<threaded-server> binary <threaded-server>
swap >>insecure swap >>insecure
binary >>encoding
"concurrency.distributed" >>name "concurrency.distributed" >>name
[ handle-node-client ] >>handler ; [ handle-node-client ] >>handler ;

5
basis/ftp/server/server.factor
View File

@ -341,12 +341,11 @@ M: ftp-server handle-client* ( server -- )
] with-destructors ; ] with-destructors ;
: <ftp-server> ( directory port -- server ) : <ftp-server> ( directory port -- server )
ftp-server new-threaded-server latin1 ftp-server new-threaded-server
swap >>insecure swap >>insecure
swap canonicalize-path >>serving-directory swap canonicalize-path >>serving-directory
"ftp.server" >>name "ftp.server" >>name
5 minutes >>timeout 5 minutes >>timeout ;
latin1 >>encoding ;
: ftpd ( directory port -- ) : ftpd ( directory port -- )
<ftp-server> start-server ; <ftp-server> start-server ;

2
basis/http/server/server.factor
View File

@ -269,7 +269,7 @@ M: http-server handle-client*
] with-destructors ; ] with-destructors ;
: <http-server> ( -- server ) : <http-server> ( -- server )
http-server new-threaded-server ascii http-server new-threaded-server
"http.server" >>name "http.server" >>name
"http" protocol-port >>insecure "http" protocol-port >>insecure
"https" protocol-port >>secure ; "https" protocol-port >>secure ;

4
basis/io/servers/connection/connection-docs.factor
View File

@ -83,8 +83,8 @@ HELP: new-threaded-server
{ $description "Creates a new instance of a subclass of " { $link threaded-server } ". Subclasses can implement the " { $link handle-client* } " generic word." } ; { $description "Creates a new instance of a subclass of " { $link threaded-server } ". Subclasses can implement the " { $link handle-client* } " generic word." } ;
HELP: <threaded-server> HELP: <threaded-server>
{ $values { "threaded-server" threaded-server } } { $values { "encoding" "an encoding descriptor" } { "threaded-server" threaded-server } }
{ $description "Creates a new threaded server. Its slots should be filled in as per " { $link "server-config" } ", before " { $link start-server } " is called to begin waiting for connections." } ; { $description "Creates a new threaded server with streams encoded " { $snippet "encoding" } ". Its slots should be filled in as per " { $link "server-config" } ", before " { $link start-server } " is called to begin waiting for connections." } ;
HELP: remote-address HELP: remote-address
{ $var-description "Variable holding the address specifier of the current client connection. See " { $link "network-addressing" } "." } ; { $var-description "Variable holding the address specifier of the current client connection. See " { $link "network-addressing" } "." } ;

10
basis/io/servers/connection/connection-tests.factor
View File

@ -3,10 +3,10 @@ USING: tools.test io.servers.connection io.sockets namespaces
io.servers.connection.private kernel accessors sequences io.servers.connection.private kernel accessors sequences
concurrency.promises io.encodings.ascii io threads calendar ; concurrency.promises io.encodings.ascii io threads calendar ;
[ t ] [ <threaded-server> listen-on empty? ] unit-test [ t ] [ ascii <threaded-server> listen-on empty? ] unit-test
[ f ] [ [ f ] [
<threaded-server> ascii <threaded-server>
25 internet-server >>insecure 25 internet-server >>insecure
listen-on listen-on
empty? empty?
@ -19,16 +19,16 @@ concurrency.promises io.encodings.ascii io threads calendar ;
and and
] unit-test ] unit-test
[ ] [ <threaded-server> init-server drop ] unit-test [ ] [ ascii <threaded-server> init-server drop ] unit-test
[ 10 ] [ [ 10 ] [
<threaded-server> ascii <threaded-server>
10 >>max-connections 10 >>max-connections
init-server semaphore>> count>> init-server semaphore>> count>>
] unit-test ] unit-test
[ ] [ [ ] [
<threaded-server> ascii <threaded-server>
5 >>max-connections 5 >>max-connections
0 >>insecure 0 >>insecure
[ "Hello world." write stop-this-server ] >>handler [ "Hello world." write stop-this-server ] >>handler

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

@ -27,18 +27,18 @@ ready ;
: internet-server ( port -- addrspec ) f swap <inet> ; : internet-server ( port -- addrspec ) f swap <inet> ;
: new-threaded-server ( class -- threaded-server ) : new-threaded-server ( encoding class -- threaded-server )
new new
swap >>encoding
"server" >>name "server" >>name
DEBUG >>log-level DEBUG >>log-level
ascii >>encoding
1 minutes >>timeout 1 minutes >>timeout
V{ } clone >>sockets V{ } clone >>sockets
<secure-config> >>secure-config <secure-config> >>secure-config
[ "No handler quotation" throw ] >>handler [ "No handler quotation" throw ] >>handler
<flag> >>ready ; inline <flag> >>ready ; inline
: <threaded-server> ( -- threaded-server ) : <threaded-server> ( encoding -- threaded-server )
threaded-server new-threaded-server ; threaded-server new-threaded-server ;
GENERIC: handle-client* ( threaded-server -- ) GENERIC: handle-client* ( threaded-server -- )

3
extra/fuel/remote/remote.factor
View File

@ -11,9 +11,8 @@ IN: fuel.remote
[ [ print-error-and-restarts ] error-hook set listener ] with-scope ; [ [ print-error-and-restarts ] error-hook set listener ] with-scope ;
: server ( port -- server ) : server ( port -- server )
<threaded-server> utf8 <threaded-server>
"tty-server" >>name "tty-server" >>name
utf8 >>encoding
swap local-server >>insecure swap local-server >>insecure
[ start-listener ] >>handler [ start-listener ] >>handler
f >>timeout ; f >>timeout ;

3
extra/managed-server/chat/chat.factor
View File

@ -100,8 +100,7 @@ Disconnects a user from the chat server."> "quit" add-command
] if ; ] if ;
: <chat-server> ( port -- managed-server ) : <chat-server> ( port -- managed-server )
"chat-server" chat-server new-managed-server "chat-server" utf8 chat-server new-managed-server ;
utf8 >>encoding ;
: handle-chat ( string -- ) : handle-chat ( string -- )
[ [

13
extra/managed-server/managed-server.factor
View File

@ -19,7 +19,9 @@ HOOK: handle-already-logged-in managed-server ( -- )
HOOK: handle-client-join managed-server ( -- ) HOOK: handle-client-join managed-server ( -- )
HOOK: handle-client-disconnect managed-server ( -- ) HOOK: handle-client-disconnect managed-server ( -- )
M: managed-server handle-already-logged-in ; ERROR: already-logged-in username ;
M: managed-server handle-already-logged-in already-logged-in ;
M: managed-server handle-client-join ; M: managed-server handle-client-join ;
M: managed-server handle-client-disconnect ; M: managed-server handle-client-disconnect ;
@ -50,8 +52,6 @@ PRIVATE>
: send-everyone-else ( seq -- ) : send-everyone-else ( seq -- )
[ everyone-else-streams ] dip '[ _ (send-client) ] each ; [ everyone-else-streams ] dip '[ _ (send-client) ] each ;
ERROR: already-logged-in username ;
<PRIVATE <PRIVATE
: <managed-client> ( username -- managed-client ) : <managed-client> ( username -- managed-client )
@ -63,10 +63,7 @@ ERROR: already-logged-in username ;
remote-address get >>remote-address ; remote-address get >>remote-address ;
: check-logged-in ( username -- username ) : check-logged-in ( username -- username )
dup server clients>> key? [ dup clients key? [ handle-already-logged-in ] when ;
[ server ] dip
[ handle-already-logged-in ] [ already-logged-in ] bi
] when ;
: add-managed-client ( -- ) : add-managed-client ( -- )
client username check-logged-in clients set-at ; client username check-logged-in clients set-at ;
@ -87,7 +84,7 @@ M: managed-server handle-client*
[ delete-managed-client handle-client-disconnect ] [ delete-managed-client handle-client-disconnect ]
[ ] cleanup ; [ ] cleanup ;
: new-managed-server ( port name class -- server ) : new-managed-server ( port name encoding class -- server )
new-threaded-server new-threaded-server
swap >>name swap >>name
swap >>insecure swap >>insecure

5
extra/mongodb/mmm/mmm.factor
View File

@ -89,9 +89,8 @@ M: mdb-msg dump-message ( message -- )
: start-mmm-server ( -- ) : start-mmm-server ( -- )
output-stream get mmm-dump-output set output-stream get mmm-dump-output set
<threaded-server> [ mmm-t-srv set ] keep binary <threaded-server> [ mmm-t-srv set ] keep
"127.0.0.1" mmm-port get <inet4> >>insecure "127.0.0.1" mmm-port get <inet4> >>insecure
binary >>encoding
[ handle-mmm-connection ] >>handler [ handle-mmm-connection ] >>handler
start-server* ; start-server* ;
@ -99,4 +98,4 @@ M: mdb-msg dump-message ( message -- )
check-options check-options
start-mmm-server ; start-mmm-server ;
MAIN: run-mmm MAIN: run-mmm

6
extra/time-server/time-server.factor
View File

@ -1,14 +1,14 @@
! Copyright (C) 2008 Slava Pestov. ! Copyright (C) 2008 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: io io.servers.connection accessors threads USING: accessors calendar calendar.format io io.encodings.ascii
calendar calendar.format ; io.servers.connection threads ;
IN: time-server IN: time-server
: handle-time-client ( -- ) : handle-time-client ( -- )
now timestamp>rfc822 print ; now timestamp>rfc822 print ;
: <time-server> ( -- threaded-server ) : <time-server> ( -- threaded-server )
<threaded-server> ascii <threaded-server>
"time-server" >>name "time-server" >>name
1234 >>insecure 1234 >>insecure
[ handle-time-client ] >>handler ; [ handle-time-client ] >>handler ;

3
extra/tty-server/tty-server.factor
View File

@ -3,9 +3,8 @@ accessors kernel ;
IN: tty-server IN: tty-server
: <tty-server> ( port -- ) : <tty-server> ( port -- )
<threaded-server> utf8 <threaded-server>
"tty-server" >>name "tty-server" >>name
utf8 >>encoding
swap local-server >>insecure swap local-server >>insecure
[ listener ] >>handler [ listener ] >>handler
start-server ; start-server ;