{-# OPTIONS -fglasgow-exts #-}
module IMain where
import Control.Concurrent.STM.TMVar
import Control.Concurrent.STM
import Control.Concurrent
import Control.Monad.STM
import System.Plugins
import Control.Arrow
import Control.Monad
import Data.Maybe
import System.IO
import Network
import Data.Map as Map
import qualified Config as C
import Monitor
import PLoader
import Logger
import List
import API
import Net
-- takes the Module referring to itself,
-- and a reboot function; starts dynmain
-- through main' with a state
main :: Module -> RebootT -> IO ()
main mod reboot = do
hSetBuffering stdout NoBuffering
servs <- forM (C.servers C.config) $ \s -> do
let sname = C.address s
h <- connectTo (C.address s) (PortNumber . fromIntegral $ C.port s)
hSetBuffering h NoBuffering
return (sname,(h,s))
putStrLn "Connected to servers..."
chan <- newChan
let st = MState undefined chan (fromList servs) C.config (C.logFile C.config) reboot mod []
main' st mod
-- thin wrapper which is what we'll reboot to so we don't have
-- to deal with reentrancy issues
-- UPDATE: 10-08-07: my idea on how to approach this is roughly
-- to fall through to dynmain in the main thread in a 'Monitor'
-- monad that'll let us monitor other threads. Meanwhile, here in
-- main' since its our thin reboot wrapper, we'll just spawn threads
-- for each server connection.
main' st m = do
let s = (toList . servers) st
(plugs,mods) <- getPlugins >>= return . unzip
tvar <- atomically $ newEmptyTMVar
forM_ s $ \(name,(s,h)) -> do
let ist = IState tvar (rchan st) plugs (s,h) (conf st) (lFile st)
forkIO $ runNet listener ist
runMonitor dynmain $ st{rebootvar=tvar,imodule=m,pmodules=mods}
-- this is the monitor thread, which keeps tracks and does reboots, etc. etc..
dynmain :: Monitor ()
dynmain = do
mlog Normal "Servers connected, threads forked..."
n <- serverNum
chanloop n
where
chanloop n = do
l <- cGetLine
case l of
Reboot -> do
mlog Normal "Got reboot msg..."
setrebootvar
s <- cGetLines
wait n s 0
unloadplugs
restart
Msg s -> Monitor.cprint s
Quit s -> do
threadQuit s
let x = n-1 in if x == 0 then exit else chanloop x
chanloop n
wait n x i = when (i < n) $ case x of
Nil:xs -> wait n xs $! i+1
_:xs -> wait n xs i
-- entry point for the subsequent threads.
listener :: Net ()
listener = do
start -- this is idempotent, so it's reentry safe
infinity $ \s -> do
if ping s then pong s
else parseIRCmsg s >>= eval
return ()
where start = setupNick >> identify >> joinC
ischan = isPrefixOf "#"
infinity a = do
i <- waitForInput 1
if i then
do s <- recv
a s
infinity a
else
do re <- chkreboot
if re then die else (infinity a)
eval s | (Err e) <- s = netlog Error $ "eval: " ++ e
| (Line u c x) <- s = do name <- getnick
when (x /= [] && ischan c && u /= name) (logmsg (u,c,x))
let n' = concat [name,":"]
when (n' `isPrefixOf` x) $ do
let str = drop (length n') x
(cmd',av) = ((tail.head.words) &&& (unwords.tail.words)) str
eval $ Cmd u c (cmd',av)
| (Cmd u c (cmd,av)) <- s = do
case cmd of
[] -> return ()
"quit" -> ifadmin u quit (privmsg c "Can't do that...")
"reboot" -> ifadmin u (privmsg c "Rebooting..." >> rebootmsg) (privmsg c "Can't do that...")
x -> do logmsg (u,c,cmd++" "++av)
s <- runPlugin x u c (if List.null av then Nothing else Just av)
case s of
Nothing -> return ()
Just r -> mapM_ (privmsg $ if ischan c then c else u) (lines r)