2008-02-05 17:36:11 -05:00
|
|
|
! Copyright (C) 2003, 2008 Slava Pestov.
|
2007-09-20 18:09:08 -04:00
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
2008-02-07 18:07:43 -05:00
|
|
|
USING: io io.sockets io.files logging continuations kernel
|
2008-02-07 02:02:26 -05:00
|
|
|
math math.parser namespaces parser sequences strings
|
2007-09-20 18:09:08 -04:00
|
|
|
prettyprint debugger quotations calendar qualified ;
|
|
|
|
QUALIFIED: concurrency
|
|
|
|
|
|
|
|
IN: io.server
|
|
|
|
|
2008-02-07 18:07:43 -05:00
|
|
|
LOG: accepted-connection NOTICE
|
|
|
|
|
|
|
|
: with-client ( client quot -- )
|
|
|
|
[
|
|
|
|
over client-stream-addr accepted-connection
|
|
|
|
with-stream*
|
|
|
|
] curry with-disposal ; inline
|
|
|
|
|
|
|
|
\ with-client NOTICE add-error-logging
|
2007-09-20 18:09:08 -04:00
|
|
|
|
2008-02-01 23:47:01 -05:00
|
|
|
: accept-loop ( server quot -- )
|
2008-02-07 18:07:43 -05:00
|
|
|
[
|
|
|
|
>r accept r> [ with-client ] 2curry concurrency:spawn
|
|
|
|
] 2keep accept-loop ; inline
|
2007-09-20 18:09:08 -04:00
|
|
|
|
|
|
|
: server-loop ( server quot -- )
|
2008-02-01 23:47:01 -05:00
|
|
|
[ accept-loop ] curry with-disposal ; inline
|
2007-09-20 18:09:08 -04:00
|
|
|
|
|
|
|
: spawn-server ( addrspec quot -- )
|
2008-02-07 18:07:43 -05:00
|
|
|
>r <server> r> server-loop ; inline
|
|
|
|
|
|
|
|
\ spawn-server NOTICE add-error-logging
|
2007-09-20 18:09:08 -04:00
|
|
|
|
|
|
|
: local-server ( port -- seq )
|
|
|
|
"localhost" swap t resolve-host ;
|
|
|
|
|
|
|
|
: internet-server ( port -- seq )
|
|
|
|
f swap t resolve-host ;
|
|
|
|
|
|
|
|
: with-server ( seq service quot -- )
|
|
|
|
[
|
|
|
|
[ spawn-server ] curry concurrency:parallel-each
|
|
|
|
] curry with-logging ; inline
|
|
|
|
|
2008-02-07 18:07:43 -05:00
|
|
|
: received-datagram ( addrspec -- ) drop ;
|
|
|
|
|
|
|
|
\ received-datagram NOTICE add-input-logging
|
2007-09-20 18:09:08 -04:00
|
|
|
|
|
|
|
: datagram-loop ( quot datagram -- )
|
|
|
|
[
|
2008-02-07 18:07:43 -05:00
|
|
|
[ receive dup received-datagram >r swap call r> ] keep
|
2007-11-12 01:41:27 -05:00
|
|
|
pick [ send ] [ 3drop ] keep
|
2007-09-20 18:09:08 -04:00
|
|
|
] 2keep datagram-loop ; inline
|
|
|
|
|
|
|
|
: spawn-datagrams ( quot addrspec -- )
|
2008-01-31 01:52:06 -05:00
|
|
|
<datagram> [ datagram-loop ] with-disposal ; inline
|
2007-09-20 18:09:08 -04:00
|
|
|
|
2008-02-07 18:07:43 -05:00
|
|
|
\ spawn-datagrams NOTICE add-input-logging
|
|
|
|
|
2007-09-20 18:09:08 -04:00
|
|
|
: with-datagrams ( seq service quot -- )
|
|
|
|
[
|
|
|
|
[ swap spawn-datagrams ] curry concurrency:parallel-each
|
2007-11-12 01:41:27 -05:00
|
|
|
] curry with-logging ; inline
|