Added exception handling, an autorestart when that happens and output in case of restart/reload

Hsbot.hs

@@ -5,13 +5,19 @@ module Hsbot
 import qualified Config.Dyre as Dyre
 import Config.Dyre.Relaunch
 import Control.Monad.Reader
+import qualified Data.Map as M
 import System.Log.Logger
+import qualified Network.IRC as IRC
 
 import Hsbot.Core
 import Hsbot.Types
+import Hsbot.Utils
+
+data State = State (M.Map String String) deriving (Read, Show)
 
 startHsbot :: Config -> IO ()
 startHsbot config = do
+    (State buffer) <- restoreTextState $ State M.empty
     -- checking for configuration file compilation error
     case configErrors config of
          Nothing -> return ()
@@ -19,16 +25,34 @@ startHsbot config = do
     -- initialization
     infoM "Hsbot" "Bot initializations"
     hsbotEnv <- initHsbot config
+    -- Handle previous exit state if it exists
+    die_msgs <- case M.lookup "die_msg" buffer of
+        Just dieMsg -> case reads dieMsg :: [(BotStatus, String)] of
+            (status, _):_ -> case status of
+                BotReload reason -> return ["hsbot reloaded, reason : " ++ reason]
+                BotRestart (reason, Just info) -> return ["hsbot restarted, readon : " ++ reason, "additional information: " ++ info]
+                BotRestart (reason, Nothing) -> return ["hsbot restarted, readon : " ++ reason]
+                BotExit -> return []
+            _ -> return ["hsbot die_msg parsing error, this should not happen"]
+        Nothing -> return []
+    let connhdl  = envHandle hsbotEnv
+        tlsCtx   = envTLSCtx hsbotEnv
+        channels = configChannels config
+    mapM_ (infoM "Hsbot") die_msgs
+    mapM_ (\msg -> mapM_ (\channel -> sendStr hsbotEnv connhdl tlsCtx . IRC.encode $ IRC.Message Nothing "PRIVMSG" [channel, msg]) channels) die_msgs
     -- main stuff
     infoM "Hsbot" "Bot core starting"
     status <- runReaderT runHsbot hsbotEnv
     infoM "Hsbot" $ "Bot core exited with status " ++ show status
     -- Handling exit signal
     case status of
-         BotContinue -> startHsbot config -- TODO do something not so dumb about starting over
          BotExit -> runReaderT terminateHsbot hsbotEnv
-         BotReload -> relaunchMaster Nothing -- TODO relaunchWithTextState (state { stateConfig = config }) Nothing, add a flag that prevent spawning the sockets again
+         BotReload reason -> do
-         BotRestart -> relaunchMaster Nothing -- TODO relaunch and kill sockets
+             runReaderT terminateHsbot hsbotEnv
+             relaunchWithTextState (M.singleton "die_msg" . show $ BotReload reason) Nothing  -- TODO find a way to properly implement that, then insert necessary information in this MVar
+         BotRestart reason -> do
+             runReaderT terminateHsbot hsbotEnv
+             relaunchWithTextState (M.singleton "die_msg" . show $ BotRestart reason) Nothing
 
 hsbot :: Config -> IO ()
 hsbot = Dyre.wrapMain $ Dyre.defaultParams

Hsbot/Core.hs

@@ -70,10 +70,10 @@ runHsbot = do
             config   = envConfig env
             nickname = head $ configNicknames config
             channels = configChannels config
-        liftIO . sendStr connhdl tlsCtx . IRC.encode $ IRC.nick nickname
+        liftIO . sendStr env connhdl tlsCtx . IRC.encode $ IRC.nick nickname
-        liftIO . sendStr connhdl tlsCtx . IRC.encode $ IRC.user nickname hostname "*" (configRealname config)
+        liftIO . sendStr env connhdl tlsCtx . IRC.encode $ IRC.user nickname hostname "*" (configRealname config)
         -- Then we join channels
