diff -r 95efe37482e3 -r 4e78ad846fb6 gameServer/NetRoutines.hs --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/gameServer/NetRoutines.hs Wed Feb 18 15:04:40 2009 +0000 @@ -0,0 +1,60 @@ +{-# LANGUAGE PatternSignatures #-} +module NetRoutines where + +import Network +import Network.Socket +import System.IO +import Control.Concurrent +import Control.Concurrent.Chan +import Control.Concurrent.STM +import Control.Exception +import Data.Time +----------------------------- +import CoreTypes +import ClientIO + +sockAddr2String :: SockAddr -> IO String +sockAddr2String (SockAddrInet _ hostAddr) = inet_ntoa hostAddr +sockAddr2String (SockAddrInet6 _ _ (a, b, c, d) _) = return (foldr1 (\a b -> a ++ ":" ++ b) [show a, show b, show c, show d]) + +acceptLoop :: Socket -> Chan CoreMessage -> Int -> IO () +acceptLoop servSock coreChan clientCounter = do + Control.Exception.handle + (\(_ :: Exception) -> putStrLn "exception on connect") $ + do + (socket, sockAddr) <- Network.Socket.accept servSock + + cHandle <- socketToHandle socket ReadWriteMode + hSetBuffering cHandle LineBuffering + clientHost <- sockAddr2String sockAddr + + currentTime <- getCurrentTime + putStrLn $ (show currentTime) ++ " new client id: " ++ (show nextID) + + sendChan <- newChan + + let newClient = + (ClientInfo + nextID + sendChan + cHandle + clientHost + --currentTime + "" + 0 + 0 + False + False + False + False) + + writeChan coreChan $ Accept newClient + + forkIO $ clientRecvLoop cHandle coreChan nextID + forkIO $ clientSendLoop cHandle coreChan sendChan nextID + return () + + yield -- hm? + acceptLoop servSock coreChan nextID + where + nextID = clientCounter + 1