diff --git a/src/Simplex/Messaging/Protocol.hs b/src/Simplex/Messaging/Protocol.hs index 197b1fc96..1943eb123 100644 --- a/src/Simplex/Messaging/Protocol.hs +++ b/src/Simplex/Messaging/Protocol.hs @@ -816,6 +816,19 @@ instance J.ToJSON NameRecord where "expiry" J..= nrExpiry, "isTest" J..= nrIsTest ] + -- explicit toEncoding to preserve the spec-documented key order; the default + -- routes through Value/KeyMap and re-emits keys alphabetically, breaking the + -- "two routers MUST emit byte-identical JSON" requirement. + toEncoding NameRecord {nrDisplayName, nrOwner, nrChannelLinks, nrContactLinks, nrAdminAddress, nrAdminEmail, nrExpiry, nrIsTest} = + J.pairs $ + "displayName" J..= nrDisplayName + <> "owner" J..= nrOwner + <> "channelLinks" J..= nrChannelLinks + <> "contactLinks" J..= nrContactLinks + <> "adminAddress" J..= nrAdminAddress + <> "adminEmail" J..= nrAdminEmail + <> "expiry" J..= nrExpiry + <> "isTest" J..= nrIsTest instance J.FromJSON NameRecord where parseJSON = J.withObject "NameRecord" $ \o -> do diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs index 6fa7bf611..acade609a 100644 --- a/src/Simplex/Messaging/Server.hs +++ b/src/Simplex/Messaging/Server.hs @@ -247,8 +247,11 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg, startOpt closeServer :: M s () closeServer = do - asks (smpAgent . proxyAgent) >>= liftIO . closeSMPClientAgent - asks namesEnv >>= liftIO . mapM_ closeNamesEnv + pa <- asks (smpAgent . proxyAgent) + ne <- asks namesEnv + -- finally: if the proxy-agent close throws, we still release the resolver's + -- HTTP connection manager. + liftIO $ closeSMPClientAgent pa `E.finally` mapM_ closeNamesEnv ne serverThread :: forall sub. String -> diff --git a/src/Simplex/Messaging/Server/Main.hs b/src/Simplex/Messaging/Server/Main.hs index 8968cbd34..5272e3f93 100644 --- a/src/Simplex/Messaging/Server/Main.hs +++ b/src/Simplex/Messaging/Server/Main.hs @@ -813,15 +813,22 @@ readNamesConfig ini { ethereumEndpoint = either (error . ("[NAMES] ethereum_endpoint: " <>)) id (validateUrl endpoint rpcAuth_), tldRegistries = registries, rpcAuth = rpcAuth_, - rpcTimeoutMs = readIniDefault 3000 "NAMES" "rpc_timeout_ms" ini, - rpcMaxResponseBytes = readIniDefault 262144 "NAMES" "rpc_max_response_bytes" ini, - rpcMaxConcurrency = readIniDefault 8 "NAMES" "rpc_max_concurrency" ini + rpcTimeoutMs = positiveIniInt 3000 100 "rpc_timeout_ms", + rpcMaxResponseBytes = positiveIniInt 262144 1024 "rpc_max_response_bytes", + rpcMaxConcurrency = positiveIniInt 8 1 "rpc_max_concurrency" } where enabled = fromMaybe False (iniOnOff "NAMES" "enable" ini) requiredText key = either (error . (("[NAMES] " <> T.unpack key <> " is required: ") <>)) id $ lookupValue "NAMES" key ini + -- Reject zero / negative values that would deadlock waitQSem (concurrency = 0), + -- time-out every RSLV immediately (timeout = 0), or accept zero-length + -- responses (max_response_bytes = 0). The lower bounds also catch sub-sane + -- values an operator might choose by accident. + positiveIniInt def floor_ key = case readIniDefault def "NAMES" key ini of + n | n >= floor_ -> n + | otherwise -> error $ "[NAMES] " <> T.unpack key <> " must be at least " <> show floor_ <> " (got " <> show n <> ")" readTldRegistries = let regs = TldRegistries { tldSimplex = optionalAddr "registry_tld_simplex", @@ -843,8 +850,12 @@ readNamesConfig ini -- * userinfo (user:pass@) MUST NOT be present (credentials belong in -- rpc_auth so they don't leak via Host header or logs) -- * query and fragment MUST NOT be present --- * https requires rpc_auth on non-loopback hosts (operator misconfig --- guard — a public HTTPS endpoint without auth is almost always wrong) +-- * http is rejected on non-loopback hosts (plaintext to a third party +-- leaks rpc_auth on every request) +-- * https requires rpc_auth on non-loopback hosts (a public endpoint +-- without auth is almost always misconfig) +-- * link-local hosts (169.254.0.0/16, including the cloud metadata IP +-- 169.254.169.254) are rejected unconditionally validateUrl :: Text -> Maybe RpcAuth -> Either String Text validateUrl url auth_ = do uri <- maybe (Left "not an absolute URI") Right $ parseAbsoluteURI (T.unpack url) @@ -852,12 +863,14 @@ validateUrl url auth_ = do unless (scheme == "http:" || scheme == "https:") $ Left ("scheme " <> show scheme <> " not supported (use http or https)") ua <- maybe (Left "missing authority (host)") Right (uriAuthority uri) - when (null (uriRegName ua)) $ Left "empty host" + let host = uriRegName ua + when (null host) $ Left "empty host" + when (isLinkLocal host) $ Left "link-local host not allowed (rejects cloud metadata services)" unless (null (uriUserInfo ua)) $ Left "userinfo (user:pass@) not allowed; use rpc_auth instead" case uriPort ua of "" -> Left "explicit port required (e.g. http://host:8545)" ':' : portStr -> case readMaybe portStr of - Just n | n >= 1 && n <= 65535 -> Right () + Just n | (n :: Int) >= 1 && n <= 65535 -> Right () _ -> Left $ "port " <> portStr <> " out of range (must be 1..65535)" other -> Left $ "unexpected port syntax: " <> other unless (null (uriQuery uri)) $ Left "query string not allowed" @@ -865,11 +878,14 @@ validateUrl url auth_ = do let path = uriPath uri unless (path == "" || path == "/") $ Left "URL path not allowed; API keys embedded in the path leak to logs — use rpc_auth instead" - when (scheme == "https:" && not (isLoopback (uriRegName ua)) && isNothing auth_) $ + when (scheme == "http:" && not (isLoopback host)) $ + Left "http endpoint on a non-loopback host not allowed (plaintext leaks rpc_auth); use https" + when (scheme == "https:" && not (isLoopback host) && isNothing auth_) $ Left "https endpoint on a non-loopback host requires rpc_auth" Right url where isLoopback h = h == "127.0.0.1" || h == "localhost" || h == "[::1]" + isLinkLocal h = "169.254." `isPrefixOf` h || h == "[fe80::1]" -- | Parse a 20-byte Ethereum address as text "0x[hex40]" or "[hex40]". -- EIP-55 mixed-case checksum verification is a follow-up. diff --git a/src/Simplex/Messaging/Server/Names.hs b/src/Simplex/Messaging/Server/Names.hs index da0fd1955..3536808b5 100644 --- a/src/Simplex/Messaging/Server/Names.hs +++ b/src/Simplex/Messaging/Server/Names.hs @@ -201,6 +201,6 @@ mapEthRpcError :: EthRpcError -> ResolveError mapEthRpcError = \case HttpFailure _ -> EthHttpErr HttpStatusErr _ -> EthHttpErr - BodyTooLarge -> EthDecodeErr + BodyTooLarge -> EthHttpErr -- transport-side cap, not a decoder failure InvalidJson _ -> EthDecodeErr JsonRpcErr c m -> EthRpcErr {rpcCode = c, rpcMessage = m} diff --git a/src/Simplex/Messaging/SimplexName.hs b/src/Simplex/Messaging/SimplexName.hs index cfb700470..1a007f18a 100644 --- a/src/Simplex/Messaging/SimplexName.hs +++ b/src/Simplex/Messaging/SimplexName.hs @@ -75,12 +75,16 @@ instance StrEncoding SimplexNameDomain where strP = parseDomain . safeDecodeUtf8 <$?> A.takeWhile1 (not . A.isSpace) where parseDomain s = AT.parseOnly (nameLabelP `AT.sepBy1` AT.char '.' <* AT.endOfInput) s >>= mkDomain + -- TLD label compared lowercase: DNS labels are case-insensitive, and a + -- mixed-case `foo.SIMPLEX` would otherwise fall through to TLDWeb and + -- route through `registry_tld_all` instead of `registry_tld_simplex`. mkDomain labels = case reverse labels of [] -> Left "empty name" [_] -> Left "domain requires TLD" - "simplex" : name : sub -> Right $ SimplexNameDomain TLDSimplex name sub - "testing" : name : sub -> Right $ SimplexNameDomain TLDTesting name sub - _ -> Right $ SimplexNameDomain TLDWeb (T.intercalate "." labels) [] + tld : name : sub -> Right $ case T.toLower tld of + "simplex" -> SimplexNameDomain TLDSimplex name sub + "testing" -> SimplexNameDomain TLDTesting name sub + _ -> SimplexNameDomain TLDWeb (T.intercalate "." labels) [] fullDomainName :: SimplexNameDomain -> Text fullDomainName SimplexNameDomain {nameTLD, domain, subDomain} = T.intercalate "." (reverse subDomain ++ [domain] ++ tld') diff --git a/tests/SMPNamesTests.hs b/tests/SMPNamesTests.hs index a78196186..fea6e61a2 100644 --- a/tests/SMPNamesTests.hs +++ b/tests/SMPNamesTests.hs @@ -10,6 +10,7 @@ import qualified Data.ByteString.Char8 as B import qualified Data.ByteArray as BA import Data.Either (isLeft, isRight) import Data.IORef (atomicModifyIORef', newIORef, readIORef) +import Data.List (sort) import qualified Data.Text as T import qualified Data.Aeson as J import qualified Data.ByteString.Lazy as LB @@ -97,6 +98,14 @@ nameRecordEncodingSpec = do it "round-trips JSON encode / decode" $ J.eitherDecodeStrict (LB.toStrict (J.encode sampleRecord)) `shouldBe` Right sampleRecord + it "emits keys in spec-documented order (displayName, owner, channelLinks, contactLinks, adminAddress, adminEmail, expiry, isTest)" $ do + -- Default toEncoding routes through Value/KeyMap and re-emits keys + -- alphabetically; spec requires byte-identical canonical encoding. + let bytes = LB.toStrict (J.encode sampleRecord) + offset k = B.length (fst (B.breakSubstring k bytes)) + offsets = map offset ["displayName", "owner", "channelLinks", "contactLinks", "adminAddress", "adminEmail", "expiry", "isTest"] + offsets `shouldBe` sort offsets + it "rejects negative expiry" $ do let badBytes = LB.toStrict (J.encode sampleRecord {nrExpiry = -1}) (J.eitherDecodeStrict badBytes :: Either String NameRecord) `shouldSatisfy` isLeft