-        mapM_ (liftIO . sendStr connhdl tlsCtx . IRC.encode . IRC.joinChan) channels
+        mapM_ (liftIO . sendStr env connhdl tlsCtx . IRC.encode . IRC.joinChan) channels
         -- Finally we set the new bot state
         asks envBotState >>= liftIO . flip putMVar BotState { botPlugins  = M.empty
                                                             , botAccess   = configAccess config
@@ -88,9 +88,8 @@ runHsbot = do
         liftIO $ debugM "Hsbot.Core" "Spawning reader thread"
         let connhdl  = envHandle env
             tlsCtx   = envTLSCtx env
-        myOwnThreadId  <- liftIO myThreadId
         chan <- asks envChan
-        (liftIO . forkIO $ botReader connhdl tlsCtx chan myOwnThreadId) >>= addThreadIdToQuitMVar
+        (liftIO . forkIO $ botReader env connhdl tlsCtx chan) >>= addThreadIdToQuitMVar
         -- Then we spawn all plugins
         asks envConfig >>= mapM_ loadPlugin . configPlugins
         -- Finally we spawn the main bot loop
@@ -102,18 +101,18 @@ runHsbot = do
         -- TODO : kill plugin threads
         return code
 
-botReader :: Handle -> Maybe TLSCtx -> Chan Message -> ThreadId -> IO ()
+botReader :: BotEnv -> Handle -> Maybe TLSCtx -> Chan Message -> IO ()
-botReader _ (Just ctx) chan _ = forever $
+botReader env _ (Just ctx) chan = forever $
-    fmap L.toString (recvData ctx) >>= handleIncomingStr chan  -- TODO exceptions
+    fmap L.toString (recvData ctx) `catch` handleIOException env  "botReader died" >>= handleIncomingStr chan
-botReader handle Nothing chan fatherThreadId = forever $
+botReader env handle Nothing chan = forever $
-    hGetLine handle `catch` handleIOException >>= handleIncomingStr chan
+    hGetLine handle `catch` handleIOException env "botReader died" >>= handleIncomingStr chan
-  where
+
-    handleIOException :: IOException -> IO String
+handleIOException :: BotEnv -> String -> IOException -> IO String
-    handleIOException ioException = do
+handleIOException env msg ioException = do
-        throwTo fatherThreadId ioException
+    runReaderT (setGlobalQuitMVar $ BotRestart (show ioException, Just msg)) env
-        myId <- myThreadId
+    myId <- myThreadId
-        killThread myId
+    killThread myId
-        return ""
+    return ""
 
 handleIncomingStr :: Chan Message -> String -> IO ()
 handleIncomingStr chan str =
@@ -136,7 +135,7 @@ botLoop = forever $ do
             let connhdl  = envHandle env
                 tlsCtx   = envTLSCtx env
             liftIO $ debugM "Hsbot.Loop" $ "--> " ++ show outMsg
-            liftIO . sendStr connhdl tlsCtx $ IRC.encode outMsg
+            liftIO . sendStr env connhdl tlsCtx $ IRC.encode outMsg
 
 terminateHsbot :: Env IO ()
 terminateHsbot = do

Hsbot/Plugin/Admin.hs

@@ -33,11 +33,11 @@ theAdmin = forever $ readMsg >>= eval
                         else answerMsg msg "Only admins can do that."
                 "restart":"help":_ -> answerMsg msg "restart hsbot, reset the running state to config file directives."
                 "restart":_ -> lift (hasAccess (IRC.msg_prefix msg) Admin) >>= \right -> if right
-                        then lift $ setGlobalQuitMVar BotRestart
+                        then lift . setGlobalQuitMVar $ BotRestart (getSender msg ++ " request", Nothing)
                         else answerMsg msg "Only admins can do that."
                 "reload":"help":_ -> answerMsg msg "reload hsbot, and try merge the new config file directives with actual running state)."
                 "reload":_ -> lift (hasAccess (IRC.msg_prefix msg) Admin) >>= \right -> if right
-                        then lift $ setGlobalQuitMVar BotReload
+                        then lift . setGlobalQuitMVar . BotReload $ getSender msg ++ " request"
                         else answerMsg msg "Only admins can do that."
                 _ -> return ()
         | otherwise = return ()

Hsbot/Types.hs

@@ -66,7 +66,7 @@ data PluginId = PluginId
 data Message = IncomingMsg IRC.Message
              | OutgoingMsg IRC.Message
 
-data BotStatus = BotContinue | BotExit | BotReload | BotRestart deriving (Show)
+data BotStatus = BotExit | BotReload String | BotRestart (String, Maybe String) deriving (Read, Show)
 
 -- Config
 data Config = Config

Hsbot/Utils.hs

@@ -8,12 +8,14 @@ module Hsbot.Utils
     ) where
 
 import Control.Concurrent
+import Control.Exception (IOException, catch)
 import Control.Monad.Reader
 import Control.Monad.State
 import qualified Data.ByteString.Lazy.UTF8 as L
 import qualified Data.List as L
 import qualified Network.IRC as IRC
 import Network.TLS
+import Prelude hiding (catch)
 import System.IO
 
 import Hsbot.Types
@@ -47,9 +49,16 @@ hasAccess (Just mask) right = do
       | otherwise = False
 
 -- Helpers
-sendStr :: Handle -> Maybe TLSCtx -> String -> IO ()
+sendStr :: BotEnv -> Handle -> Maybe TLSCtx -> String -> IO ()
-sendStr _ (Just ctx) msg = sendData ctx . L.fromString $ msg ++ "\r\n"
+sendStr env _ (Just ctx) msg = sendData ctx (L.fromString $ msg ++ "\r\n") `catch` handleIOException env ("sendStr " ++ msg)
-sendStr handle Nothing msg = hPutStrLn handle $ msg ++ "\r\n"
+sendStr env handle Nothing msg = hPutStrLn handle (msg ++ "\r\n") `catch` handleIOException env ("sendStr " ++ msg)
+
+handleIOException :: BotEnv -> String -> IOException -> IO ()
+handleIOException env msg ioException = do
+    runReaderT (setGlobalQuitMVar $ BotRestart (show ioException, Just msg)) env
+    myId <- myThreadId
+    killThread myId
+    return ()
 
 -- TLS utils
 initTLSEnv :: TLSConfig -> IO TLSParams

TODO

@@ -1,7 +1,7 @@
 * better hooks?
 * add help MVar
 * add regexes support in accessList prefix
-
+* exception handling on channel and MVar operations?
 
 
 
@@ -9,7 +9,6 @@
 
 :julien!~julien@ogu21.corp PRIVMSG #shbot :@quote graou snif
 
-* Improve configuration file errors display
 * fork process in background
 
 * add a function to answer by /msg to somebody
@@ -18,16 +17,10 @@
 * detect too identical quoting in a raw, or implement quote abort
 * find a better way to track who voted for what? - need authentication against the bot
 
-* write the help module
-* clean the plugin module
-* clean cleaning for the quote module
 * write a channel tracking plugin. Write the part chan command
 
-* add a plugin for admin checks and tracking
+* add a plugin for admin rights checking and user tracking
 * add a plugin for timer functionnalities other plugin could subscribe to (the troll plugin).
-* add a "I have stuff to save so don't kill me too hard" status for plugins
-
-* Make the bot auto-reconnect (/!\ admin plugin!)
 
 * Find a way to prevent the socket from being garbage collected, by writing a connection handler for example
 * Find a way so that not a single message/information would be lost in the case of a reboot