~singpolyma/cheogram

c2f88151d793595d77e2596db78ff39def888d96 — Stephen Paul Weber 1 year, 10 months ago f4401d2
Seperate out mapping for SIP URIs so SMS targets don't get caught
2 files changed, 31 insertions(+), 24 deletions(-)

M Main.hs
M Util.hs
M Main.hs => Main.hs +18 -14
@@ 1103,10 1103,10 @@ component db backendHost toRoomPresences toRejoinManager toJoinPartDebouncer toC
								tcPut db cheoJid "owners" (show $ (T.unpack $ bareTxt owner) : owners)

							_ -> log "NO TOKEN FOUND, or mismatch" maybeToken
			(Just from, Just to, Nothing, _, _) |
				Just multipleTo <- mapM localpartToURI (T.split (==',') $ fromMaybe mempty $ fmap strNode $ jidNode to),
				ReceivedMessage m <- stanza,
				Just backendJid <- parseJID backendHost -> liftIO $
			(Just from, Just to, Nothing, Just localpart, _)
				| Just multipleTo <- mapM localpartToURI (T.split (==',') localpart),
				  ReceivedMessage m <- stanza,
				  Just backendJid <- parseJID backendHost -> liftIO $
					let m' = m { messagePayloads = messagePayloads m ++ [
						Element (s"{http://jabber.org/protocol/address}addresses") [] $ map (\oneto ->
							NodeElement $ Element (s"{http://jabber.org/protocol/address}address") [


@@ 1118,6 1118,16 @@ component db backendHost toRoomPresences toRejoinManager toJoinPartDebouncer toC
					-- TODO: should check if backend supports XEP-0033
					-- TODO: fallback for no-backend case should work
					mapM_ sendToComponent =<< componentMessage db componentJid m' Nothing (bareTxt from) (strResource <$> jidResource from) backendJid (getBody "jabber:component:accept" m')
				| (s"sip.cheogram.com") == strDomain (jidDomain from) -> liftIO $
					case (mapLocalpartToBackend (formatJID componentJid) =<< sanitizeSipLocalpart (maybe mempty strNode $ jidNode from), parseJID (unescapeJid localpart ++ (maybe mempty (s"/"++) (strResource <$> jidResource to)))) of
						(Just componentFrom, Just routeTo) -> liftIO $ do
							Just componentFromSip <- return $ parseJID (formatJID componentFrom ++ s"/sip:" ++ escapeJid (formatJID from))
							sendToComponent $ mkStanzaRec $ receivedStanza $ receivedStanzaFromTo componentFromSip routeTo stanza
						_ ->
							sendToComponent $ stanzaError stanza $
								Element (fromString "{jabber:component:accept}error")
								[(fromString "{jabber:component:accept}type", [ContentText $ fromString "cancel"])]
								[NodeElement $ Element (fromString "{urn:ietf:params:xml:ns:xmpp-stanzas}item-not-found") [] []]
			(Just from, Just to, Nothing, Just localpart, _)
				| Nothing <- mapM localpartToURI (T.split (==',') $ fromMaybe mempty $ fmap strNode $ jidNode to),
				  fmap (((s"CHEOGRAM%") `T.isPrefixOf`) . strResource) (jidResource to) /= Just True -> liftIO $ do


@@ 1126,10 1136,6 @@ component db backendHost toRoomPresences toRejoinManager toJoinPartDebouncer toC
					case (fmap fromString maybeRoute, parseJID (unescapeJid localpart ++ toResourceSuffix), mapToComponent from) of
						(Just route, Just routeTo, Just componentFrom) | route == strDomain (jidDomain from) -> do
								sendToComponent $ mkStanzaRec $ receivedStanza $ receivedStanzaFromTo componentFrom routeTo stanza
						(Just route, Just routeTo, Just componentFrom)
							| (s"sip.cheogram.com") == strDomain (jidDomain from),
							  Just componentFromSip <- parseJID (formatJID componentFrom ++ s"/sip:" ++ escapeJid (formatJID from)) -> do
								sendToComponent $ mkStanzaRec $ receivedStanza $ receivedStanzaFromTo componentFromSip routeTo stanza
						_ | Just jid <- (`telToJid` formatJID componentJid) =<< strNode <$> jidNode to -> do
							sendToComponent $ stanzaError stanza $
								Element (fromString "{jabber:component:accept}error")


@@ 1141,7 1147,7 @@ component db backendHost toRoomPresences toRejoinManager toJoinPartDebouncer toC
										[(fromString "xml:lang", [ContentText $ fromString "en"])]
										[NodeContent $ ContentText $ fromString "JID must include country code: " <> formatJID jid]
								]
						  | otherwise -> do
						  | otherwise ->
							sendToComponent $ stanzaError stanza $
								Element (fromString "{jabber:component:accept}error")
								[(fromString "{jabber:component:accept}type", [ContentText $ fromString "cancel"])]


