--- a/gameServer/CMakeLists.txt Thu Sep 29 16:30:02 2022 +0200
+++ b/gameServer/CMakeLists.txt Wed Oct 05 22:39:07 2022 +0300
@@ -42,6 +42,7 @@
HandlerUtils.hs
JoinsMonitor.hs
NetRoutines.hs
+ CommandHelp.hs
Opts.hs
RoomsAndClients.hs
ServerCore.hs
--- a/gameServer/CommandHelp.hs Thu Sep 29 16:30:02 2022 +0200
+++ b/gameServer/CommandHelp.hs Wed Oct 05 22:39:07 2022 +0300
@@ -33,6 +33,8 @@
loc "/me <message>: Chat action, e.g. '/me eats pizza' becomes '* Player eats pizza'",
loc "/rnd: Flip a virtual coin and reply with 'heads' or 'tails'",
loc "/rnd [A] [B] [C] [...]: Reply with a random word from the given list",
+ loc "/msg <nick_without_spaces> <message> | /msg <[nick with spaces]> <message>: Send a direct message to the player",
+ loc "/allow_msg <all|registered|none>: Specify what kind of players are allowed to /msg you",
#if defined(OFFICIAL_SERVER)
loc "/watch <id>: Watch a demo stored on the server with the given ID",
#endif
--- a/gameServer/CoreTypes.hs Thu Sep 29 16:30:02 2022 +0200
+++ b/gameServer/CoreTypes.hs Wed Oct 05 22:39:07 2022 +0300
@@ -127,6 +127,8 @@
details :: Maybe GameDetails
}
+data AllowMsgState = AllowAll | AllowRegistered | AllowNone
+
data ClientInfo =
ClientInfo
{
@@ -152,6 +154,7 @@
isKickedFromServer :: !Bool,
isJoinedMidGame :: !Bool,
hasAskedList :: !Bool,
+ allowMsgState :: !AllowMsgState,
clientClan :: !(Maybe B.ByteString),
checkInfo :: !(Maybe CheckInfo),
eiLobbyChat,
--- a/gameServer/HWProtoCore.hs Thu Sep 29 16:30:02 2022 +0200
+++ b/gameServer/HWProtoCore.hs Wed Oct 05 22:39:07 2022 +0300
@@ -22,6 +22,7 @@
import Control.Monad.Reader
import Data.Maybe
import qualified Data.ByteString.Char8 as B
+import Text.Regex.TDFA
--------------------------------------
import CoreTypes
import HWProtoNEState
@@ -118,6 +119,8 @@
return [AnswerClients chans ["CHAT", nickGlobal, p]]
h "WATCH" f = return [QueryReplay f]
h "INFO" n | not $ B.null n = handleCmd ["INFO", n]
+ h "ALLOW_MSG" state = handleCmd ["ALLOW_MSG", state]
+ h "MSG" n = handleCmd ["MSG", n]
h "HELP" _ = handleCmd ["HELP"]
h "REGISTERED_ONLY" _ = serverAdminOnly $ do
rnc <- liftM snd ask
@@ -137,6 +140,56 @@
extractParameters p = let (a, b) = B.break (== ' ') p in (upperCase a, B.dropWhile (== ' ') b)
+handleCmd_loggedin ["MSG", nickMsg] = do
+ thisCl <- thisClient
+ thisNick <- clientNick
+ clChans <- thisClientChans
+ let addEcho nick msg a = AnswerClients clChans ["CHAT", thisNick, B.concat ["/msg [", nick, "] ", msg]] : a
+ let sendingMsgAllowed clientInfo = case allowMsgState clientInfo of
+ AllowAll -> True
+ AllowRegistered -> isRegistered thisCl
+ AllowNone -> False
+ let sendNickMsg nick msg = do
+ (_, rnc) <- ask
+ maybeClientId <- clientByNick nick
+ case maybeClientId of
+ Just cl -> let ci = client rnc cl in
+ if sendingMsgAllowed ci then
+ return [AnswerClients [sendChan ci]
+ ["CHAT", thisNick, B.concat ["[direct] ", msg]]]
+ else
+ return [Warning $ loc "Player is not allowing direct messages."]
+ Nothing -> return [Warning $ loc "Player is not online."]
+
+ case nickMsg =~ ("^[[:space:]]*\\[([^]\\[]*)\\][[:space:]]*(.*)$" :: B.ByteString) of
+ [[_, "", msg]] -> return [Warning $ loc "Invalid /msg command."]
+ [[_, nick, msg]] -> addEcho (B.strip nick) msg <$> sendNickMsg (B.strip nick) msg
+ [] -> case nickMsg =~ ("^[[:space:]]*([^[:space:]]+)[[:space:]]*(.*)$" :: B.ByteString) of
+ [[_, nick, msg]] -> addEcho nick msg <$> sendNickMsg nick msg
+ [] -> return [Warning $ loc "Invalid /msg command."]
+
+
+handleCmd_loggedin ["ALLOW_MSG", state] = do
+ cl <- thisClient
+ let statusMsg state = B.pack $ "Direct messages allowed: " ++ stateToStr state
+ let changeIgnoreState newState = [
+ ModifyClient (\c -> c{allowMsgState = newState}),
+ AnswerClients [sendChan cl] ["CHAT", nickServer, loc $ statusMsg newState]]
+ let maybeNewState = stateFromStr state
+ return $ maybe
+ [Warning unknownCmdWarningText] changeIgnoreState maybeNewState
+ where
+ stateFromStr str = case B.strip str of
+ "all" -> Just AllowAll
+ "registered" -> Just AllowRegistered
+ "none" -> Just AllowNone
+ _ -> Nothing
+ stateToStr state = case state of
+ AllowAll -> "all"
+ AllowRegistered -> "registered"
+ AllowNone -> "none"
+
+
handleCmd_loggedin ["INFO", asknick] = do
(_, rnc) <- ask
maybeClientId <- clientByNick asknick
--- a/gameServer/NetRoutines.hs Thu Sep 29 16:30:02 2022 +0200
+++ b/gameServer/NetRoutines.hs Wed Oct 05 22:39:07 2022 +0300
@@ -71,6 +71,7 @@
False
False
False
+ AllowAll
Nothing
Nothing
newEventsInfo