summaryrefslogtreecommitdiff
path: root/Hsbot/Irc
diff options
context:
space:
mode:
authorJulien Dessaux2010-05-24 22:46:20 +0200
committerJulien Dessaux2010-05-24 22:46:20 +0200
commita12e4927728c9907537b221257c5e2914f5f1c48 (patch)
tree8b8f2dcaa3e796e53767531d654c7e437437ff05 /Hsbot/Irc
parentCleaned the definition of irc plugins' data structure. (diff)
downloadhsbot-a12e4927728c9907537b221257c5e2914f5f1c48.tar.gz
hsbot-a12e4927728c9907537b221257c5e2914f5f1c48.tar.bz2
hsbot-a12e4927728c9907537b221257c5e2914f5f1c48.zip
Implemented ircbot update messages.
Diffstat (limited to '')
-rw-r--r--Hsbot/Irc/Command.hs14
-rw-r--r--Hsbot/Irc/Core.hs46
-rw-r--r--Hsbot/Irc/Plugin.hs32
-rw-r--r--Hsbot/Irc/Types.hs21
4 files changed, 69 insertions, 44 deletions
diff --git a/Hsbot/Irc/Command.hs b/Hsbot/Irc/Command.hs
index e5c033e..ef1ef27 100644
--- a/Hsbot/Irc/Command.hs
+++ b/Hsbot/Irc/Command.hs
@@ -36,7 +36,7 @@ unregisterCommand cmd pluginName' = do
-- | Processes an internal command
processInternalCommand :: IrcBotMsg -> IrcBot ()
processInternalCommand (IntIrcCmd ircCmd)
- | ircCmdTo ircCmd == "CORE" = processCoreCommand ircCmd
+ | ircCmdTo ircCmd == "CORE" = processCoreCommand ircCmd
| otherwise = do
plugins <- gets ircBotPlugins
case M.lookup (ircCmdTo ircCmd) plugins of
@@ -52,8 +52,18 @@ processCoreCommand ircCmd = do
case command' of
"LIST" -> listPlugins originalRequest (ircCmdFrom ircCmd)
"LOAD" -> loadIrcPlugin $ ircCmdMsg ircCmd
- "UNLOAD" -> unloadPlugin $ ircCmdMsg ircCmd
+ "UNLOAD" -> unloadIrcPlugin $ ircCmdMsg ircCmd
+ "UPDATE" -> processUpdateCommand ircCmd
"REGISTER" -> registerCommand (ircCmdMsg ircCmd) (ircCmdFrom ircCmd)
"UNREGISTER" -> unregisterCommand (ircCmdMsg ircCmd) (ircCmdFrom ircCmd)
_ -> return ()
+-- | Process an update command
+processUpdateCommand :: IrcCmd -> IrcBot ()
+processUpdateCommand ircCmd = do
+ ircbot <- get
+ let oldData = ircBotResumeData ircbot
+ from = ircCmdFrom ircCmd
+ stuff = ircCmdMsg ircCmd
+ put $ ircbot { ircBotResumeData = M.insert from stuff oldData }
+
diff --git a/Hsbot/Irc/Core.hs b/Hsbot/Irc/Core.hs
index 2c455ce..1a51a5c 100644
--- a/Hsbot/Irc/Core.hs
+++ b/Hsbot/Irc/Core.hs
@@ -11,6 +11,7 @@ import Data.Time
import Network
import Prelude hiding (catch)
import System.IO
+import System.Posix.IO (handleToFd)
import Hsbot.Irc.Command
import Hsbot.Irc.Config
@@ -18,7 +19,7 @@ import Hsbot.Irc.Message
import Hsbot.Irc.Plugin
import Hsbot.Irc.Server
import Hsbot.Irc.Types
-import Hsbot.Message (BotMsg)
+import Hsbot.Message
-- | IrcBot's main entry point
startIrcbot :: IrcConfig -> Chan BotMsg -> Chan BotMsg -> IO ()
@@ -29,8 +30,9 @@ startIrcbot config masterChan myChan = do
putStrLn $ concat ["[IrcBot] Connecting to ", ircConfigAddress config, "... "]
handle <- connectTo (ircConfigAddress config) (ircConfigPort config)
hSetBuffering handle NoBuffering
- myOwnThreadId <- myThreadId
+ fd <- handleToFd handle
putStrLn "[IrcBot] Spawning reader threads..."
+ myOwnThreadId <- myThreadId
readerThreadId <- forkIO $ ircBotReader handle chan myOwnThreadId
masterReaderThreadId <- forkIO $ ircBotMasterReader masterChan chan
putStrLn "[IrcBot] Initializing server connection..."
@@ -49,10 +51,13 @@ startIrcbot config masterChan myChan = do
, ircBotHandle = handle
, ircBotConfig = config
, ircBotReaderThreadId = readerThreadId
- , ircBotMasterReaderThreadId = masterReaderThreadId }
+ , ircBotMasterReaderThreadId = masterReaderThreadId
+ , ircBotResumeData = M.singleton "HANDLE" (show fd) }
ircBotState' <- execStateT (initBotServerConnection config) ircBotState
- putStrLn "[IrcBot] Entering main loop... "
- _ <- ircBotLoop ircBotState' `catch` (\(_ :: IOException) -> return ())
+ putStrLn "[IrcBot] Spawning plugins..."
+ ircBotState'' <- execStateT spawnIrcPlugins ircBotState'
+ putStrLn "[IrcBot] Entering Core loop... "
+ _ <- (execStateT ircBotLoop ircBotState'') `catch` (\(_ :: IOException) -> return (ircBotState''))
return ()
--resumeIrcBot
@@ -89,28 +94,17 @@ initBotServerConnection config = do
ircServerState' <- execStateT (initServerConnection config) ircServerState
put $ ircBot { ircBotServerState = ircServerState' }
--- | IrcBot's loop that can catch ircbot's states' updates
-ircBotLoop :: IrcBotState -> IO ()
-ircBotLoop ircBotState = do
- putStrLn "[IrcBot] Spawning plugins..."
- ircBotState' <- execStateT spawnIrcPlugins ircBotState
- -- Todo : throw new ircbotstate to hsbot
- putStrLn "[IrcBot] Entering Core loop... "
- _ <- (execStateT ircBotCore ircBotState') -- `catch` (\(_ :: NewBotStateException) -> return ircBotState')
- return ()
- -- TODO : loop!
-
-- | Run the IrcBot's main loop
-ircBotCore :: IrcBot ()
-ircBotCore = forever $ do
- ircBot <- get
- let chan = ircBotChan ircBot
+ircBotLoop :: IrcBot ()
+ircBotLoop = forever $ do
+ chan <- gets ircBotChan
msg <- liftIO $ readChan chan
case msg of
InIrcMsg inIrcMsg -> dispatchMessage $ InIrcMsg inIrcMsg
OutIrcMsg outIrcMsg -> sendThisMessage outIrcMsg
IntIrcCmd intIrcCmd -> do
processInternalCommand $ IntIrcCmd intIrcCmd
+ reportUpdate
where
sendThisMessage :: IrcMsg -> IrcBot ()
sendThisMessage outputMsg = do
@@ -143,3 +137,15 @@ dispatchMessage (InIrcMsg inIrcMsg) = do
getMsgContent = unwords . tail $ ircMsgParameters inIrcMsg
dispatchMessage _ = return ()
+-- | Reports an update to the master bot
+reportUpdate :: IrcBot ()
+reportUpdate = do
+ ircbot <- get
+ let masterChan = ircBotMasterChan ircbot
+ msg = IntMsg $ Msg { msgType = "UPDATE"
+ , msgFrom = ircConfigName $ ircBotConfig ircbot
+ , msgTo = "CORE"
+ , msgCmd = show $ ircBotResumeData ircbot
+ }
+ liftIO $ writeChan masterChan msg
+
diff --git a/Hsbot/Irc/Plugin.hs b/Hsbot/Irc/Plugin.hs
index 3e6bef0..d972db2 100644
--- a/Hsbot/Irc/Plugin.hs
+++ b/Hsbot/Irc/Plugin.hs
@@ -5,7 +5,7 @@ module Hsbot.Irc.Plugin
, loadIrcPlugin
, sendToPlugin
, spawnIrcPlugins
- , unloadPlugin
+ , unloadIrcPlugin
) where
import Control.Concurrent
@@ -45,16 +45,20 @@ loadIrcPlugin pluginName = do
"Ping" -> ircBotPluginPing
"Quote" -> ircBotPluginQuote
_ -> ircBotPluginDummy
- let oldPlugins = ircBotPlugins ircbot
+ let oldPlugins = ircBotPlugins ircbot
+ oldResumeData = ircBotResumeData ircbot
-- We check for unicity
case M.lookup pluginName oldPlugins of
Just _ -> return ()
Nothing -> do
threadId <- liftIO $ forkIO (entryPoint pluginChan masterChan)
- let plugin = IrcPluginState { ircPluginName = pluginName
- , ircPluginChan = pluginChan
- , ircPluginMasterChan = masterChan }
- put $ ircbot { ircBotPlugins = M.insert pluginName (plugin, threadId) oldPlugins }
+ let plugin = IrcPluginState { ircPluginName = pluginName
+ , ircPluginChan = pluginChan
+ , ircPluginMasterChan = masterChan }
+ newPlugins = M.insert pluginName (plugin, threadId) oldPlugins
+ newResumeData = M.insert "PLUGINS" (show $ M.keys newPlugins) oldResumeData
+ put $ ircbot { ircBotPlugins = newPlugins
+ , ircBotResumeData = newResumeData }
-- | Sends a list of loaded plugins
listPlugins :: IrcMsg -> String -> IrcBot ()
@@ -66,14 +70,18 @@ listPlugins originalRequest dest = do
Nothing -> return ()
-- | Unloads a plugin
-unloadPlugin :: String -> IrcBot ()
-unloadPlugin name = do
- bot <- get
- let oldPlugins = ircBotPlugins bot
+unloadIrcPlugin :: String -> IrcBot ()
+unloadIrcPlugin 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
+ let newPlugins = M.delete name oldPlugins
+ newResumeData = M.insert "PLUGINS" (show $ M.keys newPlugins) oldResumeData
liftIO $ throwTo threadId UserInterrupt
- put $ bot { ircBotPlugins = newPlugins }
+ put $ ircbot { ircBotPlugins = newPlugins
+ , ircBotResumeData = newResumeData }
Nothing -> return ()
diff --git a/Hsbot/Irc/Types.hs b/Hsbot/Irc/Types.hs
index 78e663b..90bd728 100644
--- a/Hsbot/Irc/Types.hs
+++ b/Hsbot/Irc/Types.hs
@@ -21,17 +21,18 @@ type IrcBot = StateT IrcBotState IO
-- | An Ircbot state
data IrcBotState = IrcBotState
- { ircBotStartTime :: UTCTime -- the bot's uptime
+ { ircBotStartTime :: UTCTime -- the bot's uptime
, ircBotPlugins :: M.Map String (IrcPluginState, ThreadId) -- Loaded plugins
- , 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
- , ircBotMasterReaderThreadId :: ThreadId
+ , 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 :: M.Map String String -- the necessary data to resume the bot's operations on reboot
}
-- | The IrcServer monad