diff options
Diffstat (limited to '')
| -rw-r--r-- | Hsbot/Command.hs | 2 | ||||
| -rw-r--r-- | Hsbot/IRCParser.hs | 4 | ||||
| -rw-r--r-- | Hsbot/IRCPlugin.hs | 8 | ||||
| -rw-r--r-- | Hsbot/Plugin.hs | 12 | ||||
| -rw-r--r-- | Plugins/Core.hs | 20 | ||||
| -rw-r--r-- | TODO | 9 |
6 files changed, 40 insertions, 15 deletions
diff --git a/Hsbot/Command.hs b/Hsbot/Command.hs index 1eaee82..ea372e4 100644 --- a/Hsbot/Command.hs +++ b/Hsbot/Command.hs @@ -76,7 +76,9 @@ processInternalCommand _ = return () processCoreCommand :: IntCmd -> IrcBot () processCoreCommand intCmd = do let command' = intCmdCmd intCmd + originalRequest = intCmdBotMsg intCmd case command' of + "LIST" -> listPlugins originalRequest (intCmdFrom intCmd) "LOAD" -> traceM $ inColor "hsbot has been compiled in static mode." [31] "UNLOAD" -> unloadPlugin $ intCmdMsg intCmd "REGISTER" -> registerCommand (intCmdMsg intCmd) (intCmdFrom intCmd) diff --git a/Hsbot/IRCParser.hs b/Hsbot/IRCParser.hs index a5f2e41..263ac1f 100644 --- a/Hsbot/IRCParser.hs +++ b/Hsbot/IRCParser.hs @@ -18,8 +18,8 @@ pMsg = do pfx <- optionMaybe pPrefix cmd <- pCommand params <- many (char ' ' >> (pLongParam <|> pShortParam)) - --char '\r' - eof + char '\r' + --eof return $ IrcMsg pfx cmd params pPrefix :: ParsecT String u Identity [Char] diff --git a/Hsbot/IRCPlugin.hs b/Hsbot/IRCPlugin.hs index 568eb1d..c32d24c 100644 --- a/Hsbot/IRCPlugin.hs +++ b/Hsbot/IRCPlugin.hs @@ -1,6 +1,7 @@ module Hsbot.IRCPlugin ( readMsg , sendCommand + , sendCommandWithRequest , sendRegisterCommand , sendUnregisterCommand , writeMsg @@ -25,10 +26,13 @@ writeMsg botMsg = do -- | Commands management sendCommand :: String -> String -> String -> IrcPlugin () -sendCommand cmd to params = do +sendCommand cmd to params = sendCommandWithRequest cmd to params Nothing + +sendCommandWithRequest :: String -> String -> String -> Maybe IrcMsg -> IrcPlugin () +sendCommandWithRequest cmd to params originalRequest = do serverChan <- gets instanceServerChan from <- gets instanceName - liftIO $ writeChan serverChan $ InternalCmd $ IntCmd cmd from to params Nothing + liftIO $ writeChan serverChan $ InternalCmd $ IntCmd cmd from to params originalRequest sendRegisterCommand :: String -> IrcPlugin () sendRegisterCommand cmd = sendCommand "REGISTER" "CORE" cmd diff --git a/Hsbot/Plugin.hs b/Hsbot/Plugin.hs index 34c6603..43ce0fb 100644 --- a/Hsbot/Plugin.hs +++ b/Hsbot/Plugin.hs @@ -1,5 +1,6 @@ module Hsbot.Plugin - ( loadPlugin + ( listPlugins + , loadPlugin , sendToPlugin , unloadPlugin ) where @@ -31,6 +32,15 @@ effectivelyLoadPlugin name entryPoint serverChan = do threadId <- forkIO $ entryPoint serverChan chan return $ Plugin name threadId chan +-- | Sends a list of loaded plugins +listPlugins :: Maybe IrcMsg -> String -> IrcBot () +listPlugins originalRequest dest = do + plugins <- gets botPlugins + let listing = unwords $ M.keys plugins + case M.lookup dest plugins of + Just plugin -> sendToPlugin (InternalCmd $ IntCmd "ANSWER" "CORE" dest listing originalRequest) plugin + Nothing -> return () + -- | Unloads a plugin unloadPlugin :: String -> IrcBot () unloadPlugin name = do diff --git a/Plugins/Core.hs b/Plugins/Core.hs index 123d2e6..64e0bf7 100644 --- a/Plugins/Core.hs +++ b/Plugins/Core.hs @@ -5,6 +5,7 @@ module Plugins.Core import Control.Concurrent.Chan(Chan) import Control.Exception import Control.Monad.State +import Data.Maybe(fromMaybe) import Prelude hiding (catch) import Hsbot.IRCPlugin @@ -28,16 +29,27 @@ run = forever $ do eval :: BotMsg -> IrcPlugin () eval (InternalCmd intCmd) = do case intCmdCmd intCmd of - "RUN" -> let stuff = words $ intCmdMsg intCmd - in case head stuff of + "RUN" -> let stuff = words $ intCmdMsg intCmd + request = intCmdBotMsg intCmd + in case head stuff of + "list" -> listPlugins request "load" -> loadPlugin $ tail stuff "reload" -> reloadPlugin $ tail stuff "unload" -> unloadPlugin $ tail stuff _ -> lift $ trace $ show intCmd -- TODO : help message - _ -> lift $ trace $ show intCmd - eval (InputMsg msg) = return () + "ANSWER" -> let stuff = intCmdMsg intCmd + request = intCmdBotMsg intCmd + chanOrigin = head $ parameters (fromMaybe (IrcMsg Nothing "ARGH" []) request) + in writeMsg $ OutputMsg $ IrcMsg Nothing "PRIVMSG" [chanOrigin, "Loaded plugins : " ++ stuff] + _ -> lift $ trace $ show intCmd + eval (InputMsg _) = return () eval _ = return () +-- | The list command +listPlugins :: Maybe IrcMsg -> IrcPlugin () +listPlugins request = do + sendCommandWithRequest "LIST" "CORE" (unwords []) request + -- | The load command loadPlugin :: [String] -> IrcPlugin () loadPlugin pluginNames = mapM_ (sendCommand "LOAD" "CORE") pluginNames @@ -1,10 +1,7 @@ :julien!~julien@ogu21.corp PRIVMSG #shbot :@quote graou snif -* write a safe reload : try reload before unloading -* discard all trace with a color param and replace those with functions info/warn/error/debug - +* Write the quote module * clean the plugin module -* list modules command * part chan * add admin checks for cmds @@ -13,6 +10,6 @@ * Handle unix signals properly * Make the bot auto-reconnect (/!\ admin plugin!) - -* restore \r in IRCParser +* discard all trace with a color param and replace those with functions info/warn/error/debug +* write a safe reload : try reload before unloading |