From 938657be77cac36e4f6bae2b2b1c6aaa15c41f5a Mon Sep 17 00:00:00 2001
From: Julien Dessaux
Date: Thu, 3 Nov 2011 21:54:11 +0100
Subject: Fixed the incorrect parsing of the TCP stream.

---
 Hsbot/Core.hs | 52 +++++++++++++++++++++++++++++++++-------------------
 hsbot.cabal   |  1 +
 2 files changed, 34 insertions(+), 19 deletions(-)

diff --git a/Hsbot/Core.hs b/Hsbot/Core.hs
index 7f97918..43276f9 100644
--- a/Hsbot/Core.hs
+++ b/Hsbot/Core.hs
@@ -17,6 +17,7 @@ import Network.TLS
 import Prelude hiding (catch)
 import System.IO
 import System.Log.Logger
+import Text.ParserCombinators.Parsec
 
 import Hsbot.Plugin
 import Hsbot.Types
@@ -104,25 +105,38 @@ runHsbot die_msgs = do
         return code
 
 botReader :: BotEnv -> Handle -> Maybe (TLSCtx Handle) -> Chan Message -> IO ()
-botReader env _ (Just ctx) chan = forever $
-    fmap L.toString (recvData ctx) `catch` handleIOException env  "botReader died" >>= handleIncomingStr chan
-botReader env handle Nothing chan = forever $
-    hGetLine handle `catch` handleIOException env "botReader died" >>= handleIncomingStr chan
-
-handleIOException :: BotEnv -> String -> IOException -> IO String
-handleIOException env msg ioException = do
-    runReaderT (setGlobalQuitMVar $ BotRestart (show ioException, Just msg)) env
-    myId <- myThreadId
-    killThread myId
-    return ""
-
-handleIncomingStr :: Chan Message -> String -> IO ()
-handleIncomingStr chan str =
-    case IRC.decode str of
-        Just msg -> do
-            debugM "Hsbot.Reader" $ "<-- " ++ show msg
-            writeChan chan $ IncomingMsg msg
-        Nothing -> return ()
+botReader env handle mctx chan = do
+    ioException <- botTrueReader "" `catch` return
+    runReaderT (setGlobalQuitMVar $ BotRestart (show ioException, Just "botReader died")) env
+  where
+    botTrueReader :: String -> IO IOException
+    botTrueReader buff = do
+        str <- readThis handle mctx
+        case parse messages [] (buff ++ str) of
+            Right (msgs, trash) -> do
+                mapM_ handleMessage msgs
+                botTrueReader trash
+            Left err -> do
+                errorM "Hsbot.Reader" $ "Reader decode error (" ++ show err ++ ") on " ++ str
+                botTrueReader ""
+    messages = do
+        msgs <- many1 message
+        trash <- option "" $ many1 anyChar
+        return (msgs, trash)
+    message = do
+        mess <- many1 $ noneOf "\r\n"
+        end <- string "\r\n" <|> string "\r" <|> string "\n"
+        return $ mess ++ end
+    handleMessage :: String -> IO ()
+    handleMessage str =
+        case IRC.decode str of
+            Just msg -> do
+                debugM "Hsbot.Reader" $ "<-- " ++ show msg
+                writeChan chan $ IncomingMsg msg
+            Nothing -> return ()
+    readThis :: Handle -> Maybe (TLSCtx Handle) -> IO String
+    readThis _ (Just ctx) = fmap L.toString (recvData ctx)
+    readThis h Nothing = hGetLine h
 
 botLoop :: Env IO ()
 botLoop = forever $ do
diff --git a/hsbot.cabal b/hsbot.cabal
index 481f026..1a4acf6 100644
--- a/hsbot.cabal
+++ b/hsbot.cabal
@@ -42,6 +42,7 @@ Library
                     irc,
                     mtl,
                     network,
+                    parsec,
                     random,
                     safecopy,
                     tls >= 0.8.1,
-- 
cgit v1.2.3