From 4776e0843d3a3f663772ba3fdc6d353b10904a7f Mon Sep 17 00:00:00 2001 From: Abhinav Sarkar Date: Sun, 4 May 2014 07:03:23 +0530 Subject: [PATCH] Added reconnected/rejoin support in case of disconnects/kick/kickban --- Network/IRC/Client.hs | 90 +++++++++++++++++++++++++++++------------ Network/IRC/Main.hs | 3 +- Network/IRC/Protocol.hs | 22 +++++----- Network/IRC/Types.hs | 2 + 4 files changed, 80 insertions(+), 37 deletions(-) diff --git a/Network/IRC/Client.hs b/Network/IRC/Client.hs index b423ce7..68e8dd8 100644 --- a/Network/IRC/Client.hs +++ b/Network/IRC/Client.hs @@ -2,62 +2,102 @@ module Network.IRC.Client(run) where -import qualified Control.Exception as E +import Control.Exception import Control.Concurrent import Control.Monad.Reader import Network +import Prelude hiding (log) import System.IO import System.Time +import System.Timeout import Text.Printf import Network.IRC.Handlers import Network.IRC.Protocol import Network.IRC.Types +data Status = Connected | Disconnected | Joined | Kicked | Errored + deriving (Show, Eq) + +oneSec = 1000000 + io = liftIO +log msg = putStrLn $ "** " ++ msg + sendCommand :: Bot -> Command -> IO () sendCommand Bot{ .. } reply = do let line = lineFromCommand botConfig reply hPrintf socket "%s\r\n" line >> printf "> %s\n" line -listen :: IRC () -listen = forever $ do +listen :: Status -> IRC Status +listen status = do bot@Bot{ .. } <- ask + let nick = botNick botConfig - line <- fmap init $ io $ hGetLine socket - time <- io getClockTime + when (status == Kicked) $ + io $ threadDelay (5 * oneSec) >> sendCommand bot JoinCmd - io $ printf "[%s] %s\n" (show time) line + mLine <- io . timeout (oneSec * botTimeout botConfig) . hGetLine $ socket + case mLine of + Nothing -> return Disconnected + Just l -> do + let line = init l + time <- io getClockTime - io $ forkIO $ case msgFromLine botConfig time line of - Ping { .. } -> sendCommand bot $ Pong msg - ModeMsg { user = Self, .. } -> sendCommand bot JoinCmd - msg -> forM_ (handlers botConfig) $ \handler -> do - cmd <- handleMessage handler botConfig msg - case cmd of - Nothing -> return () - Just cmd -> sendCommand bot cmd + io $ printf "[%s] %s\n" (show time) line + + let message = msgFromLine botConfig time line + nStatus <- io $ case message of + JoinMsg { .. } | userNick user == nick -> log "Joined" >> return Joined + KickMsg { .. } -> log "Kicked" >> return Kicked + _ -> do + forkIO $ case message of + Ping { .. } -> sendCommand bot $ Pong msg + ModeMsg { user = Self, .. } -> sendCommand bot JoinCmd + msg -> forM_ (handlers botConfig) $ \handler -> do + cmd <- handleMessage handler botConfig msg + case cmd of + Nothing -> return () + Just cmd -> sendCommand bot cmd + return status + + listen nStatus connect :: BotConfig -> IO Bot connect botConfig@BotConfig{ .. } = do - putStrLn "** Connecting ..." - handle <- connectTo server (PortNumber (fromIntegral port)) + log "Connecting ..." + handle <- connectToWithRetry hSetBuffering handle LineBuffering hSetBuffering stdout LineBuffering - putStrLn "** Connected" + log "Connected" return $ Bot botConfig handle + where + connectToWithRetry = connectTo server (PortNumber (fromIntegral port)) + `catch` (\(e :: SomeException) -> do + log ("Error: " ++ show e ++ ". Waiting.") + threadDelay (5 * oneSec) + connectToWithRetry) disconnect :: Bot -> IO () disconnect bot = do - putStrLn "** Disconnecting ..." + log "Disconnecting ..." hClose . socket $ bot - putStrLn "** Disconnected" + log "Disconnected" run :: BotConfig -> IO () -run botConfig = E.bracket (connect botConfig) disconnect $ \bot -> - E.catch (run_ bot) (\(e :: E.SomeException) -> putStrLn $ "Exception! " ++ show e) - where - run_ bot = do - sendCommand bot NickCmd >> sendCommand bot UserCmd - runReaderT listen bot +run botConfig = withSocketsDo $ do + status <- run_ + case status of + Disconnected -> log "Connection timedout" >> run botConfig + Errored -> return () + where + run_ = bracket (connect botConfig) disconnect $ \bot -> + go bot `catch` \(e :: SomeException) -> do + log $ "Exception! " ++ show e + return Errored + + go bot = do + sendCommand bot NickCmd + sendCommand bot UserCmd + runReaderT (listen Connected) bot diff --git a/Network/IRC/Main.hs b/Network/IRC/Main.hs index 9acf5e8..d2a008a 100644 --- a/Network/IRC/Main.hs +++ b/Network/IRC/Main.hs @@ -19,5 +19,4 @@ main = do if length args < 4 then putStrLn ("Usage: " ++ prog ++ " ") >> exitFailure - else run $ BotConfig server port channel botNick handlers - + else run $ BotConfig server port channel botNick 120 handlers diff --git a/Network/IRC/Protocol.hs b/Network/IRC/Protocol.hs index f376841..e888138 100644 --- a/Network/IRC/Protocol.hs +++ b/Network/IRC/Protocol.hs @@ -15,6 +15,7 @@ msgFromLine (BotConfig { .. }) time line "JOIN" -> JoinMsg time user "QUIT" -> QuitMsg time user message "PART" -> PartMsg time user message + "KICK" -> KickMsg time user kickReason "MODE" -> if source == botNick then ModeMsg time Self target message [] else ModeMsg time user target mode modeArgs @@ -24,16 +25,17 @@ msgFromLine (BotConfig { .. }) time line else PrivMsg time user message _ -> OtherMsg time source command target message where - isSpc = (== ' ') - isNotSpc = not . isSpc - splits = splitWhen isSpc line - source = drop 1 . takeWhile isNotSpc $ line - target = splits !! 2 - command = splits !! 1 - message = drop 1 . unwords . drop 3 $ splits - user = let u = splitWhen (== '!') source in User (u !! 0) (u !! 1) - mode = splits !! 3 - modeArgs = drop 4 splits + isSpc = (== ' ') + isNotSpc = not . isSpc + splits = splitWhen isSpc line + source = drop 1 . takeWhile isNotSpc $ line + target = splits !! 2 + command = splits !! 1 + message = drop 1 . unwords . drop 3 $ splits + user = let u = splitWhen (== '!') source in User (u !! 0) (u !! 1) + mode = splits !! 3 + modeArgs = drop 4 splits + kickReason = drop 1 . unwords . drop 4 $ splits lineFromCommand :: BotConfig -> Command -> String lineFromCommand (BotConfig { .. }) reply = case reply of diff --git a/Network/IRC/Types.hs b/Network/IRC/Types.hs index d5e4b4d..88154d4 100644 --- a/Network/IRC/Types.hs +++ b/Network/IRC/Types.hs @@ -22,6 +22,7 @@ data Message = | NickMsg { time :: ClockTime, user :: User, nick :: String } | QuitMsg { time :: ClockTime, user :: User, msg :: String } | PartMsg { time :: ClockTime, user :: User, msg :: String } + | KickMsg { time :: ClockTime, user :: User, msg :: String } | OtherMsg { time :: ClockTime, source :: String, command :: String , target :: String, msg :: String } deriving (Show, Eq) @@ -39,6 +40,7 @@ data BotConfig = BotConfig { server :: String , port :: Int , channel :: String , botNick :: String + , botTimeout :: Int , handlers :: [HandlerName] } deriving (Show, Eq) data Bot = Bot { botConfig :: BotConfig, socket :: Handle } deriving (Show, Eq)