summaryrefslogtreecommitdiff
path: root/Hsbot
diff options
context:
space:
mode:
authorJulien Dessaux2010-04-21 22:58:34 +0200
committerJulien Dessaux2010-04-21 23:01:02 +0200
commit50b21c21ee92a5dbc220022772c74b288e327e5d (patch)
treebb80d771cc3fead70ccbba1717413a90c329c17c /Hsbot
parentAdd the IrcMsg as an optional parameter for an internal command. (diff)
downloadhsbot-50b21c21ee92a5dbc220022772c74b288e327e5d.tar.gz
hsbot-50b21c21ee92a5dbc220022772c74b288e327e5d.tar.bz2
hsbot-50b21c21ee92a5dbc220022772c74b288e327e5d.zip
Make the main thread exit cleanly in case of connection loss.
Diffstat (limited to 'Hsbot')
-rw-r--r--Hsbot/Core.hs29
-rw-r--r--Hsbot/Main.hs1
2 files changed, 23 insertions, 7 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