core/io/server.factor

   1 ! Copyright (C) 2003, 2005 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 IN: io
   4 USING: errors io kernel math namespaces parser sequences strings
   5 threads ;
   6
   7 SYMBOL: log-stream
   8
   9 : log-message ( str -- )
  10     log-stream get [ stream-print ] keep stream-flush ;
  11
  12 : log-error ( str -- ) "Error: " swap append log-message ;
  13
  14 : log-client ( client -- )
  15     [
  16         "Accepted connection from " %
  17         dup client-stream-host %
  18         CHAR: : ,
  19         client-stream-port #
  20     ] "" make log-message ;
  21
  22 : with-log-file ( path quot -- )
  23     [ swap <file-writer> log-stream set call ] with-scope ;
  24
  25 : with-logging ( quot -- )
  26     [ stdio get log-stream set call ] with-scope ;
  27
  28 : with-client ( quot client -- )
  29     dup log-client [ swap with-stream ] in-thread 2drop ;
  30     inline
  31
  32 SYMBOL: server-stream
  33
  34 : server-loop ( quot -- )
  35     server-stream get accept over
  36     >r with-client r> server-loop ; inline
  37
  38 : with-server ( port ident quot -- )
  39     >r >r <server> dup r> set r> swap [
  40         server-stream set
  41         [ server-loop ]
  42         [ server-stream get stream-close ] cleanup
  43     ] with-logging ; inline