diff options
| -rw-r--r-- | Hsbot/Core.hs | 29 | ||||
| -rw-r--r-- | Hsbot/Main.hs | 1 | ||||
| -rw-r--r-- | TODO | 5 |
3 files changed, 26 insertions, 9 deletions
diff --git a/Hsbot/Core.hs b/Hsbot/Core.hs index e3ce3eb..2195525 100644 --- a/Hsbot/Core.hs +++ b/Hsbot/Core.hs @@ -5,10 +5,12 @@ module Hsbot.Core import Control.Concurrent import Control.Concurrent.Chan() +import Control.Exception import Control.Monad.State import Data.List() import qualified Data.Map as M import Network +import Prelude hiding (catch) import System.IO import System.Time (getClockTime) @@ -26,9 +28,10 @@ connectServer server = do handle <- connectTo name $ serverPort server hSetBuffering handle NoBuffering putStrLn "done." - putStr $ "Opening server communication channel... " + putStr "Opening server communication channel... " chan <- newChan :: IO (Chan BotMsg) - threadId <- forkIO $ botReader handle chan + myFatherThreadId <- myThreadId + threadId <- forkIO $ botReader handle chan myFatherThreadId putStrLn "done." return $ Bot server starttime handle [] M.empty chan threadId M.empty @@ -36,16 +39,21 @@ connectServer server = do disconnectServer :: IrcBot () disconnectServer = do bot <- get + let name = serverAddress $ serverConfig bot + liftIO $ putStr "Shutting down plugins..." mapM_ unloadPlugin (M.keys $ botPlugins bot) + liftIO $ putStrLn"done." + liftIO $ putStr "Closing server communication channel... " liftIO $ killThread $ readerThreadId bot + liftIO $ putStrLn "done." + liftIO $ putStr $ "Disconnecting from " ++ name ++ "... " liftIO $ hClose $ botHandle bot - return () + liftIO $ putStrLn "done." -- | Socket reading loop -botReader :: Handle -> Chan BotMsg -> IO () -botReader handle chan = forever $ do - -- TODO : detect end of connection! - str <- hGetLine handle +botReader :: Handle -> Chan BotMsg -> ThreadId -> IO () +botReader handle chan fatherThreadId = forever $ do + str <- (hGetLine handle) `catch` handleIOException let msg = parseIrcMsg str case msg of Right msg' -> do @@ -53,4 +61,11 @@ botReader handle chan = forever $ do writeChan chan (InputMsg msg') _ -> do return () + where + handleIOException :: IOException -> IO (String) + handleIOException ioException = do + throwTo fatherThreadId ioException + myId <- myThreadId + killThread myId + return "" diff --git a/Hsbot/Main.hs b/Hsbot/Main.hs index 82b643f..767722b 100644 --- a/Hsbot/Main.hs +++ b/Hsbot/Main.hs @@ -28,6 +28,7 @@ imain = do run :: IrcBot () run = do initServer + liftIO $ putStrLn "Starting plugins..." loadPlugin "Ping" mainPing loadPlugin "Core" mainCore loadPlugin "Quote" mainQuote @@ -1,7 +1,5 @@ :julien!~julien@ogu21.corp PRIVMSG #shbot :@quote graou snif -* Solve the catching that never happen in main -* throwto exception to main thread * write a safe reload : try reload before unloading * discard all trace with a color param and replace those with functions info/warn/error/debug @@ -13,5 +11,8 @@ * add register for casual conversations for plugins? * add a "I have stuff to save so don't kill me too hard" status for plugins +* Handle unix signals properly +* Make the bot auto-reconnect (/!\ admin plugin!) + * restore \r in IRCParser |