Implement filtering in server
authorunc0rr
Wed, 12 Aug 2009 12:44:42 +0000
changeset 2304 a6e733ad0366
parent 2303 f411e9f8e6d4
child 2305 a51f5f88f3cf
Implement filtering in server
gameServer/HWProtoInRoomState.hs
gameServer/Utils.hs
--- a/gameServer/HWProtoInRoomState.hs	Wed Aug 12 12:27:08 2009 +0000
+++ b/gameServer/HWProtoInRoomState.hs	Wed Aug 12 12:44:42 2009 +0000
@@ -159,7 +159,7 @@
 
 
 handleCmd_inRoom clID clients rooms ["EM", msg] =
-	if teamsInGame client > 0 then
+	if (teamsInGame client > 0) && (isLegalNetCommand msg) then
 		[ModifyRoom (\r -> r{roundMsgs = roundMsgs r |> msg}),
 		AnswerOthersInRoom ["EM", msg]]
 	else
--- a/gameServer/Utils.hs	Wed Aug 12 12:27:08 2009 +0000
+++ b/gameServer/Utils.hs	Wed Aug 12 12:44:42 2009 +0000
@@ -6,10 +6,12 @@
 import Data.Word
 import qualified Data.Map as Map
 import qualified Data.IntMap as IntMap
+import qualified Data.Set as Set
 import Numeric
 import Network.Socket
 import System.IO
 import qualified Data.List as List
+import Maybe
 -------------------------------------------------
 import qualified Codec.Binary.Base64 as Base64
 import qualified Codec.Binary.UTF8.String as UTF8
@@ -26,8 +28,21 @@
 toEngineMsg :: String -> String
 toEngineMsg msg = Base64.encode (fromIntegral (length msg) : (UTF8.encode msg))
 
---tselect :: [ClientInfo] -> STM ([String], ClientInfo)
---tselect = foldl orElse retry . map (\ci -> (flip (,) ci) `fmap` readTChan (chan ci))
+fromEngineMsg :: String -> Maybe String
+fromEngineMsg msg = Base64.decode msg >>= return . UTF8.decode >>= removeLength
+	where
+		removeLength (x:xs) = if length xs == ord x then Just xs else Nothing
+		removeLength _ = Nothing
+
+isLegalNetCommand :: String -> Bool
+isLegalNetCommand msg = test decoded
+	where
+		decoded = fromEngineMsg msg
+		test Nothing = False
+		test (Just "") = False
+		test (Just (m:ms)) = m `Set.member` legalMessages
+		legalMessages = Set.fromList $ "M#+LlRrUuDdZzAaSjJ,sFNpPwtghb12345" ++ slotMessages
+		slotMessages = ['\128', '\129', '\130', '\131', '\132', '\133', '\134', '\135', '\136', '\137', '\138']
 
 maybeRead :: Read a => String -> Maybe a
 maybeRead s = case reads s of