2005-01-30 15:57:25 -05:00
|
|
|
! Copyright (C) 2004, 2005 Slava Pestov.
|
|
|
|
! See http://factor.sf.net/license.txt for BSD license.
|
2004-11-25 21:53:27 -05:00
|
|
|
IN: streams
|
2005-01-30 15:57:25 -05:00
|
|
|
USING: io-internals errors hashtables kernel stdio strings
|
|
|
|
namespaces unparser generic ;
|
2004-11-25 21:53:27 -05:00
|
|
|
|
2005-01-30 15:57:25 -05:00
|
|
|
TUPLE: server port ;
|
2004-12-27 06:56:05 -05:00
|
|
|
GENERIC: accept
|
2004-11-28 21:56:58 -05:00
|
|
|
|
|
|
|
M: server fclose ( stream -- )
|
2005-01-30 15:57:25 -05:00
|
|
|
server-port close-port ;
|
2004-11-28 21:56:58 -05:00
|
|
|
|
|
|
|
C: server ( port -- stream )
|
2004-11-25 21:53:27 -05:00
|
|
|
#! Starts listening on localhost:port. Returns a stream that
|
|
|
|
#! you can close with fclose, and accept connections from
|
|
|
|
#! with accept. No other stream operations are supported.
|
2005-01-30 15:57:25 -05:00
|
|
|
[ >r server-socket r> set-server-port ] keep ;
|
2004-11-25 21:53:27 -05:00
|
|
|
|
2005-01-30 15:57:25 -05:00
|
|
|
TUPLE: client-stream delegate host ;
|
2004-11-25 21:53:27 -05:00
|
|
|
|
2005-01-30 15:57:25 -05:00
|
|
|
C: client-stream ( host port in out -- stream )
|
2004-11-25 21:53:27 -05:00
|
|
|
#! fflush yields until connection is established.
|
2005-01-30 15:57:25 -05:00
|
|
|
[ >r <fd-stream> r> set-client-stream-delegate ] keep
|
|
|
|
[ >r ":" swap unparse cat3 r> set-client-stream-host ] keep
|
|
|
|
dup fflush ;
|
|
|
|
|
|
|
|
: <client> ( host port -- stream )
|
|
|
|
2dup client-socket <client-stream> ;
|
2004-11-25 21:53:27 -05:00
|
|
|
|
2004-12-27 06:56:05 -05:00
|
|
|
M: server accept ( server -- client )
|
2004-11-25 21:53:27 -05:00
|
|
|
#! Accept a connection from a server socket.
|
2005-01-30 15:57:25 -05:00
|
|
|
server-port blocking-accept <client-stream> ;
|