Fixed the incorrect parsing of the TCP stream.

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 $
+botReader env handle mctx chan = do
-    fmap L.toString (recvData ctx) `catch` handleIOException env  "botReader died" >>= handleIncomingStr chan
+    ioException <- botTrueReader "" `catch` return
-botReader env handle Nothing chan = forever $
+    runReaderT (setGlobalQuitMVar $ BotRestart (show ioException, Just "botReader died")) env
-    hGetLine handle `catch` handleIOException env "botReader died" >>= handleIncomingStr chan
+  where
-
+    botTrueReader :: String -> IO IOException
-handleIOException :: BotEnv -> String -> IOException -> IO String
+    botTrueReader buff = do
-handleIOException env msg ioException = do
+        str <- readThis handle mctx
-    runReaderT (setGlobalQuitMVar $ BotRestart (show ioException, Just msg)) env
+        case parse messages [] (buff ++ str) of
-    myId <- myThreadId
+            Right (msgs, trash) -> do
-    killThread myId
+                mapM_ handleMessage msgs
-    return ""
+                botTrueReader trash
-
+            Left err -> do
-handleIncomingStr :: Chan Message -> String -> IO ()
+                errorM "Hsbot.Reader" $ "Reader decode error (" ++ show err ++ ") on " ++ str
-handleIncomingStr chan str =
+                botTrueReader ""
-    case IRC.decode str of
+    messages = do
-        Just msg -> do
+        msgs <- many1 message
-            debugM "Hsbot.Reader" $ "<-- " ++ show msg
+        trash <- option "" $ many1 anyChar
-            writeChan chan $ IncomingMsg msg
+        return (msgs, trash)
-        Nothing -> return ()
+    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

hsbot.cabal

@@ -42,6 +42,7 @@ Library
                     irc,
                     mtl,
                     network,
+                    parsec,
                     random,
                     safecopy,
                     tls >= 0.8.1,