diff -r 835fd7a0e1bf -r 5e3c5fe2cb14 gameServer/NetRoutines.hs --- a/gameServer/NetRoutines.hs Thu Nov 11 11:04:24 2010 -0500 +++ b/gameServer/NetRoutines.hs Thu Nov 11 22:17:54 2010 +0300 @@ -1,41 +1,46 @@ -{-# LANGUAGE ScopedTypeVariables, OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} module NetRoutines where +import Network import Network.Socket import System.IO +import Control.Concurrent import Control.Concurrent.Chan +import Control.Concurrent.STM import qualified Control.Exception as Exception import Data.Time -import Control.Monad ----------------------------- import CoreTypes +import ClientIO import Utils -import RoomsAndClients -acceptLoop :: Socket -> Chan CoreMessage -> IO () -acceptLoop servSock chan = forever $ do +acceptLoop :: Socket -> Chan CoreMessage -> Int -> IO () +acceptLoop servSock coreChan clientCounter = do Exception.handle (\(_ :: Exception.IOException) -> putStrLn "exception on connect") $ do - (sock, sockAddr) <- Network.Socket.accept servSock + (socket, sockAddr) <- Network.Socket.accept servSock + cHandle <- socketToHandle socket ReadWriteMode + hSetBuffering cHandle LineBuffering clientHost <- sockAddr2String sockAddr currentTime <- getCurrentTime - - sendChan' <- newChan + + sendChan <- newChan let newClient = (ClientInfo - sendChan' - sock + nextID + sendChan + cHandle clientHost currentTime "" "" False 0 - lobbyId + 0 0 False False @@ -44,5 +49,12 @@ undefined ) - writeChan chan $ Accept newClient + writeChan coreChan $ Accept newClient + + forkIO $ clientRecvLoop cHandle coreChan nextID + forkIO $ clientSendLoop cHandle coreChan sendChan nextID return () + + acceptLoop servSock coreChan nextID + where + nextID = clientCounter + 1