adyxax/hsbot
Archived
1
0
Fork 0
Code Issues Activity

Implemented the clean killing of plugins' threads.

Browse source
This commit is contained in:
Julien Dessaux 2010-05-29 00:55:14 +02:00
parent c506c58e92
commit daea135424
6 changed files with 70 additions and 33 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
Hsbot/Core.hs
View file

@ -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

17
Hsbot/Irc/Core.hs
View file

@ -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

22
Hsbot/Irc/Plugin.hs
View file

@ -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 ()

3
Hsbot/Irc/Types.hs
View file

@ -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
}

52
Hsbot/Plugin.hs
View file

@ -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 ()

1
TODO
View file

@ -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)