Skip to content

Commit c0f357d

Browse files
epoberezkinepoberezkin
authored
servers: control port session improvements (#1591)
* servers: prohibit changing role during control port session * quota for blocked queues * allow disabling blocking and quota * fix test * fix INI file
1 parent 40fc09a commit c0f357d

File tree

8 files changed

+47
-28
lines changed

8 files changed

+47
-28
lines changed

‎src/Simplex/FileTransfer/Server.hs‎

Lines changed: 3 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -54,7 +54,7 @@ import qualified Simplex.Messaging.Crypto.Lazy as LC
5454
import Simplex.Messaging.Encoding
5555
import Simplex.Messaging.Encoding.String
5656
import Simplex.Messaging.Protocol (BlockingInfo, EntityId (..), RcvPublicAuthKey, RcvPublicDhKey, RecipientId, SignedTransmission, pattern NoEntity)
57-
import Simplex.Messaging.Server (dummyVerifyCmd, verifyCmdAuthorization)
57+
import Simplex.Messaging.Server (controlPortAuth, dummyVerifyCmd, verifyCmdAuthorization)
5858
import Simplex.Messaging.Server.Control (CPClientRole (..))
5959
import Simplex.Messaging.Server.Expiration
6060
import Simplex.Messaging.Server.QueueStore (RoundedSystemTime, ServerEntityStatus (..), getRoundedSystemTime)
@@ -277,12 +277,9 @@ xftpServer cfg@XFTPServerConfig {xftpPort, transportConfig, inactiveClientExpira
277277
CPSkip -> False
278278
_ -> True
279279
processCP h role = \case
280-
CPAuth auth -> atomically $ writeTVar role $! newRole cfg
280+
CPAuth auth -> controlPortAuth h user admin role auth
281281
where
282-
newRole XFTPServerConfig {controlPortUserAuth = user, controlPortAdminAuth = admin}
283-
| Just auth == admin = CPRAdmin
284-
| Just auth == user = CPRUser
285-
| otherwise = CPRNone
282+
XFTPServerConfig {controlPortUserAuth = user, controlPortAdminAuth = admin} = cfg
286283
CPStatsRTS -> E.tryAny getRTSStats >>= either (hPrint h) (hPrint h)
287284
CPDelete fileId -> withUserRole $ unliftIO u $ do
288285
fs <- asks store

‎src/Simplex/Messaging/Notifications/Server.hs‎

Lines changed: 2 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -364,12 +364,9 @@ ntfServer cfg@NtfServerConfig {transports, transportConfig = tCfg, startOptions}
364364
CPSkip -> False
365365
_ -> True
366366
processCP h role = \case
367-
CPAuth auth -> atomically $ writeTVar role $! newRole cfg
367+
CPAuth auth -> controlPortAuth h user admin role auth
368368
where
369-
newRole NtfServerConfig {controlPortUserAuth = user, controlPortAdminAuth = admin}
370-
| Just auth == admin = CPRAdmin
371-
| Just auth == user = CPRUser
372-
| otherwise = CPRNone
369+
NtfServerConfig {controlPortUserAuth = user, controlPortAdminAuth = admin} = cfg
373370
CPStats -> withUserRole $ do
374371
ss <- unliftIO u $ asks serverStats
375372
let getStat :: (NtfServerStats -> IORef a) -> IO a

‎src/Simplex/Messaging/Server.hs‎

Lines changed: 33 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -31,6 +31,7 @@
3131
module Simplex.Messaging.Server
3232
( runSMPServer,
3333
runSMPServerBlocking,
34+
controlPortAuth,
3435
importMessages,
3536
exportMessages,
3637
printMessageStats,
@@ -558,6 +559,7 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg, startOpt
558559
msgNtfNoSub' <- atomicSwapIORef (msgNtfNoSub ss) 0
559560
msgNtfLost' <- atomicSwapIORef (msgNtfLost ss) 0
560561
msgNtfExpired' <- atomicSwapIORef (msgNtfExpired ss) 0
562+
_qBlocked <- atomicSwapIORef (qBlocked ss) 0 -- not logged, only reset
561563
pRelays' <- getResetProxyStatsData pRelays
562564
pRelaysOwn' <- getResetProxyStatsData pRelaysOwn
563565
pMsgFwds' <- getResetProxyStatsData pMsgFwds
@@ -770,12 +772,9 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg, startOpt
770772
CPSkip -> False
771773
_ -> True
772774
processCP h role = \case
773-
CPAuth auth -> atomically $ writeTVar role $! newRole cfg
775+
CPAuth auth -> controlPortAuth h user admin role auth
774776
where
775-
newRole ServerConfig {controlPortUserAuth = user, controlPortAdminAuth = admin}
776-
| Just auth == admin = CPRAdmin
777-
| Just auth == user = CPRUser
778-
| otherwise = CPRNone
777+
ServerConfig {controlPortUserAuth = user, controlPortAdminAuth = admin} = cfg
779778
CPSuspend -> withAdminRole $ hPutStrLn h "suspend not implemented"
780779
CPResume -> withAdminRole $ hPutStrLn h "resume not implemented"
781780
CPClients -> withAdminRole $ do
@@ -964,7 +963,7 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg, startOpt
964963
SubPending -> (c1, c2 + 1, c3, c4)
965964
SubThread _ -> (c1, c2, c3 + 1, c4)
966965
ProhibitSub -> pure (c1, c2, c3, c4 + 1)
967-
CPDelete sId -> withUserRole $ unliftIO u $ do
966+
CPDelete sId -> withAdminRole $ unliftIO u $ do
968967
st <- asks msgStore
969968
r <- liftIO $ runExceptT $ do
970969
q <- ExceptT $ getQueue st SSender sId
@@ -983,14 +982,20 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg, startOpt
983982
"status: " <> show status <> ", updatedAt: " <> show updatedAt <> ", queueMode: " <> show queueMode
984983
CPBlock sId info -> withUserRole $ unliftIO u $ do
985984
st <- asks msgStore
986-
r <- liftIO $ runExceptT $ do
987-
q <- ExceptT $ getQueue st SSender sId
988-
ExceptT $ blockQueue (queueStore st) q info
989-
case r of
990-
Left e -> liftIO $ hPutStrLn h $ "error: " <> show e
991-
Right () -> do
992-
incStat . qBlocked =<< asks serverStats
993-
liftIO $ hPutStrLn h "ok"
985+
stats <- asks serverStats
986+
blocked <- liftIO $ readIORef $ qBlocked stats
987+
let quota = dailyBlockQueueQuota cfg
988+
if blocked >= quota && quota /= 0
989+
then liftIO $ hPutStrLn h $ "error: reached limit of " <> show quota <> " queues blocked daily"
990+
else do
991+
r <- liftIO $ runExceptT $ do
992+
q <- ExceptT $ getQueue st SSender sId
993+
ExceptT $ blockQueue (queueStore st) q info
994+
case r of
995+
Left e -> liftIO $ hPutStrLn h $ "error: " <> show e
996+
Right () -> do
997+
incStat $ qBlocked stats
998+
liftIO $ hPutStrLn h "ok"
994999
CPUnblock sId -> withUserRole $ unliftIO u $ do
9951000
st <- asks msgStore
9961001
r <- liftIO $ runExceptT $ do
@@ -1045,6 +1050,20 @@ runClientTransport h@THandle {params = thParams@THandleParams {sessionId}} = do
10451050
where
10461051
hasSubs ServerSubscribers {subClients} = IS.member clientId <$> readTVarIO subClients
10471052

1053+
controlPortAuth :: Handle -> Maybe BasicAuth -> Maybe BasicAuth -> TVar CPClientRole -> BasicAuth -> IO ()
1054+
controlPortAuth h user admin role auth = do
1055+
readTVarIO role >>= \case
1056+
CPRNone -> do
1057+
atomically $ writeTVar role $! newRole
1058+
hPutStrLn h $ currentRole newRole
1059+
r -> hPutStrLn h $ currentRole r <> if r == newRole then "" else ", start new session to change."
1060+
where
1061+
currentRole r = "Current role is " <> show r
1062+
newRole
1063+
| Just auth == admin = CPRAdmin
1064+
| Just auth == user = CPRUser
1065+
| otherwise = CPRNone
1066+
10481067
clientDisconnected :: forall s. Client s -> M s ()
10491068
clientDisconnected c@Client {clientId, subscriptions, ntfSubscriptions, serviceSubsCount, ntfServiceSubsCount, connected, clientTHParams = THandleParams {sessionId, thAuth}, endThreads} = do
10501069
labelMyThread . B.unpack $ "client $" <> encode sessionId <> " disc"

‎src/Simplex/Messaging/Server/Control.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -8,7 +8,7 @@ import Simplex.Messaging.Encoding.String
88
import Simplex.Messaging.Protocol (BasicAuth, BlockingInfo, SenderId)
99

1010
data CPClientRole = CPRNone | CPRUser | CPRAdmin
11-
deriving (Eq)
11+
deriving (Eq, Show)
1212

1313
data ControlProtocol
1414
= CPAuth BasicAuth

‎src/Simplex/Messaging/Server/Env/STM.hs‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -149,6 +149,7 @@ data ServerConfig s = ServerConfig
149149
-- | control port passwords,
150150
controlPortUserAuth :: Maybe BasicAuth,
151151
controlPortAdminAuth :: Maybe BasicAuth,
152+
dailyBlockQueueQuota :: Int,
152153
-- | time after which the messages can be removed from the queues and check interval, seconds
153154
messageExpiration :: Maybe ExpirationConfig,
154155
expireMessagesOnStart :: Bool,

‎src/Simplex/Messaging/Server/Main.hs‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -420,6 +420,7 @@ smpServerCLI_ generateSite serveStaticFiles attachStaticFiles cfgPath logPath =
420420
newQueueBasicAuth = either error id <$!> strDecodeIni "AUTH" "create_password" ini,
421421
controlPortAdminAuth = either error id <$!> strDecodeIni "AUTH" "control_port_admin_password" ini,
422422
controlPortUserAuth = either error id <$!> strDecodeIni "AUTH" "control_port_user_password" ini,
423+
dailyBlockQueueQuota = readIniDefault 20 "AUTH" "daily_block_queue_quota" ini,
423424
messageExpiration =
424425
Just
425426
defaultMessageExpiration

‎src/Simplex/Messaging/Server/Main/Init.hs‎

Lines changed: 5 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -107,8 +107,11 @@ iniFileContent cfgPath logPath opts host basicAuth controlPortPwds =
107107
)
108108
<> "\n\n"
109109
<> (optDisabled controlPortPwds <> "control_port_admin_password: " <> maybe "" fst controlPortPwds <> "\n")
110-
<> (optDisabled controlPortPwds <> "control_port_user_password: " <> maybe "" snd controlPortPwds <> "\n")
111-
<> "\n\
110+
<> (optDisabled controlPortPwds <> "control_port_user_password: " <> maybe "" snd controlPortPwds <> "\n\n")
111+
<> "# The limit for queues that can be blocked via control port per day, resets at 0:00 UTC.\n\
112+
\# Set to 0 to disable limit, to -1 to prohibit blocking. Default is 20.\n\
113+
\# daily_block_queue_quota: 20\n\
114+
\\n\
112115
\[TRANSPORT]\n\
113116
\# Host is only used to print server address on start.\n\
114117
\# You can specify multiple server ports.\n"

‎tests/SMPClient.hs‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -226,6 +226,7 @@ cfgMS msType = withStoreCfg (testServerStoreConfig msType) $ \serverStoreCfg ->
226226
newQueueBasicAuth = Nothing,
227227
controlPortUserAuth = Nothing,
228228
controlPortAdminAuth = Nothing,
229+
dailyBlockQueueQuota = 20,
229230
messageExpiration = Just defaultMessageExpiration,
230231
expireMessagesOnStart = True,
231232
idleQueueInterval = defaultIdleQueueInterval,

0 commit comments

Comments
 (0)