summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--Hsbot/Command.hs2
-rw-r--r--Hsbot/IRCParser.hs4
-rw-r--r--Hsbot/IRCPlugin.hs8
-rw-r--r--Hsbot/Plugin.hs12
-rw-r--r--Plugins/Core.hs20
-rw-r--r--TODO9
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
diff --git a/TODO b/TODO
index 7e8afd1..9ec408e 100644
--- a/TODO
+++ b/TODO
@@ -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