summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--Hsbot/Core.hs8
-rw-r--r--Hsbot/Irc/Core.hs17
-rw-r--r--Hsbot/Irc/Plugin.hs22
-rw-r--r--Hsbot/Irc/Types.hs3
-rw-r--r--Hsbot/Plugin.hs52
-rw-r--r--TODO1
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)