6 import Control.Monad |
6 import Control.Monad |
7 import System.IO |
7 import System.IO |
8 ---------------- |
8 ---------------- |
9 import CoreTypes |
9 import CoreTypes |
10 |
10 |
11 listenLoop :: Handle -> [String] -> Chan CoreMessage -> Int -> IO () |
11 listenLoop :: Handle -> Int -> [String] -> Chan CoreMessage -> Int -> IO () |
12 listenLoop handle buf chan clientID = do |
12 listenLoop handle linesNumber buf chan clientID = do |
13 str <- hGetLine handle |
13 str <- hGetLine handle |
14 if str == "" then do |
14 if (linesNumber > 50) || (length str > 450) then |
15 writeChan chan $ ClientMessage (clientID, buf) |
15 writeChan chan $ ClientMessage (clientID, ["QUIT", "Protocol violation"]) |
16 listenLoop handle [] chan clientID |
|
17 else |
16 else |
18 listenLoop handle (buf ++ [str]) chan clientID |
17 if str == "" then do |
|
18 writeChan chan $ ClientMessage (clientID, buf) |
|
19 listenLoop handle 0 [] chan clientID |
|
20 else |
|
21 listenLoop handle (linesNumber + 1) (buf ++ [str]) chan clientID |
19 |
22 |
20 clientRecvLoop :: Handle -> Chan CoreMessage -> Int -> IO () |
23 clientRecvLoop :: Handle -> Chan CoreMessage -> Int -> IO () |
21 clientRecvLoop handle chan clientID = |
24 clientRecvLoop handle chan clientID = |
22 listenLoop handle [] chan clientID |
25 listenLoop handle 0 [] chan clientID |
23 `catch` (\e -> (clientOff $ show e) >> return ()) |
26 `catch` (\e -> (clientOff $ show e) >> return ()) |
24 where clientOff msg = writeChan chan $ ClientMessage (clientID, ["QUIT", msg]) -- if the client disconnects, we perform as if it sent QUIT message |
27 where clientOff msg = writeChan chan $ ClientMessage (clientID, ["QUIT", msg]) -- if the client disconnects, we perform as if it sent QUIT message |
25 |
28 |
26 clientSendLoop :: Handle -> Chan CoreMessage -> Chan [String] -> Int -> IO() |
29 clientSendLoop :: Handle -> Chan CoreMessage -> Chan [String] -> Int -> IO() |
27 clientSendLoop handle coreChan chan clientID = do |
30 clientSendLoop handle coreChan chan clientID = do |