Archived
1
0
Fork 0

Wrote the list plugin command.

This commit is contained in:
Julien Dessaux 2010-04-22 00:05:35 +02:00
parent 50b21c21ee
commit d922240e9a
6 changed files with 40 additions and 15 deletions

View file

@ -76,7 +76,9 @@ processInternalCommand _ = return ()
processCoreCommand :: IntCmd -> IrcBot () processCoreCommand :: IntCmd -> IrcBot ()
processCoreCommand intCmd = do processCoreCommand intCmd = do
let command' = intCmdCmd intCmd let command' = intCmdCmd intCmd
originalRequest = intCmdBotMsg intCmd
case command' of case command' of
"LIST" -> listPlugins originalRequest (intCmdFrom intCmd)
"LOAD" -> traceM $ inColor "hsbot has been compiled in static mode." [31] "LOAD" -> traceM $ inColor "hsbot has been compiled in static mode." [31]
"UNLOAD" -> unloadPlugin $ intCmdMsg intCmd "UNLOAD" -> unloadPlugin $ intCmdMsg intCmd
"REGISTER" -> registerCommand (intCmdMsg intCmd) (intCmdFrom intCmd) "REGISTER" -> registerCommand (intCmdMsg intCmd) (intCmdFrom intCmd)

View file

@ -18,8 +18,8 @@ pMsg = do
pfx <- optionMaybe pPrefix pfx <- optionMaybe pPrefix
cmd <- pCommand cmd <- pCommand
params <- many (char ' ' >> (pLongParam <|> pShortParam)) params <- many (char ' ' >> (pLongParam <|> pShortParam))
--char '\r' char '\r'
eof --eof
return $ IrcMsg pfx cmd params return $ IrcMsg pfx cmd params
pPrefix :: ParsecT String u Identity [Char] pPrefix :: ParsecT String u Identity [Char]

View file

@ -1,6 +1,7 @@
module Hsbot.IRCPlugin module Hsbot.IRCPlugin
( readMsg ( readMsg
, sendCommand , sendCommand
, sendCommandWithRequest
, sendRegisterCommand , sendRegisterCommand
, sendUnregisterCommand , sendUnregisterCommand
, writeMsg , writeMsg
@ -25,10 +26,13 @@ writeMsg botMsg = do
-- | Commands management -- | Commands management
sendCommand :: String -> String -> String -> IrcPlugin () 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 serverChan <- gets instanceServerChan
from <- gets instanceName 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 :: String -> IrcPlugin ()
sendRegisterCommand cmd = sendCommand "REGISTER" "CORE" cmd sendRegisterCommand cmd = sendCommand "REGISTER" "CORE" cmd

View file

@ -1,5 +1,6 @@
module Hsbot.Plugin module Hsbot.Plugin
( loadPlugin ( listPlugins
, loadPlugin
, sendToPlugin , sendToPlugin
, unloadPlugin , unloadPlugin
) where ) where
@ -31,6 +32,15 @@ effectivelyLoadPlugin name entryPoint serverChan = do
threadId <- forkIO $ entryPoint serverChan chan threadId <- forkIO $ entryPoint serverChan chan
return $ Plugin name threadId 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 -- | Unloads a plugin
unloadPlugin :: String -> IrcBot () unloadPlugin :: String -> IrcBot ()
unloadPlugin name = do unloadPlugin name = do

View file

@ -5,6 +5,7 @@ module Plugins.Core
import Control.Concurrent.Chan(Chan) import Control.Concurrent.Chan(Chan)
import Control.Exception import Control.Exception
import Control.Monad.State import Control.Monad.State
import Data.Maybe(fromMaybe)
import Prelude hiding (catch) import Prelude hiding (catch)
import Hsbot.IRCPlugin import Hsbot.IRCPlugin
@ -29,15 +30,26 @@ run = forever $ do
eval (InternalCmd intCmd) = do eval (InternalCmd intCmd) = do
case intCmdCmd intCmd of case intCmdCmd intCmd of
"RUN" -> let stuff = words $ intCmdMsg intCmd "RUN" -> let stuff = words $ intCmdMsg intCmd
request = intCmdBotMsg intCmd
in case head stuff of in case head stuff of
"list" -> listPlugins request
"load" -> loadPlugin $ tail stuff "load" -> loadPlugin $ tail stuff
"reload" -> reloadPlugin $ tail stuff "reload" -> reloadPlugin $ tail stuff
"unload" -> unloadPlugin $ tail stuff "unload" -> unloadPlugin $ tail stuff
_ -> lift $ trace $ show intCmd -- TODO : help message _ -> lift $ trace $ show intCmd -- TODO : help message
"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 _ -> lift $ trace $ show intCmd
eval (InputMsg msg) = return () eval (InputMsg _) = return ()
eval _ = return () eval _ = return ()
-- | The list command
listPlugins :: Maybe IrcMsg -> IrcPlugin ()
listPlugins request = do
sendCommandWithRequest "LIST" "CORE" (unwords []) request
-- | The load command -- | The load command
loadPlugin :: [String] -> IrcPlugin () loadPlugin :: [String] -> IrcPlugin ()
loadPlugin pluginNames = mapM_ (sendCommand "LOAD" "CORE") pluginNames loadPlugin pluginNames = mapM_ (sendCommand "LOAD" "CORE") pluginNames

9
TODO
View file

@ -1,10 +1,7 @@
:julien!~julien@ogu21.corp PRIVMSG #shbot :@quote graou snif :julien!~julien@ogu21.corp PRIVMSG #shbot :@quote graou snif
* write a safe reload : try reload before unloading * Write the quote module
* discard all trace with a color param and replace those with functions info/warn/error/debug
* clean the plugin module * clean the plugin module
* list modules command
* part chan * part chan
* add admin checks for cmds * add admin checks for cmds
@ -13,6 +10,6 @@
* Handle unix signals properly * Handle unix signals properly
* Make the bot auto-reconnect (/!\ admin plugin!) * Make the bot auto-reconnect (/!\ admin plugin!)
* discard all trace with a color param and replace those with functions info/warn/error/debug
* restore \r in IRCParser * write a safe reload : try reload before unloading