equal
deleted
inserted
replaced
4 import qualified Control.Exception as Exception |
4 import qualified Control.Exception as Exception |
5 import Control.Concurrent.Chan |
5 import Control.Concurrent.Chan |
6 import Control.Concurrent |
6 import Control.Concurrent |
7 import Control.Monad |
7 import Control.Monad |
8 import System.IO |
8 import System.IO |
|
9 import qualified Data.ByteString.UTF8 as BUTF8 |
|
10 import qualified Data.ByteString as B |
9 ---------------- |
11 ---------------- |
10 import CoreTypes |
12 import CoreTypes |
11 |
13 |
12 listenLoop :: Handle -> Int -> [String] -> Chan CoreMessage -> Int -> IO () |
14 listenLoop :: Handle -> Int -> [String] -> Chan CoreMessage -> Int -> IO () |
13 listenLoop handle linesNumber buf chan clientID = do |
15 listenLoop handle linesNumber buf chan clientID = do |
14 str <- hGetLine handle |
16 str <- liftM BUTF8.toString $ B.hGetLine handle |
15 if (linesNumber > 50) || (length str > 450) then |
17 if (linesNumber > 50) || (length str > 450) then |
16 writeChan chan $ ClientMessage (clientID, ["QUIT", "Protocol violation"]) |
18 writeChan chan $ ClientMessage (clientID, ["QUIT", "Protocol violation"]) |
17 else |
19 else |
18 if str == "" then do |
20 if str == "" then do |
19 writeChan chan $ ClientMessage (clientID, buf) |
21 writeChan chan $ ClientMessage (clientID, buf) |
31 clientSendLoop :: Handle -> Chan CoreMessage -> Chan [String] -> Int -> IO() |
33 clientSendLoop :: Handle -> Chan CoreMessage -> Chan [String] -> Int -> IO() |
32 clientSendLoop handle coreChan chan clientID = do |
34 clientSendLoop handle coreChan chan clientID = do |
33 answer <- readChan chan |
35 answer <- readChan chan |
34 doClose <- Exception.handle |
36 doClose <- Exception.handle |
35 (\(e :: Exception.IOException) -> if isQuit answer then return True else sendQuit e >> return False) $ do |
37 (\(e :: Exception.IOException) -> if isQuit answer then return True else sendQuit e >> return False) $ do |
36 forM_ answer (hPutStrLn handle) |
38 B.hPutStrLn handle $ BUTF8.fromString $ unlines (answer ++ [""]) |
37 hPutStrLn handle "" |
|
38 hFlush handle |
39 hFlush handle |
39 return $ isQuit answer |
40 return $ isQuit answer |
40 |
41 |
41 if doClose then |
42 if doClose then |
42 Exception.handle (\(_ :: Exception.IOException) -> putStrLn "error on hClose") $ hClose handle |
43 Exception.handle (\(_ :: Exception.IOException) -> putStrLn "error on hClose") $ hClose handle |