adyxax/hsbot
Archived
1
0
Fork 0
Code Issues Activity

Implemented ircbot update messages.

Browse source
This commit is contained in:
Julien Dessaux 2010-05-24 22:46:20 +02:00
parent 5b8cffbf68
commit a12e492772
6 changed files with 73 additions and 44 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

14
Hsbot/Irc/Command.hs
View file

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

46
Hsbot/Irc/Core.hs
View file

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

32
Hsbot/Irc/Plugin.hs
View file

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

21
Hsbot/Irc/Types.hs
View file

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

3
Hsbot/Message.hs
View file

@ -1,8 +1,11 @@
module Hsbot.Message
( BotMsg (..)
, Msg (..)
, processInternalMessage
) where
import Hsbot.PluginUtils
-- | A hsbot message
data Msg = Msg
{ msgType :: String -- the message type

1
TODO
View file

@ -2,6 +2,7 @@
* Handle bot/Plugin state updates threw the masters' Chans
* Find a way to handle bot reloading threw exec
* Find a way to cleanly handle termination/reboot requests (signals, IOExceptions, plugins' requests)
* write the vote system for the quote module
* only the quote reporter should be able to edit it