hedgewars-draft: gameServer/NetRoutines.hs@9be6693c78cb (annotated)

2348 b39d826e1ccd Drop support for ghc 6.8, use 6.10 instead unc0rr parents: 2296 diff changeset	1	{-# LANGUAGE ScopedTypeVariables #-}
1804 4e78ad846fb6 New game server: unc0rr parents: diff changeset	2	module NetRoutines where
4e78ad846fb6 New game server: unc0rr parents: diff changeset	3
4e78ad846fb6 New game server: unc0rr parents: diff changeset	4	import Network
4e78ad846fb6 New game server: unc0rr parents: diff changeset	5	import Network.Socket
4e78ad846fb6 New game server: unc0rr parents: diff changeset	6	import System.IO
4e78ad846fb6 New game server: unc0rr parents: diff changeset	7	import Control.Concurrent
4e78ad846fb6 New game server: unc0rr parents: diff changeset	8	import Control.Concurrent.Chan
4e78ad846fb6 New game server: unc0rr parents: diff changeset	9	import Control.Concurrent.STM
2296 19f2f76dc346 Patch for compiling with 6.10 (define NEW_EXCEPTIONS to do that) unc0rr parents: 2245 diff changeset	10	import qualified Control.Exception as Exception
1804 4e78ad846fb6 New game server: unc0rr parents: diff changeset	11	import Data.Time
4e78ad846fb6 New game server: unc0rr parents: diff changeset	12	-----------------------------
4e78ad846fb6 New game server: unc0rr parents: diff changeset	13	import CoreTypes
4e78ad846fb6 New game server: unc0rr parents: diff changeset	14	import ClientIO
1917 c94045b70142 - Better ip2string implementation unc0rr parents: 1847 diff changeset	15	import Utils
1804 4e78ad846fb6 New game server: unc0rr parents: diff changeset	16
4e78ad846fb6 New game server: unc0rr parents: diff changeset	17	acceptLoop :: Socket -> Chan CoreMessage -> Int -> IO ()
4e78ad846fb6 New game server: unc0rr parents: diff changeset	18	acceptLoop servSock coreChan clientCounter = do
2867 9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2403 diff changeset	19	Exception.handle
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2403 diff changeset	20	(\(_ :: Exception.IOException) -> putStrLn "exception on connect") $
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2403 diff changeset	21	do
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2403 diff changeset	22	(socket, sockAddr) <- Network.Socket.accept servSock
1804 4e78ad846fb6 New game server: unc0rr parents: diff changeset	23
2867 9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2403 diff changeset	24	cHandle <- socketToHandle socket ReadWriteMode
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2403 diff changeset	25	hSetBuffering cHandle LineBuffering
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2403 diff changeset	26	clientHost <- sockAddr2String sockAddr
1804 4e78ad846fb6 New game server: unc0rr parents: diff changeset	27
2867 9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2403 diff changeset	28	currentTime <- getCurrentTime
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2403 diff changeset	29
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2403 diff changeset	30	sendChan <- newChan
1804 4e78ad846fb6 New game server: unc0rr parents: diff changeset	31
2867 9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2403 diff changeset	32	let newClient =
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2403 diff changeset	33	(ClientInfo
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2403 diff changeset	34	nextID
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2403 diff changeset	35	sendChan
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2403 diff changeset	36	cHandle
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2403 diff changeset	37	clientHost
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2403 diff changeset	38	currentTime
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2403 diff changeset	39	""
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2403 diff changeset	40	""
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2403 diff changeset	41	False
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2403 diff changeset	42	0
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2403 diff changeset	43	0
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2403 diff changeset	44	0
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2403 diff changeset	45	False
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2403 diff changeset	46	False
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2403 diff changeset	47	False
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2403 diff changeset	48	undefined
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2403 diff changeset	49	undefined
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2403 diff changeset	50	)
1804 4e78ad846fb6 New game server: unc0rr parents: diff changeset	51
2867 9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2403 diff changeset	52	writeChan coreChan $ Accept newClient
1804 4e78ad846fb6 New game server: unc0rr parents: diff changeset	53
2867 9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2403 diff changeset	54	forkIO $ clientRecvLoop cHandle coreChan nextID
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2403 diff changeset	55	forkIO $ clientSendLoop cHandle coreChan sendChan nextID
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2403 diff changeset	56	return ()
1804 4e78ad846fb6 New game server: unc0rr parents: diff changeset	57
2867 9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2403 diff changeset	58	acceptLoop servSock coreChan nextID
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2403 diff changeset	59	where
9be6693c78cb - Unbreak support for client versions prior to 0.9.13-dev unc0rr parents: 2403 diff changeset	60	nextID = clientCounter + 1

author	unc0rr
	Thu, 25 Feb 2010 18:28:33 +0000
changeset 2867	9be6693c78cb
parent 2403	6c5d504af2ba
child 3425	ead2ed20dfd4
permissions	-rw-r--r--