summaryrefslogtreecommitdiff
path: root/Hsbot
diff options
context:
space:
mode:
authorJulien Dessaux2011-11-03 21:54:11 +0100
committerJulien Dessaux2011-11-03 21:54:11 +0100
commit938657be77cac36e4f6bae2b2b1c6aaa15c41f5a (patch)
tree3db7a42ec2ae7d924b9fbaa2b2174f806a22c0cf /Hsbot
parentTaking advantage of the new TLS debugging capabilities (diff)
downloadhsbot-938657be77cac36e4f6bae2b2b1c6aaa15c41f5a.tar.gz
hsbot-938657be77cac36e4f6bae2b2b1c6aaa15c41f5a.tar.bz2
hsbot-938657be77cac36e4f6bae2b2b1c6aaa15c41f5a.zip
Fixed the incorrect parsing of the TCP stream.
Diffstat (limited to '')
-rw-r--r--Hsbot/Core.hs52
1 files changed, 33 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