2005-03-18 21:41:13 -05:00
|
|
|
! Copyright (C) 2003, 2005 Slava Pestov.
|
2006-01-16 02:48:15 -05:00
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
2005-06-19 17:50:35 -04:00
|
|
|
IN: io
|
2005-09-20 20:18:01 -04:00
|
|
|
USING: errors io kernel math namespaces parser sequences strings
|
|
|
|
threads ;
|
2004-07-16 02:26:21 -04:00
|
|
|
|
2005-04-22 20:09:46 -04:00
|
|
|
SYMBOL: log-stream
|
2004-07-16 02:26:21 -04:00
|
|
|
|
2006-08-16 21:55:53 -04:00
|
|
|
: log-message ( str -- )
|
2006-05-25 16:06:25 -04:00
|
|
|
log-stream get [ stream-print ] keep stream-flush ;
|
2005-03-18 21:41:13 -05:00
|
|
|
|
2006-08-16 21:55:53 -04:00
|
|
|
: log-error ( str -- ) "Error: " swap append log-message ;
|
2005-03-18 21:41:13 -05:00
|
|
|
|
2006-08-16 21:55:53 -04:00
|
|
|
: log-client ( client -- )
|
2005-04-22 20:09:46 -04:00
|
|
|
[
|
|
|
|
"Accepted connection from " %
|
2005-04-24 23:02:19 -04:00
|
|
|
dup client-stream-host %
|
|
|
|
CHAR: : ,
|
2005-08-31 21:06:13 -04:00
|
|
|
client-stream-port #
|
|
|
|
] "" make log-message ;
|
2005-04-24 23:02:19 -04:00
|
|
|
|
2006-08-16 21:55:53 -04:00
|
|
|
: with-log-file ( path quot -- )
|
2005-04-24 23:02:19 -04:00
|
|
|
[ swap <file-writer> log-stream set call ] with-scope ;
|
|
|
|
|
|
|
|
: with-logging ( quot -- )
|
|
|
|
[ stdio get log-stream set call ] with-scope ;
|
2005-09-20 20:18:01 -04:00
|
|
|
|
|
|
|
: with-client ( quot client -- )
|
|
|
|
dup log-client [ swap with-stream ] in-thread 2drop ;
|
|
|
|
inline
|
|
|
|
|
|
|
|
SYMBOL: server-stream
|
|
|
|
|
|
|
|
: server-loop ( quot -- )
|
|
|
|
server-stream get accept over
|
|
|
|
>r with-client r> server-loop ; inline
|
|
|
|
|
|
|
|
: with-server ( port ident quot -- )
|
|
|
|
>r >r <server> dup r> set r> swap [
|
|
|
|
server-stream set
|
|
|
|
[ server-loop ]
|
|
|
|
[ server-stream get stream-close ] cleanup
|
|
|
|
] with-logging ; inline
|