Allow toggling registration requirement on live server
authorunc0rr
Mon, 28 Dec 2015 21:21:02 +0300
changeset 11470 0ae2e4c13bd1
parent 11469 a9957113404a
child 11471 4b5c7a5c49fd
Allow toggling registration requirement on live server
gameServer/Actions.hs
gameServer/CoreTypes.hs
gameServer/HWProtoCore.hs
--- a/gameServer/Actions.hs	Mon Dec 28 09:06:29 2015 +0300
+++ b/gameServer/Actions.hs	Mon Dec 28 21:21:02 2015 +0300
@@ -466,12 +466,15 @@
 
 
 processAction (ProcessAccountInfo info) = do
+    si <- gets serverInfo
     case info of
         HasAccount passwd isAdmin isContr -> do
             b <- isBanned
             c <- client's isChecker
             when (not b) $ (if c then checkerLogin else playerLogin) passwd isAdmin isContr
-        Guest -> do
+        Guest | isRegisteredUsersOnly si -> do
+            processAction $ ByeClient "Registered users only"
+            | otherwise -> do
             b <- isBanned
             c <- client's isChecker
             when (not b) $
--- a/gameServer/CoreTypes.hs	Mon Dec 28 09:06:29 2015 +0300
+++ b/gameServer/CoreTypes.hs	Mon Dec 28 21:21:02 2015 +0300
@@ -281,6 +281,7 @@
     ServerInfo
     {
         isDedicated :: Bool,
+        isRegisteredUsersOnly :: Bool,
         serverMessage :: B.ByteString,
         serverMessageForOldVersions :: B.ByteString,
         latestReleaseVersion :: Word16,
@@ -304,6 +305,7 @@
 newServerInfo =
     ServerInfo
         True
+        False
         "<h2><p align=center><a href=\"http://www.hedgewars.org/\">http://www.hedgewars.org/</a></p></h2>"
         "<font color=yellow><h3 align=center>Hedgewars 0.9.22 is out! Please update.</h3><p align=center><a href=http://hedgewars.org/download.html>Download page here</a></font>"
         51 -- latestReleaseVersion
--- a/gameServer/HWProtoCore.hs	Mon Dec 28 09:06:29 2015 +0300
+++ b/gameServer/HWProtoCore.hs	Mon Dec 28 21:21:02 2015 +0300
@@ -92,6 +92,11 @@
         h "MAXTEAMS" n | not $ B.null n = handleCmd ["MAXTEAMS", n]
         h "INFO" n | not $ B.null n = handleCmd ["INFO", n]
         h "RESTART_SERVER" "YES" = handleCmd ["RESTART_SERVER"]
+        h "REGISTERED_ONLY" _ = do
+            cl <- thisClient
+            return [ModifyServerInfo(\s -> s{isRegisteredUsersOnly = not $ isRegisteredUsersOnly s})
+                , AnswerClients [sendChan cl] ["CHAT", "[server]", "'Registered only' state toggled"]
+                ]
         h c p = return [Warning $ B.concat ["Unknown cmd: /", c, " ", p]]
 
         extractParameters p = let (a, b) = B.break (== ' ') p in (upperCase a, B.dropWhile (== ' ') b)