@@ 1244,14 1250,12 @@ mapToBackend backendHost (JID { jidNode = Just node }) = mapLocalpartToBackend b
mapToBackend backendHost (JID { jidNode = Nothing }) = parseJID backendHost

mapLocalpartToBackend backendHost localpart
	| Just ('+', tel) <- T.uncons localpart',
	| Just ('+', tel) <- T.uncons localpart,
	  T.all isDigit tel = result
	| Just _ <- parsePhoneContext localpart' = result
	| Just _ <- parsePhoneContext localpart = result
	| otherwise = Nothing
	where
	-- Unescape local and strip any @suffix in case this is a tel-like SIP uri
	localpart' = sanitizeTelCandidate $ fst $ T.breakOn (s"@") $ unescapeJid localpart
	result = parseJID (localpart' ++ s"@" ++ backendHost)
	result = parseJID (localpart ++ s"@" ++ backendHost)

localpartToURI localpart
	| Just ('+', tel) <- T.uncons localpart,

M Util.hs => Util.hs +13 -10
@@ 67,22 67,25 @@ unescapeJid txt = fromString result
			("20", ' '), ("22", '"'), ("26", '&'), ("27", '\''), ("2f", '/'), ("3a", ':'), ("3c", '<'), ("3e", '>'), ("40", '@'), ("5c", '\\')
		]

-- To handle blocked callers, etc
sanitizeTelCandidate :: Text -> Text
sanitizeTelCandidate candidate
sanitizeSipLocalpart :: Text -> Maybe Text
sanitizeSipLocalpart localpart
	| Just ('+', tel) <- T.uncons candidate,
	  T.all isDigit tel = Just candidate
	| T.length candidate < 3 =
		s"13;phone-context=anonymous.phone-context.soprani.ca"
		Just $ s"13;phone-context=anonymous.phone-context.soprani.ca"
	| candidate == s"Restricted" =
		s"14;phone-context=anonymous.phone-context.soprani.ca"
		Just $ s"14;phone-context=anonymous.phone-context.soprani.ca"
	| candidate == s"anonymous" =
		s"15;phone-context=anonymous.phone-context.soprani.ca"
		Just $ s"15;phone-context=anonymous.phone-context.soprani.ca"
	| candidate == s"Anonymous" =
		s"16;phone-context=anonymous.phone-context.soprani.ca"
		Just $ s"16;phone-context=anonymous.phone-context.soprani.ca"
	| candidate == s"unavailable" =
		s"17;phone-context=anonymous.phone-context.soprani.ca"
		Just $ s"17;phone-context=anonymous.phone-context.soprani.ca"
	| candidate == s"Unavailable" =
		s"18;phone-context=anonymous.phone-context.soprani.ca"
	| otherwise = candidate
		Just $ s"18;phone-context=anonymous.phone-context.soprani.ca"
	| otherwise = Nothing
	where
	candidate = fst $ T.breakOn (s"@") $ unescapeJid localpart

parsePhoneContext :: Text -> Maybe (Text, Text)
parsePhoneContext txt = hush $ Atto.parseOnly (