| iproctor | ff8eb92 | 2007-07-25 19:06:13 +0000 | [diff] [blame^] | 1 | module TServer(run_basic_server,run_threaded_server) where |
| 2 | |
| 3 | import Network |
| 4 | import Thrift |
| 5 | import Control.Exception |
| 6 | import TBinaryProtocol |
| 7 | import TChannelTransport |
| 8 | import Control.Concurrent |
| 9 | |
| 10 | proc_loop hand proc ps = do v <-proc hand ps |
| 11 | if v then proc_loop hand proc ps |
| 12 | else return () |
| 13 | |
| 14 | accept_loop hand sock proc transgen iprotgen oprotgen = |
| 15 | do (h,hn,_) <- accept sock |
| 16 | let t = transgen h |
| 17 | let ip = iprotgen t |
| 18 | let op = oprotgen t |
| 19 | forkIO (handle (\e -> return ()) (proc_loop hand proc (ip,op))) |
| 20 | accept_loop hand sock proc transgen iprotgen oprotgen |
| 21 | |
| 22 | run_threaded_server hand proc port transgen iprotgen oprotgen = |
| 23 | do sock <- listenOn (PortNumber port) |
| 24 | accept_loop hand sock proc transgen iprotgen oprotgen |
| 25 | return () |
| 26 | |
| 27 | |
| 28 | -- A basic threaded binary protocol socket server. |
| 29 | run_basic_server hand proc port = run_threaded_server hand proc port TChannelTrans TBinaryProtocol TBinaryProtocol |