Implemented the clean killing of plugins' threads.

6 files changed, 70 insertions, 33 deletions

diff --git a/Hsbot/Core.hs b/Hsbot/Core.hs
index f98fece..fac9f8e 100644
--- a/Hsbot/Core.hs
+++ b/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 botState resumeData = do
+resumeHsbot :: BotResumeData -> IO ()
+resumeHsbot resumeData = do
     print resumeData
 
 -- | Run the bot main loop
diff --git a/Hsbot/Irc/Core.hs b/Hsbot/Irc/Core.hs
index 2fb8386..229fef8 100644
--- a/Hsbot/Irc/Core.hs
+++ b/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
diff --git a/Hsbot/Irc/Plugin.hs b/Hsbot/Irc/Plugin.hs
index d972db2..28026aa 100644
--- a/Hsbot/Irc/Plugin.hs
+++ b/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 oldPlugins    = ircBotPlugins ircbot
-        oldResumeData = ircBotResumeData ircbot
+    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
     -- 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
+            let newPlugins = M.delete name oldPlugins
             liftIO $ throwTo threadId UserInterrupt
-            put $ ircbot { ircBotPlugins = newPlugins
-                         , ircBotResumeData = newResumeData }
-        Nothing     -> return ()
+            put $ ircbot { ircBotPlugins = newPlugins }
+        Nothing            -> return ()
 
diff --git a/Hsbot/Irc/Types.hs b/Hsbot/Irc/Types.hs
index c9be251..fe70ea4 100644
--- a/Hsbot/Irc/Types.hs
+++ b/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
     }
 
diff --git a/Hsbot/Plugin.hs b/Hsbot/Plugin.hs
index aafa495..10c59af 100644
--- a/Hsbot/Plugin.hs
+++ b/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,16 +22,37 @@ spawnIrcPlugins :: Bot ()
 spawnIrcPlugins = do
     config <- gets botConfig
     mapM_ (spawnIrcPlugin) (ircConfigs config)
-  where
-    spawnIrcPlugin :: IrcConfig -> Bot ()
-    spawnIrcPlugin config = do
-        bot <- get
-        let chan  = botChan bot
-        pchan <- liftIO (newChan :: IO (Chan BotMsg))
-        threadId <- liftIO $ forkIO (startIrcbot config chan pchan)
-        let plugin  = PluginState { pluginName    = ircConfigName config
-                                  , pluginChan    = pchan
-                                  , pluginHandles = M.empty }
-            plugins = botPlugins bot
-        put $ bot { botPlugins = M.insert (pluginName plugin) (plugin, threadId) plugins }
+
+-- | spawns a single irc plugin
+spawnIrcPlugin :: IrcConfig -> Bot ()
+spawnIrcPlugin config = do
+    bot <- get
+    let chan  = botChan bot
+    pchan <- liftIO (newChan :: IO (Chan BotMsg))
+    threadId <- liftIO $ forkIO (startIrcbot config chan pchan)
+    let plugin  = PluginState { pluginName    = ircConfigName config
+                              , pluginChan    = pchan
+                              , pluginHandles = M.empty }
+        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 ()
 
diff --git a/TODO b/TODO
index 05adc9c..13a3aba 100644
--- a/TODO
+++ b/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)