diff -r f185e7367dd3 -r bf92592915c6 gameServer/HWProtoCore.hs --- 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