12 import CoreTypes |
12 import CoreTypes |
13 import RoomsAndClients |
13 import RoomsAndClients |
14 |
14 |
15 listenLoop :: Handle -> Int -> [String] -> Chan CoreMessage -> ClientIndex -> IO () |
15 listenLoop :: Handle -> Int -> [String] -> Chan CoreMessage -> ClientIndex -> IO () |
16 listenLoop handle linesNumber buf chan clientID = do |
16 listenLoop handle linesNumber buf chan clientID = do |
|
17 putStrLn $ show handle ++ show buf ++ show clientID |
17 str <- liftM BUTF8.toString $ B.hGetLine handle |
18 str <- liftM BUTF8.toString $ B.hGetLine handle |
18 if (linesNumber > 50) || (length str > 450) then |
19 if (linesNumber > 50) || (length str > 450) then |
19 writeChan chan $ ClientMessage (clientID, ["QUIT", "Protocol violation"]) |
20 protocolViolationMsg >> freeClient |
20 else |
21 else |
21 if str == "" then do |
22 if str == "" then do |
22 writeChan chan $ ClientMessage (clientID, buf) |
23 writeChan chan $ ClientMessage (clientID, reverse buf) |
23 yield |
24 yield |
24 listenLoop handle 0 [] chan clientID |
25 listenLoop handle 0 [] chan clientID |
25 else |
26 else |
26 listenLoop handle (linesNumber + 1) (buf ++ [str]) chan clientID |
27 listenLoop handle (linesNumber + 1) (str : buf) chan clientID |
|
28 where |
|
29 protocolViolationMsg = writeChan chan $ ClientMessage (clientID, ["QUIT", "Protocol violation"]) |
|
30 freeClient = writeChan chan $ FreeClient clientID |
|
31 |
27 |
32 |
28 clientRecvLoop :: Handle -> Chan CoreMessage -> ClientIndex -> IO () |
33 clientRecvLoop :: Handle -> Chan CoreMessage -> ClientIndex -> IO () |
29 clientRecvLoop handle chan clientID = |
34 clientRecvLoop handle chan clientID = |
30 listenLoop handle 0 [] chan clientID |
35 listenLoop handle 0 [] chan clientID |
31 `catch` (\e -> clientOff (show e) >> return ()) |
36 `catch` (\e -> clientOff (show e) >> freeClient >> return ()) |
32 where clientOff msg = writeChan chan $ ClientMessage (clientID, ["QUIT", msg]) -- if the client disconnects, we perform as if it sent QUIT message |
37 where |
|
38 clientOff msg = writeChan chan $ ClientMessage (clientID, ["QUIT", msg]) -- if the client disconnects, we perform as if it sent QUIT message |
|
39 freeClient = writeChan chan $ FreeClient clientID |
33 |
40 |
34 clientSendLoop :: Handle -> Chan CoreMessage -> Chan [String] -> ClientIndex -> IO() |
41 clientSendLoop :: Handle -> Chan CoreMessage -> Chan [String] -> ClientIndex -> IO() |
35 clientSendLoop handle coreChan chan clientID = do |
42 clientSendLoop handle coreChan chan clientID = do |
36 answer <- readChan chan |
43 answer <- readChan chan |
37 doClose <- Exception.handle |
44 doClose <- Exception.handle |