netserver/hedgewars-server.hs
changeset 1484 c01512115c12
parent 1483 89e24edb6020
child 1492 2da1fe033f23
equal deleted inserted replaced
1483:89e24edb6020 1484:c01512115c12
   110 mainLoop acceptChan messagesChan clients rooms = do
   110 mainLoop acceptChan messagesChan clients rooms = do
   111 	r <- atomically $
   111 	r <- atomically $
   112 		(Accept `fmap` readTChan acceptChan) `orElse`
   112 		(Accept `fmap` readTChan acceptChan) `orElse`
   113 		(ClientMessage `fmap` tselect clients) `orElse`
   113 		(ClientMessage `fmap` tselect clients) `orElse`
   114 		(CoreMessage `fmap` readTChan messagesChan)
   114 		(CoreMessage `fmap` readTChan messagesChan)
       
   115 	
   115 	case r of
   116 	case r of
   116 		Accept ci -> do
   117 		Accept ci -> do
   117 			let sameHostClients = filter (\cl -> host ci == host cl) clients
   118 			let sameHostClients = filter (\cl -> host ci == host cl) clients
   118 			let haveJustConnected = not $ null $ filter (\cl -> connectTime ci `diffUTCTime` connectTime cl <= 25) sameHostClients
   119 			let haveJustConnected = not $ null $ filter (\cl -> connectTime ci `diffUTCTime` connectTime cl <= 25) sameHostClients
   119 			
   120 			
   121 				atomically $ do
   122 				atomically $ do
   122 					--writeTChan (chan ci) ["ERROR", "Reconnected too fast"]
   123 					--writeTChan (chan ci) ["ERROR", "Reconnected too fast"]
   123 					writeTChan (chan ci) ["QUIT", "Reconnected too fast"]
   124 					writeTChan (chan ci) ["QUIT", "Reconnected too fast"]
   124 				
   125 				
   125 			mainLoop acceptChan messagesChan (clients ++ [ci]) rooms
   126 			mainLoop acceptChan messagesChan (clients ++ [ci]) rooms
       
   127 			
   126 		ClientMessage (cmd, client) -> do
   128 		ClientMessage (cmd, client) -> do
   127 			(clientsIn, mrooms) <- reactCmd cmd client clients rooms
   129 			(clientsIn, mrooms) <- reactCmd cmd client clients rooms
   128 			
   130 			
   129 			let hadRooms = (not $ null rooms) && (null mrooms)
   131 			let hadRooms = (not $ null rooms) && (null mrooms)
   130 				in unless ((not $ isDedicated globalOptions) && ((null clientsIn) || hadRooms)) $
   132 				in unless ((not $ isDedicated globalOptions) && ((null clientsIn) || hadRooms)) $
   131 					mainLoop acceptChan messagesChan clientsIn mrooms
   133 					mainLoop acceptChan messagesChan clientsIn mrooms
       
   134 		
   132 		CoreMessage msg ->
   135 		CoreMessage msg ->
   133 			if not $ null $ clients then
   136 			if not $ null $ clients then
   134 				do
   137 				do
   135 				let client = head clients -- don't care
   138 				let client = head clients -- don't care
   136 				(clientsIn, mrooms) <- reactCmd msg client clients rooms
   139 				(clientsIn, mrooms) <- reactCmd msg client clients rooms