netserver/hedgewars-server.hs
changeset 1481 f741afa7dbf3
parent 1480 aec44e91f2d1
child 1482 8af42b3f93d2
equal deleted inserted replaced
1480:aec44e91f2d1 1481:f741afa7dbf3
    29 	atomically $ writeTChan messagesChan ["PING"]
    29 	atomically $ writeTChan messagesChan ["PING"]
    30 
    30 
    31 acceptLoop :: Socket -> TChan ClientInfo -> IO ()
    31 acceptLoop :: Socket -> TChan ClientInfo -> IO ()
    32 acceptLoop servSock acceptChan = Control.Exception.handle (const $ putStrLn "exception on connect" >> acceptLoop servSock acceptChan) $ do
    32 acceptLoop servSock acceptChan = Control.Exception.handle (const $ putStrLn "exception on connect" >> acceptLoop servSock acceptChan) $ do
    33 	(cHandle, host, _) <- accept servSock
    33 	(cHandle, host, _) <- accept servSock
    34 	putStrLn $ "new client: " ++ host
       
    35 	currentTime <- getCurrentTime
    34 	currentTime <- getCurrentTime
       
    35 	putStrLn $ (show currentTime) ++ " new client: " ++ host
    36 	cChan <- atomically newTChan
    36 	cChan <- atomically newTChan
    37 	forkIO $ clientLoop cHandle cChan
    37 	forkIO $ clientLoop cHandle cChan
    38 	atomically $ writeTChan acceptChan (ClientInfo cChan cHandle host currentTime"" 0 "" False False False)
    38 	atomically $ writeTChan acceptChan (ClientInfo cChan cHandle host currentTime"" 0 "" False False False)
    39 	atomically $ writeTChan cChan ["ASKME"]
    39 	atomically $ writeTChan cChan ["ASKME"]
    40 	acceptLoop servSock acceptChan
    40 	acceptLoop servSock acceptChan