Implemented the clean killing of plugins' threads.

Hsbot/Core.hs

@@ -31,9 +31,11 @@ hsbot config = do
                                                     , botResumeData = mvar }
     putStrLn "[Hsbot] Entering main loop... "
     (status, botState') <- runLoop botState
+    putStrLn "[Hsbot] Killing active plugins... "
     resumeData <- takeMVar mvar
+    evalStateT (mapM_ killPlugin $ M.keys resumeData) botState'
     if status == BotReboot
-      then resumeHsbot botState' resumeData
+      then resumeHsbot resumeData
       else return ()
   where
     runLoop :: BotState -> IO (BotStatus, BotState)
@@ -43,8 +45,8 @@ hsbot config = do
             BotContinue -> runLoop botState'
             _           -> return (status, botState')
 
-resumeHsbot :: BotState -> BotResumeData -> IO ()
+resumeHsbot :: BotResumeData -> IO ()
-resumeHsbot botState resumeData = do
+resumeHsbot resumeData = do
     print resumeData
 
 -- | Run the bot main loop

Hsbot/Irc/Core.hs

@@ -3,7 +3,7 @@ module Hsbot.Irc.Core
     ) where
 
 import Control.Concurrent
-import Control.Exception (IOException, catch)
+import Control.Exception (AsyncException, Handler (..), IOException, catch, catches)
 import Control.Monad.State
 import qualified Data.Map as M
 import Data.Maybe (fromMaybe)
@@ -34,7 +34,7 @@ startIrcbot config masterChan myChan = do
     putStrLn "[IrcBot] Spawning reader threads..."
     myOwnThreadId  <- myThreadId
     readerThreadId <- forkIO $ ircBotReader handle chan myOwnThreadId
-    masterReaderThreadId <- forkIO $ ircBotMasterReader masterChan chan
+    masterReaderThreadId <- forkIO $ ircBotMasterReader myChan chan
     putStrLn "[IrcBot] Initializing server connection..."
     let ircServerState = IrcServerState { ircServerId            = ircConfigAddress config
                                         , ircServerChannels      = []
@@ -46,18 +46,23 @@ startIrcbot config masterChan myChan = do
                                   , ircBotCommands             = M.empty
                                   , ircBotChan                 = chan
                                   , ircBotMasterChan           = masterChan
-                                  , ircBotMyChan               = myChan
                                   , ircBotServerState          = ircServerState
                                   , ircBotHandle               = handle
                                   , ircBotConfig               = config
-                                  , ircBotReaderThreadId       = readerThreadId
-                                  , ircBotMasterReaderThreadId = masterReaderThreadId
                                   , ircBotResumeData           = M.singleton "HANDLE" (show fd) }
     ircBotState' <- execStateT (initBotServerConnection config) ircBotState
     putStrLn "[IrcBot] Spawning plugins..."
     ircBotState'' <- execStateT spawnIrcPlugins ircBotState'
     putStrLn "[IrcBot] Entering Core loop... "
-    (evalStateT ircBotLoop ircBotState'') `catch` (\(_ :: IOException) -> return ())
+    ircBotState''' <- (execStateT ircBotLoop ircBotState'') `catches` [ Handler (\ (_ :: IOException) -> return (ircBotState''))
+                                                                      , Handler (\ (_ :: AsyncException) -> return (ircBotState'')) ]
+    putStrLn "[IrcBot] Killing reader threads..."
+    killThread readerThreadId
+    killThread masterReaderThreadId
+    putStrLn "[IrcBot] Killing active plugins... "
+    let resumeData = ircBotResumeData ircBotState'''
+        ircPlugins = read (fromMaybe [] (M.lookup "PLUGINS" resumeData)) :: [String]
+    evalStateT (mapM_ killIrcPlugin ircPlugins) ircBotState'''
     return ()
 
 --resumeIrcBot

Hsbot/Irc/Plugin.hs

@@ -1,6 +1,7 @@
 module Hsbot.Irc.Plugin
     ( IrcPlugin
     , IrcPluginState (..)
+    , killIrcPlugin
     , listPlugins
     , loadIrcPlugin
     , sendToPlugin
@@ -72,16 +73,23 @@ listPlugins originalRequest dest = do
 -- | Unloads a plugin
 unloadIrcPlugin :: String -> IrcBot ()
 unloadIrcPlugin name = do
+    killIrcPlugin name
+    ircbot <- get
+    let oldResumeData = ircBotResumeData ircbot
+        newPlugins    = M.keys $ ircBotPlugins ircbot
+        newResumeData = M.insert "PLUGINS" (show newPlugins) oldResumeData
+    put $ ircbot { ircBotResumeData = newResumeData }
+
+-- | kills a plugin
+killIrcPlugin :: String -> IrcBot ()
+killIrcPlugin name = do
     ircbot <- get
     let oldPlugins = ircBotPlugins ircbot
-        oldResumeData = ircBotResumeData ircbot
     -- We check if the plugin exists
     case M.lookup name oldPlugins of
         Just (_, threadId) -> do
             let newPlugins = M.delete name oldPlugins
-                newResumeData = M.insert "PLUGINS" (show $ M.keys newPlugins) oldResumeData
             liftIO $ throwTo threadId UserInterrupt
-            put $ ircbot { ircBotPlugins = newPlugins
+            put $ ircbot { ircBotPlugins = newPlugins }
-                         , ircBotResumeData = newResumeData }
         Nothing            -> return ()
 

Hsbot/Irc/Types.hs

@@ -26,12 +26,9 @@ data IrcBotState = IrcBotState
     , ircBotCommands             :: M.Map String [String]   -- Loaded plugins
     , ircBotChan                 :: Chan IrcBotMsg          -- The IrcBot's communication channel
     , ircBotMasterChan           :: Chan BotMsg             -- The Hsbot communication channel
-    , ircBotMyChan               :: Chan BotMsg             -- The Hsbot communication channel
     , ircBotServerState          :: IrcServerState          -- The state of the IrcServer
     , ircBotHandle               :: Handle                  -- The server's socket/handle
     , ircBotConfig               :: IrcConfig               -- The starting configuration
-    , ircBotReaderThreadId       :: ThreadId                -- the thread that process inputs from the socket
-    , ircBotMasterReaderThreadId :: ThreadId                -- the thread that process inputs from the master bot
     , ircBotResumeData           :: ResumeData              -- the necessary data to resume the bot's operations on reboot
     }
 

Hsbot/Plugin.hs

@@ -1,11 +1,16 @@
 module Hsbot.Plugin
-    ( spawnIrcPlugins
+    ( killPlugin
+    , spawnIrcPlugins
+    , spawnIrcPlugin
+    , unloadPlugin
     ) where
 
 import Control.Concurrent
 import Control.Concurrent.Chan ()
+import Control.Exception
 import Control.Monad.State
 import qualified Data.Map as M
+import Prelude hiding (catch)
 
 import Hsbot.Config
 import Hsbot.Irc.Config
@@ -17,9 +22,10 @@ spawnIrcPlugins :: Bot ()
 spawnIrcPlugins = do
     config <- gets botConfig
     mapM_ (spawnIrcPlugin) (ircConfigs config)
-  where
+
-    spawnIrcPlugin :: IrcConfig -> Bot ()
+-- | spawns a single irc plugin
-    spawnIrcPlugin config = do
+spawnIrcPlugin :: IrcConfig -> Bot ()
+spawnIrcPlugin config = do
     bot <- get
     let chan  = botChan bot
     pchan <- liftIO (newChan :: IO (Chan BotMsg))
@@ -30,3 +36,23 @@ spawnIrcPlugins = do
         plugins = botPlugins bot
     put $ bot { botPlugins = M.insert (pluginName plugin) (plugin, threadId) plugins }
 
+-- | Unloads a plugin
+unloadPlugin :: String -> Bot ()
+unloadPlugin name = do
+    killPlugin name
+    resumeData <- gets botResumeData
+    liftIO $ modifyMVar_ resumeData (\oldData -> return $ M.delete name oldData)
+
+-- | kills a plugin
+killPlugin :: String -> Bot ()
+killPlugin name = do
+    bot <- get
+    let oldPlugins = botPlugins bot
+    -- We check if the plugin exists
+    case M.lookup name oldPlugins of
+        Just (_, threadId) -> do
+            let newPlugins = M.delete name oldPlugins
+            liftIO $ throwTo threadId UserInterrupt
+            put $ bot { botPlugins = newPlugins }
+        Nothing            -> return ()
+

TODO

@@ -1,6 +1,5 @@
 :julien!~julien@ogu21.corp PRIVMSG #shbot :@quote graou snif
 
-* Handle clean termination of all thread on reboot
 * Find a way to handle bot reloading threw exec
 * Find a way to cleanly handle termination/reboot requests (signals, IOExceptions, plugins' requests)