dandri/simplexmq
1
0
Fork 0
mirror of https://github.com/simplex-chat/simplexmq.git synced 2026-07-21 11:12:03 +00:00
Code Issues Packages Projects Releases Wiki Activity

Merge branch 'master' into f/ntf-change-creds

Browse Source
This commit is contained in:
Evgeny Poberezkin
2024-09-11 19:32:16 +01:00
parent c9bee6e590 30e15b881f
commit 6cc19b38bc
20 changed files with 324 additions and 104 deletions
Download Patch File Download Diff File Expand all files Collapse all files
CHANGELOG.md
+22
View File
@@ -1,3 +1,25 @@
# 6.0.4
SMP server:
- better performance/memory: fewer map updates on re-subscriptions (#1297), split and reduce STM transactions (#1294)
- send DELD when subscribed queue is deleted (#1312)
- add created/updated/used date to queues to manage expiration (#1306)
XFTP server: truncate file creation time to 1 hour (#1310)
Servers:
- bind control port only to 127.0.0.1 for better security in case of firewall misconfiguration (#1280)
- reduce memory used for period stats (#1298)
Agent: process last notification from list (#1307)
- report receive file error with redirected file ID, when redirect is present (#1304)
- special error when deleted user record is not in database (#1303)
- fix race when sending a message to the deleted connection (#1296)
- support for multiple messages in a single notification
Ntf server:
- only use SOCKS proxy for servers without public address (#1314)
# 6.0.3
Agent:
package.yaml
+1 -1
View File
@@ -1,5 +1,5 @@
name: simplexmq
version: 6.0.3.0
version: 6.0.4.0
synopsis: SimpleXMQ message broker
description: |
This package includes <./docs/Simplex-Messaging-Server.html server>,
protocol/xrcp.md
+2 -2
View File
@@ -250,7 +250,7 @@ In pseudo-code:
```
// session 1
hostHelloSecret(1) = dhSecret(1)
sessionSecret(1) = sha3-256(dhSecret(1) || kemSecret(1)) // to encrypt session 1 data, incl. controller hello
sessionSecret(1) = sha256(dhSecret(1) || kemSecret(1)) // to encrypt session 1 data, incl. controller hello
dhSecret(1) = dh(hostHelloDhKey(1), controllerInvitationDhKey(1))
kemCiphertext(1) = enc(kemSecret(1), kemEncKey(1))
// kemEncKey is included in host HELLO, kemCiphertext - in controller HELLO
@@ -262,7 +262,7 @@ dhSecret(n') = dh(hostHelloDhKey(n - 1), controllerDhKey(n))
// session n
hostHelloSecret(n) = dhSecret(n)
sessionSecret(n) = sha3-256(dhSecret(n) || kemSecret(n)) // to encrypt session n data, incl. controller hello
sessionSecret(n) = sha256(dhSecret(n) || kemSecret(n)) // to encrypt session n data, incl. controller hello
dhSecret(n) = dh(hostHelloDhKey(n), controllerDhKey(n))
// controllerDhKey(n) is either from invitation or from multicast announcement
kemCiphertext(n) = enc(kemSecret(n), kemEncKey(n))
scripts/main/simplex-servers-stopscript
+165 -21
View File
@@ -1,30 +1,174 @@
#!/usr/bin/env sh
set -eu
path_conf_var="/var/opt"
path_conf_smp="$path_conf_var/simplex"
path_conf_xftp="$path_conf_var/simplex-xftp"
path_conf_storelog_smp="$path_conf_smp/smp-server-store.log"
path_conf_storelog_xftp="$path_conf_xftp/file-server-store.log"
# Common
# ------
date="$(date -u '+%Y-%m-%dT%H:%M:%S')"
backup_smp() {
if [ -e "$path_conf_storelog_smp" ]; then
cp "$path_conf_storelog_smp" "${path_conf_storelog_smp}.${date:-date-failed}"
fi
GRN='\033[0;32m'
YLW='\033[1;33m'
BLU='\033[1;34m'
RED='\033[0;31m'
NC='\033[0m'
path_conf_var="/var/opt"
smp_variables() {
path_conf_smp="$path_conf_var/simplex"
path_conf_smp_archive="$path_conf_smp/backups"
path_conf_smp_archive_storelog="$path_conf_smp_archive/queues"
path_conf_smp_archive_stats="$path_conf_smp_archive/stats"
path_conf_smp_archive_messages="$path_conf_smp_archive/messages"
path_conf_storelog_smp="$path_conf_smp/smp-server-store.log"
path_conf_storelog_smp_out="$path_conf_smp_archive_storelog/smp-server-store.log.${date:-date-failed}"
path_conf_stats_smp="$path_conf_smp/smp-server-stats.log"
path_conf_stats_smp_out="$path_conf_smp_archive_stats/smp-server-stats.log.${date:-date-failed}"
path_conf_messages_smp="$path_conf_smp/smp-server-messages.log"
path_conf_messages_smp_out="$path_conf_smp_archive_messages/smp-server-messages.log.${date:-date-failed}"
}
backup_xftp() {
if [ -e "$path_conf_storelog_xftp" ]; then
cp "$path_conf_storelog_xftp" "${path_conf_storelog_xftp}.${date:-date-failed}"
fi
xftp_variables() {
path_conf_xftp="$path_conf_var/simplex-xftp"
path_conf_xftp_archive="$path_conf_xftp/backups"
path_conf_xftp_archive_storelog="$path_conf_xftp_archive/queues"
path_conf_xftp_archive_stats="$path_conf_xftp_archive/stats"
path_conf_storelog_xftp="$path_conf_xftp/file-server-store.log"
path_conf_storelog_xftp_out="$path_conf_xftp_archive_storelog/file-server-store.log.${date:-date-failed}"
path_conf_stats_xftp="$path_conf_xftp/file-server-stats.log"
path_conf_stats_xftp_out="$path_conf_xftp_archive_stats/file-server-stats.log.${date:-date-failed}"
}
if [ "$1" = 'smp-server' ]; then
backup_smp
elif [ "$1" = 'xftp-server' ]; then
backup_xftp
else
backup_smp
backup_xftp
fi
checks() {
result=${SERVICE_RESULT:-exit-code}
status=${EXIT_STATUS:-TERM}
case "$result" in
success)
case "$status" in
TERM)
printf "${RED}Refusing to backup files with failed service state${NC}\n"
exit 1
;;
*)
:
;;
esac
;;
*)
printf "${RED}Refusing to backup files with failed service state${NC}\n"
exit 1
;;
esac
}
smp_check() {
if [ ! -d "$path_conf_smp_archive_storelog" ]; then
mkdir -p "$path_conf_smp_archive_storelog"
fi
if [ ! -d "$path_conf_smp_archive_messages" ]; then
mkdir -p "$path_conf_smp_archive_messages"
fi
if [ ! -d "$path_conf_smp_archive_stats" ]; then
mkdir -p "$path_conf_smp_archive_stats"
fi
}
xftp_check() {
if [ ! -d "$path_conf_xftp_archive_storelog" ]; then
mkdir -p "$path_conf_xftp_archive_storelog"
fi
if [ ! -d "$path_conf_xftp_archive_stats" ]; then
mkdir -p "$path_conf_xftp_archive_stats"
fi
}
backup() {
file="$1"
out="$2"
file_type="$3"
if [ -e "$file" ]; then
if cp "$file" "$out"; then
printf "${YLW}${file_type}${NC} ${GRN}backup successful:${NC} ${BLU}%s${NC}\n" "${out}"
else
printf "${YLW}${file_type}${NC} ${RED}backup failed!${NC}\n"
fi
fi
unset file out file_type
}
cleanup() {
directory="$1"
file_type="$2"
files_date=$(find "$directory" -type f -exec stat --format="%y" {} + | awk '{print $1}' | sort -nr | uniq | awk 'NR==2')
if [ -n "$files_date" ]; then
files=$(find "$directory" -type f -not -newermt "$files_date" -printf "%T@ %Tc %p\n" | sort -n | awk '{print $NF}')
if [ -n "$files" ]; then
printf '%s' "$files" | xargs rm -f
printf "${YLW}Old ${file_type} files${NC}${GRN} has been deleted:${NC}\n"
files_colored=$(printf '%s' "$files" | awk '{print "\033[1;34m"$0"\033[0m"}')
printf "${files_colored}\n"
fi
fi
unset directory file_type files_date files
}
smp_backup() {
backup "$path_conf_storelog_smp" "$path_conf_storelog_smp_out" 'Storelog'
backup "$path_conf_messages_smp" "$path_conf_messages_smp_out" 'Messages'
backup "$path_conf_stats_smp" "$path_conf_stats_smp_out" 'Stats'
}
smp_cleanup() {
cleanup "$path_conf_smp_archive_storelog" 'storelog'
cleanup "$path_conf_smp_archive_stats" 'stats'
cleanup "$path_conf_smp_archive_messages" 'messages'
}
xftp_backup() {
backup "$path_conf_storelog_xftp" "$path_conf_storelog_xftp_out" 'Storelog'
backup "$path_conf_stats_xftp" "$path_conf_stats_xftp_out" 'Stats'
}
xftp_cleanup() {
cleanup "$path_conf_xftp_archive_storelog" 'storelog'
cleanup "$path_conf_xftp_archive_stats" 'stats'
}
main() {
type="${1:-}"
checks
case "$type" in
smp-server)
smp_variables
smp_check
smp_backup
smp_cleanup
;;
xftp-server)
xftp_variables
xftp_check
xftp_backup
xftp_cleanup
;;
*)
printf "${YLW}Unknown server type.${NC}\n"
exit 1
;;
esac
}
main "$@"
simplexmq.cabal
+1 -1
View File
@@ -5,7 +5,7 @@ cabal-version: 1.12
-- see: https://github.com/sol/hpack
name: simplexmq
version: 6.0.3.0
version: 6.0.4.0
synopsis: SimpleXMQ message broker
description: This package includes <./docs/Simplex-Messaging-Server.html server>,
<./docs/Simplex-Messaging-Client.html client> and
src/Simplex/Messaging/Agent.hs
+11 -13
View File
@@ -166,7 +166,7 @@ import Simplex.Messaging.Agent.Store
import Simplex.Messaging.Agent.Store.SQLite
import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
import qualified Simplex.Messaging.Agent.Store.SQLite.Migrations as Migrations
import Simplex.Messaging.Client (ProtocolClient (..), SMPClientError, ServerTransmission (..), ServerTransmissionBatch, temporaryClientError, unexpectedResponse)
import Simplex.Messaging.Client (SMPClientError, ServerTransmission (..), ServerTransmissionBatch, temporaryClientError, unexpectedResponse)
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Crypto.File (CryptoFile, CryptoFileArgs)
import Simplex.Messaging.Crypto.Ratchet (PQEncryption, PQSupport (..), pattern PQEncOff, pattern PQEncOn, pattern PQSupportOff, pattern PQSupportOn)
@@ -181,7 +181,7 @@ import Simplex.Messaging.Protocol (BrokerMsg, Cmd (..), ErrorType (AUTH), MsgBod
import qualified Simplex.Messaging.Protocol as SMP
import Simplex.Messaging.ServiceScheme (ServiceScheme (..))
import qualified Simplex.Messaging.TMap as TM
import Simplex.Messaging.Transport (SMPVersion, THandleParams (sessionId))
import Simplex.Messaging.Transport (SMPVersion)
import Simplex.Messaging.Util
import Simplex.Messaging.Version
import Simplex.RemoteControl.Client
@@ -1984,7 +1984,7 @@ deleteNtfToken' :: AgentClient -> DeviceToken -> AM ()
deleteNtfToken' c deviceToken =
withStore' c getSavedNtfToken >>= \case
Just tkn@NtfToken {deviceToken = savedDeviceToken} -> do
when (deviceToken /= savedDeviceToken) . throwE $ CMD PROHIBITED "deleteNtfToken: different token"
when (deviceToken /= savedDeviceToken) $ logWarn "deleteNtfToken: different token"
deleteToken_ c tkn
deleteNtfSubs c NSCSmpDelete
_ -> throwE $ CMD PROHIBITED "deleteNtfToken: no token"
@@ -2021,17 +2021,18 @@ toggleConnectionNtfs' c connId enable = do
atomically $ sendNtfSubCommand ns (connId, cmd)
deleteToken_ :: AgentClient -> NtfToken -> AM ()
deleteToken_ c tkn@NtfToken {ntfTokenId, ntfTknStatus} = do
deleteToken_ c@AgentClient {subQ} tkn@NtfToken {ntfTokenId, ntfTknStatus} = do
ns <- asks ntfSupervisor
forM_ ntfTokenId $ \tknId -> do
let ntfTknAction = Just NTADelete
withStore' c $ \db -> updateNtfToken db tkn ntfTknStatus ntfTknAction
atomically $ nsUpdateToken ns tkn {ntfTknStatus, ntfTknAction}
agentNtfDeleteToken c tknId tkn `catchAgentError` \case
NTF _ AUTH -> pure ()
e -> throwE e
agentNtfDeleteToken c tknId tkn `catchAgentError` \e -> notify (ERR e) -- TODO cleanup task
withStore' c $ \db -> removeNtfToken db tkn
atomically $ nsRemoveNtfToken ns
where
notify :: forall e. AEntityI e => AEvent e -> AM ()
notify cmd = atomically $ writeTBQueue subQ ("", "", AEvt (sAEntity @e) cmd)
withToken :: AgentClient -> NtfToken -> Maybe (NtfTknStatus, NtfTknAction) -> (NtfTknStatus, Maybe NtfTknAction) -> AM a -> AM NtfTknStatus
withToken c tkn@NtfToken {deviceToken, ntfMode} from_ (toStatus, toAction_) f = do
@@ -2450,17 +2451,14 @@ processSMPTransmissions c@AgentClient {subQ} (tSess@(userId, srv, _), _v, sessId
handleNotifyAck :: AM ACKd -> AM ACKd
handleNotifyAck m = m `catchAgentError` \e -> notify (ERR e) >> ack
SMP.END ->
atomically (TM.lookup tSess (smpClients c) $>>= (tryReadTMVar . sessionVar) >>= processEND)
atomically (ifM (activeClientSession c tSess sessId) (removeSubscription c connId $> True) (pure False))
>>= notifyEnd
where
processEND = \case
Just (Right clnt)
| sessId == sessionId (thParams $ connectedClient clnt) ->
removeSubscription c connId $> True
_ -> pure False
notifyEnd removed
| removed = notify END >> logServer "<--" c srv rId "END"
| otherwise = logServer "<--" c srv rId "END from disconnected client - ignored"
-- Possibly, we need to add some flag to connection that it was deleted
SMP.DELD -> atomically (removeSubscription c connId) >> notify DELD
SMP.ERR e -> notify $ ERR $ SMP (B.unpack $ strEncode srv) e
r -> unexpected r
where
src/Simplex/Messaging/Agent/Protocol.hs
+3
View File
@@ -344,6 +344,7 @@ data AEvent (e :: AEntity) where
INFO :: PQSupport -> ConnInfo -> AEvent AEConn
CON :: PQEncryption -> AEvent AEConn -- notification that connection is established
END :: AEvent AEConn
DELD :: AEvent AEConn
CONNECT :: AProtocolType -> TransportHost -> AEvent AENone
DISCONNECT :: AProtocolType -> TransportHost -> AEvent AENone
DOWN :: SMPServer -> [ConnId] -> AEvent AENone
@@ -413,6 +414,7 @@ data AEventTag (e :: AEntity) where
INFO_ :: AEventTag AEConn
CON_ :: AEventTag AEConn
END_ :: AEventTag AEConn
DELD_ :: AEventTag AEConn
CONNECT_ :: AEventTag AENone
DISCONNECT_ :: AEventTag AENone
DOWN_ :: AEventTag AENone
@@ -466,6 +468,7 @@ aEventTag = \case
INFO {} -> INFO_
CON _ -> CON_
END -> END_
DELD -> DELD_
CONNECT {} -> CONNECT_
DISCONNECT {} -> DISCONNECT_
DOWN {} -> DOWN_
src/Simplex/Messaging/Crypto/SNTRUP761.hs
+2 -2
View File
@@ -4,7 +4,7 @@
module Simplex.Messaging.Crypto.SNTRUP761 where
import Crypto.Hash (Digest, SHA3_256, hash)
import Crypto.Hash (Digest, SHA256, hash)
import Data.ByteArray (ScrubbedBytes)
import qualified Data.ByteArray as BA
import Data.ByteString (ByteString)
@@ -28,4 +28,4 @@ kcbEncrypt (KEMHybridSecret k) = sbEncrypt_ k
kemHybridSecret :: PublicKeyX25519 -> PrivateKeyX25519 -> KEMSharedKey -> KEMHybridSecret
kemHybridSecret k pk (KEMSharedKey kem) =
let DhSecretX25519 dh = C.dh' k pk
in KEMHybridSecret $ BA.convert (hash $ BA.convert dh <> kem :: Digest SHA3_256)
in KEMHybridSecret $ BA.convert (hash $ BA.convert dh <> kem :: Digest SHA256)
src/Simplex/Messaging/Notifications/Protocol.hs
+5
View File
@@ -443,6 +443,8 @@ data NtfSubStatus
NSInactive
| -- | END received
NSEnd
| -- | DELD received (connection was deleted)
NSDeleted
| -- | SMP AUTH error
NSAuth
| -- | SMP error other than AUTH
@@ -456,6 +458,7 @@ ntfShouldSubscribe = \case
NSActive -> True
NSInactive -> True
NSEnd -> False
NSDeleted -> False
NSAuth -> False
NSErr _ -> False
@@ -466,6 +469,7 @@ instance Encoding NtfSubStatus where
NSActive -> "ACTIVE"
NSInactive -> "INACTIVE"
NSEnd -> "END"
NSDeleted -> "DELETED"
NSAuth -> "AUTH"
NSErr err -> "ERR " <> err
smpP =
@@ -475,6 +479,7 @@ instance Encoding NtfSubStatus where
"ACTIVE" -> pure NSActive
"INACTIVE" -> pure NSInactive
"END" -> pure NSEnd
"DELETED" -> pure NSDeleted
"AUTH" -> pure NSAuth
"ERR" -> NSErr <$> (A.space *> A.takeByteString)
_ -> fail "bad NtfSubStatus"
src/Simplex/Messaging/Notifications/Server.hs
+1
View File
@@ -226,6 +226,7 @@ ntfSubscriber NtfSubscriber {smpSubscribers, newSubQ, smpAgent = ca@SMPClientAge
Right SMP.END ->
whenM (atomically $ activeClientSession' ca sessionId srv) $
updateSubStatus smpQueue NSEnd
Right SMP.DELD -> updateSubStatus smpQueue NSDeleted
Right (SMP.ERR e) -> logError $ "SMP server error: " <> tshow e
Right _ -> logError "SMP server unexpected response"
Left e -> logError $ "SMP client error: " <> tshow e
src/Simplex/Messaging/Notifications/Server/Main.hs
+8 -1
View File
@@ -16,7 +16,7 @@ import qualified Data.Text as T
import qualified Data.Text.IO as T
import Network.Socket (HostName)
import Options.Applicative
import Simplex.Messaging.Client (NetworkConfig (..), ProtocolClientConfig (..), SocksMode (..), defaultNetworkConfig)
import Simplex.Messaging.Client (HostMode (..), NetworkConfig (..), ProtocolClientConfig (..), SocksMode (..), defaultNetworkConfig)
import Simplex.Messaging.Client.Agent (SMPClientAgentConfig (..), defaultSMPClientAgentConfig)
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Notifications.Server (runNtfServer)
@@ -26,6 +26,7 @@ import Simplex.Messaging.Notifications.Transport (supportedNTFHandshakes, suppor
import Simplex.Messaging.Protocol (ProtoServerWithAuth (..), pattern NtfServer)
import Simplex.Messaging.Server.CLI
import Simplex.Messaging.Server.Expiration
import Simplex.Messaging.Server.Main (textToHostMode)
import Simplex.Messaging.Transport (simplexMQVersion)
import Simplex.Messaging.Transport.Client (TransportHost (..))
import Simplex.Messaging.Transport.Server (TransportServerConfig (..), defaultTransportServerConfig)
@@ -92,6 +93,10 @@ ntfServerCLI cfgPath logPath =
<> "websockets: off\n\n\
\[SUBSCRIBER]\n\
\# Network configuration for notification server client.\n\
\# `host_mode` can be 'public' (default) or 'onion'.\n\
\# It defines prefferred hostname for destination servers with multiple hostnames.\n\
\# host_mode: public\n\
\# required_host_mode: off\n\n\
\# SOCKS proxy port for subscribing to SMP servers.\n\
\# You may need a separate instance of SOCKS proxy for incoming single-hop requests.\n\
\# socks_proxy: localhost:9050\n\n\
@@ -134,6 +139,8 @@ ntfServerCLI cfgPath logPath =
defaultNetworkConfig
{ socksProxy = either error id <$!> strDecodeIni "SUBSCRIBER" "socks_proxy" ini,
socksMode = maybe SMOnion (either error id) $! strDecodeIni "SUBSCRIBER" "socks_mode" ini,
hostMode = either (const HMPublic) textToHostMode $ lookupValue "SUBSCRIBER" "host_mode" ini,
requiredHostMode = fromMaybe False $ iniOnOff "SUBSCRIBER" "required_host_mode" ini,
smpPingInterval = 60_000_000 -- 1 minutes
}
},
src/Simplex/Messaging/Protocol.hs
+8
View File
@@ -484,6 +484,7 @@ data BrokerMsg where
RRES :: EncFwdResponse -> BrokerMsg -- relay to proxy
PRES :: EncResponse -> BrokerMsg -- proxy to client
END :: BrokerMsg
DELD :: BrokerMsg
INFO :: QueueInfo -> BrokerMsg
OK :: BrokerMsg
ERR :: ErrorType -> BrokerMsg
@@ -705,6 +706,7 @@ data BrokerMsgTag
| RRES_
| PRES_
| END_
| DELD_
| INFO_
| OK_
| ERR_
@@ -778,6 +780,7 @@ instance Encoding BrokerMsgTag where
RRES_ -> "RRES"
PRES_ -> "PRES"
END_ -> "END"
DELD_ -> "DELD"
INFO_ -> "INFO"
OK_ -> "OK"
ERR_ -> "ERR"
@@ -794,6 +797,7 @@ instance ProtocolMsgTag BrokerMsgTag where
"RRES" -> Just RRES_
"PRES" -> Just PRES_
"END" -> Just END_
"DELD" -> Just DELD_
"INFO" -> Just INFO_
"OK" -> Just OK_
"ERR" -> Just ERR_
@@ -1423,6 +1427,9 @@ instance ProtocolEncoding SMPVersion ErrorType BrokerMsg where
RRES (EncFwdResponse encBlock) -> e (RRES_, ' ', Tail encBlock)
PRES (EncResponse encBlock) -> e (PRES_, ' ', Tail encBlock)
END -> e END_
DELD
| v >= deletedEventSMPVersion -> e DELD_
| otherwise -> e END_
INFO info -> e (INFO_, ' ', info)
OK -> e OK_
ERR err -> e (ERR_, ' ', err)
@@ -1448,6 +1455,7 @@ instance ProtocolEncoding SMPVersion ErrorType BrokerMsg where
RRES_ -> RRES <$> (EncFwdResponse . unTail <$> _smpP)
PRES_ -> PRES <$> (EncResponse . unTail <$> _smpP)
END_ -> pure END
DELD_ -> pure DELD
INFO_ -> INFO <$> _smpP
OK_ -> pure OK
ERR_ -> ERR <$> _smpP
src/Simplex/Messaging/Server.hs
+47 -41
View File
@@ -136,9 +136,11 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
expired <- restoreServerMessages
restoreServerStats expired
raceAny_
( serverThread s "server subscribedQ" subscribedQ subscribers pendingENDs subscriptions cancelSub
: serverThread s "server ntfSubscribedQ" ntfSubscribedQ Env.notifiers pendingNtfENDs ntfSubscriptions (\_ -> pure ())
: sendPendingENDsThread s
( serverThread s "server subscribedQ" True subscribedQ subscribers pendingENDs subscriptions cancelSub
: serverThread s "server deletedQ" False deletedQ subscribers pendingDELDs subscriptions cancelSub
: serverThread s "server ntfSubscribedQ" True ntfSubscribedQ Env.notifiers pendingNtfENDs ntfSubscriptions (\_ -> pure ())
: serverThread s "server ntfDeletedQ" False ntfDeletedQ Env.notifiers pendingNtfDELDs ntfSubscriptions (\_ -> pure ())
: sendPendingEvtsThread s
: receiveFromProxyAgent pa
: map runServer transports <> expireMessagesThread_ cfg <> serverStatsThread_ cfg <> controlPortThread_ cfg
)
@@ -163,13 +165,14 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
forall s.
Server ->
String ->
(Server -> TQueue (QueueId, ClientId, Subscribed)) ->
Subscribed ->
(Server -> TQueue (QueueId, ClientId)) ->
(Server -> TMap QueueId (TVar Client)) ->
(Server -> TVar (IM.IntMap (NonEmpty RecipientId))) ->
(Client -> TMap QueueId s) ->
(s -> IO ()) ->
M ()
serverThread s label subQ subs ends clientSubs unsub = do
serverThread s label subscribed subQ subs pendingEvts clientSubs unsub = do
labelMyThread label
cls <- asks clients
liftIO . forever $
@@ -177,8 +180,8 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
$>>= endPreviousSubscriptions
>>= mapM_ unsub
where
updateSubscribers :: TVar (IM.IntMap (Maybe Client)) -> (QueueId, ClientId, Bool) -> STM (Maybe (QueueId, Client))
updateSubscribers cls (qId, clntId, subscribed) =
updateSubscribers :: TVar (IM.IntMap (Maybe Client)) -> (QueueId, ClientId) -> STM (Maybe (QueueId, Client))
updateSubscribers cls (qId, clntId) =
-- Client lookup by ID is in the same STM transaction.
-- In case client disconnects during the transaction,
-- it will be re-evaluated, and the client won't be stored as subscribed.
@@ -201,37 +204,41 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg} = do
| otherwise = (\yes -> if yes then Just (qId, c') else Nothing) <$> readTVar (connected c')
endPreviousSubscriptions :: (QueueId, Client) -> IO (Maybe s)
endPreviousSubscriptions (qId, c) = do
atomically $ modifyTVar' (ends s) $ IM.alter (Just . maybe [qId] (qId <|)) (clientId c)
atomically $ modifyTVar' (pendingEvts s) $ IM.alter (Just . maybe [qId] (qId <|)) (clientId c)
atomically $ TM.lookupDelete qId (clientSubs c)
sendPendingENDsThread :: Server -> M ()
sendPendingENDsThread s = do
sendPendingEvtsThread :: Server -> M ()
sendPendingEvtsThread s = do
endInt <- asks $ pendingENDInterval . config
cls <- asks clients
forever $ do
threadDelay endInt
sendPending cls $ pendingENDs s
sendPending cls $ pendingNtfENDs s
sendPending cls END $ pendingENDs s
sendPending cls DELD $ pendingDELDs s
sendPending cls END $ pendingNtfENDs s
sendPending cls DELD $ pendingNtfDELDs s
where
sendPending cls ref = do
sendPending cls evt ref = do
ends <- atomically $ swapTVar ref IM.empty
unless (null ends) $ forM_ (IM.assocs ends) $ \(cId, qIds) ->
mapM_ (queueENDs qIds) . join . IM.lookup cId =<< readTVarIO cls
queueENDs qIds c@Client {connected, sndQ = q} =
mapM_ (queueEvts qIds evt) . join . IM.lookup cId =<< readTVarIO cls
queueEvts qIds evt c@Client {connected, sndQ = q} =
whenM (readTVarIO connected) $ do
sent <- atomically $ ifM (isFullTBQueue q) (pure False) (writeTBQueue q ts $> True)
if sent
then updateEndStats
else -- if queue is full it can block
forkClient c ("sendPendingENDsThread.queueENDs") $
forkClient c ("sendPendingEvtsThread.queueEvts") $
atomically (writeTBQueue q ts) >> updateEndStats
where
ts = L.map (CorrId "",,END) qIds
updateEndStats = do
stats <- asks serverStats
let len = L.length qIds
liftIO $ atomicModifyIORef'_ (qSubEnd stats) (+ len)
liftIO $ atomicModifyIORef'_ (qSubEndB stats) (+ (len `div` 255 + 1)) -- up to 255 ENDs in the batch
ts = L.map (CorrId "",,evt) qIds
updateEndStats = case evt of
END -> do
stats <- asks serverStats
let len = L.length qIds
liftIO $ atomicModifyIORef'_ (qSubEnd stats) (+ len)
liftIO $ atomicModifyIORef'_ (qSubEndB stats) (+ (len `div` 255 + 1)) -- up to 255 ENDs in the batch
_ -> pure ()
receiveFromProxyAgent :: ProxyAgent -> M ()
receiveFromProxyAgent ProxyAgent {smpAgent = SMPClientAgent {agentQ}} =
@@ -892,7 +899,7 @@ forkClient Client {endThreads, endThreadSeq} label action = do
mkWeakThreadId t >>= atomically . modifyTVar' endThreads . IM.insert tId
client :: THandleParams SMPVersion 'TServer -> Client -> Server -> M ()
client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, sndQ, sessionId, procThreads} Server {subscribedQ, ntfSubscribedQ, subscribers, notifiers} = do
client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, sndQ, sessionId, procThreads} Server {subscribedQ, deletedQ, ntfSubscribedQ, ntfDeletedQ, subscribers, notifiers} = do
labelMyThread . B.unpack $ "client $" <> encode sessionId <> " commands"
forever $
atomically (readTBQueue rcvQ)
@@ -985,11 +992,9 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
processCommand (qr_, (corrId, entId, cmd)) = case cmd of
Cmd SProxiedClient command -> processProxiedCmd (corrId, entId, command)
Cmd SSender command -> Just <$> case command of
SKEY sKey -> (corrId,entId,) <$> case qr_ of
Just qr@QueueRec {sndSecure}
| sndSecure -> secureQueue_ "SKEY" qr sKey
| otherwise -> pure $ ERR AUTH
Nothing -> pure $ ERR INTERNAL
SKEY sKey ->
withQueue $ \QueueRec {sndSecure, recipientId} ->
(corrId,entId,) <$> if sndSecure then secureQueue_ "SKEY" recipientId sKey else pure $ ERR AUTH
SEND flags msgBody -> withQueue $ \qr -> sendMessage qr flags msgBody
PING -> pure (corrId, NoEntity, PONG)
RFWD encBlock -> (corrId, NoEntity,) <$> processForwardedCommand encBlock
@@ -1009,9 +1014,9 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
SUB -> withQueue (`subscribeQueue` entId)
GET -> withQueue getMessage
ACK msgId -> withQueue (`acknowledgeMsg` msgId)
KEY sKey -> (corrId,entId,) <$> case qr_ of
Just qr -> secureQueue_ "KEY" qr sKey
Nothing -> pure $ ERR INTERNAL
KEY sKey ->
withQueue $ \QueueRec {recipientId} ->
(corrId,entId,) <$> secureQueue_ "KEY" recipientId sKey
NKEY nKey dhKey -> addQueueNotifier_ st nKey dhKey
NDEL -> deleteQueueNotifier_ st
OFF -> suspendQueue_ st
@@ -1063,10 +1068,9 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
n <- asks $ queueIdBytes . config
liftM2 (,) (randomId n) (randomId n)
secureQueue_ :: T.Text -> QueueRec -> SndPublicAuthKey -> M BrokerMsg
secureQueue_ name qr@QueueRec {recipientId = rId} sKey = time name $ do
secureQueue_ :: T.Text -> RecipientId -> SndPublicAuthKey -> M BrokerMsg
secureQueue_ name rId sKey = time name $ do
withLog $ \s -> logSecureQueue s rId sKey
updateQueueDate qr
st <- asks queueStore
stats <- asks serverStats
incStat $ qSecured stats
@@ -1086,20 +1090,22 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
liftIO (addQueueNotifier st entId ntfCreds) >>= \case
Left DUPLICATE_ -> addNotifierRetry (n - 1) rcvPublicDhKey rcvNtfDhSecret
Left e -> pure $ ERR e
Right _ -> do
Right nId_ -> do
withLog $ \s -> logAddNotifier s entId ntfCreds
incStat . ntfCreated =<< asks serverStats
forM_ nId_ $ \nId -> atomically $ writeTQueue ntfDeletedQ (nId, clientId)
pure $ NID notifierId rcvPublicDhKey
deleteQueueNotifier_ :: QueueStore -> M (Transmission BrokerMsg)
deleteQueueNotifier_ st = do
withLog (`logDeleteNotifier` entId)
liftIO (deleteQueueNotifier st entId) >>= \case
Right () -> do
Right (Just nId) -> do
-- Possibly, the same should be done if the queue is suspended, but currently we do not use it
atomically $ writeTQueue ntfSubscribedQ (entId, clientId, False)
atomically $ writeTQueue ntfDeletedQ (nId, clientId)
incStat . ntfDeleted =<< asks serverStats
pure ok
Right Nothing -> pure ok
Left e -> pure $ err e
suspendQueue_ :: QueueStore -> M (Transmission BrokerMsg)
@@ -1124,7 +1130,7 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
where
newSub :: M Sub
newSub = time "SUB newSub" . atomically $ do
writeTQueue subscribedQ (rId, clientId, True)
writeTQueue subscribedQ (rId, clientId)
sub <- newSubscription NoSub
TM.insert rId sub subscriptions
pure sub
@@ -1199,7 +1205,7 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
pure ok
where
newSub = do
writeTQueue ntfSubscribedQ (entId, clientId, True)
writeTQueue ntfSubscribedQ (entId, clientId)
TM.insert entId () ntfSubscriptions
acknowledgeMsg :: QueueRec -> MsgId -> M (Transmission BrokerMsg)
@@ -1480,9 +1486,9 @@ client thParams' clnt@Client {clientId, subscriptions, ntfSubscriptions, rcvQ, s
liftIO (deleteQueue st entId $>>= \q -> delMsgQueue ms entId $> Right q) >>= \case
Right q -> do
-- Possibly, the same should be done if the queue is suspended, but currently we do not use it
atomically $ writeTQueue subscribedQ (entId, clientId, False)
atomically $ writeTQueue deletedQ (entId, clientId)
forM_ (notifierId <$> notifier q) $ \nId ->
atomically $ writeTQueue ntfSubscribedQ (nId, clientId, False)
atomically $ writeTQueue ntfDeletedQ (nId, clientId)
updateDeletedStats q
pure ok
Left e -> pure $ err e
src/Simplex/Messaging/Server/Env/STM.hs
+11 -3
View File
@@ -136,12 +136,16 @@ data Env = Env
type Subscribed = Bool
data Server = Server
{ subscribedQ :: TQueue (RecipientId, ClientId, Subscribed),
{ subscribedQ :: TQueue (RecipientId, ClientId),
deletedQ :: TQueue (RecipientId, ClientId),
subscribers :: TMap RecipientId (TVar Client),
ntfSubscribedQ :: TQueue (NotifierId, ClientId, Subscribed),
ntfSubscribedQ :: TQueue (NotifierId, ClientId),
ntfDeletedQ :: TQueue (NotifierId, ClientId),
notifiers :: TMap NotifierId (TVar Client),
pendingENDs :: TVar (IntMap (NonEmpty RecipientId)),
pendingDELDs :: TVar (IntMap (NonEmpty RecipientId)),
pendingNtfENDs :: TVar (IntMap (NonEmpty NotifierId)),
pendingNtfDELDs :: TVar (IntMap (NonEmpty NotifierId)),
savingLock :: Lock
}
@@ -181,13 +185,17 @@ data Sub = Sub
newServer :: IO Server
newServer = do
subscribedQ <- newTQueueIO
deletedQ <- newTQueueIO
subscribers <- TM.emptyIO
ntfSubscribedQ <- newTQueueIO
ntfDeletedQ <- newTQueueIO
notifiers <- TM.emptyIO
pendingENDs <- newTVarIO IM.empty
pendingDELDs <- newTVarIO IM.empty
pendingNtfENDs <- newTVarIO IM.empty
pendingNtfDELDs <- newTVarIO IM.empty
savingLock <- atomically createLock
return Server {subscribedQ, subscribers, ntfSubscribedQ, notifiers, pendingENDs, pendingNtfENDs, savingLock}
return Server {subscribedQ, deletedQ, subscribers, ntfSubscribedQ, ntfDeletedQ, notifiers, pendingENDs, pendingDELDs, pendingNtfENDs, pendingNtfDELDs, savingLock}
newClient :: ClientId -> Natural -> VersionSMP -> ByteString -> SystemTime -> IO Client
newClient clientId qSize thVersion sessionId createdAt = do
src/Simplex/Messaging/Server/Main.hs
+6 -5
View File
@@ -318,11 +318,6 @@ smpServerCLI_ generateSite serveStaticFiles cfgPath logPath =
serverClientConcurrency = readIniDefault defaultProxyClientConcurrency "PROXY" "client_concurrency" ini,
information = serverPublicInfo ini
}
textToHostMode :: Text -> HostMode
textToHostMode = \case
"public" -> HMPublic
"onion" -> HMOnionViaSocks
s -> error . T.unpack $ "Invalid host_mode: " <> s
textToOwnServers :: Text -> [ByteString]
textToOwnServers = map encodeUtf8 . T.words
@@ -346,6 +341,12 @@ smpServerCLI_ generateSite serveStaticFiles cfgPath logPath =
where
isOnion = \case THOnionHost _ -> True; _ -> False
textToHostMode :: Text -> HostMode
textToHostMode = \case
"public" -> HMPublic
"onion" -> HMOnionViaSocks
s -> error . T.unpack $ "Invalid host_mode: " <> s
data EmbeddedWebParams = EmbeddedWebParams
{ webStaticPath :: FilePath,
webHttpPort :: Maybe Int,
src/Simplex/Messaging/Server/QueueStore/STM.hs
+11 -8
View File
@@ -74,23 +74,26 @@ secureQueue QueueStore {queues} rId sKey = toResult <$> do
let !q' = q {senderKey = Just sKey}
in writeTVar qVar q' $> Just q'
addQueueNotifier :: QueueStore -> RecipientId -> NtfCreds -> IO (Either ErrorType QueueRec)
addQueueNotifier :: QueueStore -> RecipientId -> NtfCreds -> IO (Either ErrorType (Maybe NotifierId))
addQueueNotifier QueueStore {queues, notifiers} rId ntfCreds@NtfCreds {notifierId = nId} = do
ifM (TM.memberIO nId notifiers) (pure $ Left DUPLICATE_) $
withQueue rId queues $ \qVar -> do
TM.lookupIO rId queues >>= \case
Just qVar -> atomically $ ifM (TM.member nId notifiers) (pure $ Left DUPLICATE_) $ do
q <- readTVar qVar
forM_ (notifier q) $ (`TM.delete` notifiers) . notifierId
nId_ <- forM (notifier q) $ \NtfCreds {notifierId} -> TM.delete notifierId notifiers $> notifierId
let !q' = q {notifier = Just ntfCreds}
writeTVar qVar q'
TM.insert nId rId notifiers
pure q'
pure $ Right nId_
Nothing -> pure $ Left AUTH
deleteQueueNotifier :: QueueStore -> RecipientId -> IO (Either ErrorType ())
deleteQueueNotifier :: QueueStore -> RecipientId -> IO (Either ErrorType (Maybe NotifierId))
deleteQueueNotifier QueueStore {queues, notifiers} rId =
withQueue rId queues $ \qVar -> do
q <- readTVar qVar
forM_ (notifier q) $ \NtfCreds {notifierId} -> TM.delete notifierId notifiers
writeTVar qVar $! q {notifier = Nothing}
forM (notifier q) $ \NtfCreds {notifierId} -> do
TM.delete notifierId notifiers
writeTVar qVar $! q {notifier = Nothing}
pure notifierId
suspendQueue :: QueueStore -> RecipientId -> IO (Either ErrorType ())
suspendQueue QueueStore {queues} rId =
src/Simplex/Messaging/Transport.hs
+9 -2
View File
@@ -47,6 +47,7 @@ module Simplex.Messaging.Transport
authCmdsSMPVersion,
sendingProxySMPVersion,
sndAuthKeySMPVersion,
deletedEventSMPVersion,
simplexMQVersion,
smpBlockSize,
TransportConfig (..),
@@ -130,6 +131,9 @@ smpBlockSize = 16384
-- 5 - basic auth for SMP servers (11/12/2022)
-- 6 - allow creating queues without subscribing (9/10/2023)
-- 7 - support authenticated encryption to verify senders' commands, imply but do NOT send session ID in signed part (4/30/2024)
-- 8 - SMP proxy for sender commands
-- 9 - faster handshake: SKEY command for sender to secure queue
-- 10 - DELD event to subscriber when queue is deleted via another connnection
data SMPVersion
@@ -160,14 +164,17 @@ sendingProxySMPVersion = VersionSMP 8
sndAuthKeySMPVersion :: VersionSMP
sndAuthKeySMPVersion = VersionSMP 9
deletedEventSMPVersion :: VersionSMP
deletedEventSMPVersion = VersionSMP 10
currentClientSMPRelayVersion :: VersionSMP
currentClientSMPRelayVersion = VersionSMP 9
currentClientSMPRelayVersion = VersionSMP 10
legacyServerSMPRelayVersion :: VersionSMP
legacyServerSMPRelayVersion = VersionSMP 6
currentServerSMPRelayVersion :: VersionSMP
currentServerSMPRelayVersion = VersionSMP 9
currentServerSMPRelayVersion = VersionSMP 10
-- Max SMP protocol version to be used in e2e encrypted
-- connection between client and server, as defined by SMP proxy.
tests/AgentTests/NotificationTests.hs
+1 -1
View File
@@ -166,7 +166,7 @@ testNtfMatrix t runTest = do
it "curr servers; curr clients" $ runNtfTestCfg t 1 cfg ntfServerCfg agentCfg agentCfg runTest
it "curr servers; prev clients" $ runNtfTestCfg t 3 cfg ntfServerCfg agentCfgVPrevPQ agentCfgVPrevPQ runTest
it "prev servers; prev clients" $ runNtfTestCfg t 3 cfgVPrev ntfServerCfgVPrev agentCfgVPrevPQ agentCfgVPrevPQ runTest
it "prev servers; curr clients" $ runNtfTestCfg t 3 cfgVPrev ntfServerCfgVPrev agentCfg agentCfg runTest
it "prev servers; curr clients" $ runNtfTestCfg t 1 cfgVPrev ntfServerCfgVPrev agentCfg agentCfg runTest
-- servers can be upgraded in any order
it "servers: curr SMP, prev NTF; prev clients" $ runNtfTestCfg t 3 cfg ntfServerCfgVPrev agentCfgVPrevPQ agentCfgVPrevPQ runTest
it "servers: prev SMP, curr NTF; prev clients" $ runNtfTestCfg t 3 cfgVPrev ntfServerCfg agentCfgVPrevPQ agentCfgVPrevPQ runTest
tests/ServerTests.hs
+8 -1
View File
@@ -385,6 +385,10 @@ testSwitchSub (ATransport t) =
Resp "bcda" _ ok3 <- signSendRecv rh2 rKey ("bcda", rId, ACK mId3)
(ok3, OK) #== "accepts ACK from the 2nd TCP connection"
Resp "cdab" _ OK <- signSendRecv rh1 rKey ("cdab", rId, DEL)
Resp "" rId' DELD <- tGet1 rh2
(rId', rId) #== "connection deleted event delivered to subscribed client"
1000 `timeout` tGet @SMPVersion @ErrorType @BrokerMsg rh1 >>= \case
Nothing -> return ()
Just _ -> error "nothing else is delivered to the 1st TCP connection"
@@ -839,7 +843,8 @@ testMessageNotifications (ATransport t) =
Resp "3a" _ OK <- signSendRecv rh rKey ("3a", rId, ACK mId1)
Resp "" _ (NMSG _ _) <- tGet1 nh1
Resp "4" _ OK <- signSendRecv nh2 nKey ("4", nId, NSUB)
Resp "" _ END <- tGet1 nh1
Resp "" nId2 END <- tGet1 nh1
nId2 `shouldBe` nId
Resp "5" _ OK <- signSendRecv sh sKey ("5", sId, _SEND' "hello again")
Resp "" _ (Msg mId2 msg2) <- tGet1 rh
Resp "5a" _ OK <- signSendRecv rh rKey ("5a", rId, ACK mId2)
@@ -849,6 +854,8 @@ testMessageNotifications (ATransport t) =
Nothing -> pure ()
Just _ -> error "nothing else should be delivered to the 1st notifier's TCP connection"
Resp "6" _ OK <- signSendRecv rh rKey ("6", rId, NDEL)
Resp "" nId3 DELD <- tGet1 nh2
nId3 `shouldBe` nId
Resp "7" _ OK <- signSendRecv sh sKey ("7", sId, _SEND' "hello there")
Resp "" _ (Msg mId3 msg3) <- tGet1 rh
(dec mId3 msg3, Right "hello there") #== "delivered from queue again"
tests/XFTPAgent.hs
+2 -2
View File
@@ -429,7 +429,7 @@ testXFTPAgentSendRestore = withGlobalLogging logCfgNoLogs $ do
("", sfId', SFPROG _ _) <- sfGet sndr'
liftIO $ sfId' `shouldBe` sfId
threadDelay 100000
threadDelay 200000
withXFTPServerStoreLogOn $ \_ -> do
-- send file - should continue uploading with server up
@@ -443,7 +443,7 @@ testXFTPAgentSendRestore = withGlobalLogging logCfgNoLogs $ do
pure rfd1
-- prefix path should be removed after sending file
threadDelay 100000
threadDelay 200000
doesDirectoryExist prefixPath `shouldReturn` False
doesFileExist encPath `shouldReturn` False