~singpolyma/cheogram-smtp

44a126d31eaa83e019591b922217a0a0b97ce53a — Stephen Paul Weber 2 years ago 3f0a9da
Switch to using = for escaping

% means something historically, and while we can set ourselves up to use
it safely it might make someone grumpy
2 files changed, 11 insertions(+), 16 deletions(-)

M Email.hs
M test/EmailTest.hs
M Email.hs => Email.hs +6 -4
@@ 53,7 53,9 @@ plainTextBody = MIME.entities . filtered isTextPlain . getEmailBody

mailboxNode :: MIME.Mailbox -> Text
mailboxNode (MIME.Mailbox _ (MIME.AddrSpec local _)) =
	fromString $ URI.unEscapeString $ textToString $ decodeUtf8 local
	fromString $ URI.unEscapeString $
	map (\c -> if c == '=' then '%' else c) $
	textToString $ decodeUtf8 local

mailboxToJID :: Text -> MIME.Mailbox -> Maybe XMPP.JID
mailboxToJID domain (MIME.Mailbox _ addrspec) =


@@ 62,14 64,14 @@ mailboxToJID domain (MIME.Mailbox _ addrspec) =
	addr = decodeUtf8 $ LByteString.toStrict $ Builder.toLazyByteString $
		renderAddressSpec addrspec

-- Always escapes % for now
-- Always escapes . for now
-- always escapes . for now
unescapedInEmailLocalpart :: Char -> Bool
unescapedInEmailLocalpart c = isAscii c &&
	(isAlphaNum c || c `elem` "!#$&'*+-/=?^_`{|}~")
	(isAlphaNum c || c `elem` "#$&'*+-/?^_`{|}~")

jidToLocalpart :: XMPP.JID -> ByteString
jidToLocalpart jid = encodeUtf8 $ fromString $
	map (\c -> if c == '%' then '=' else c) $
	URI.escapeURIString unescapedInEmailLocalpart bareStr
	where
	bareStr = textToString $ bareTxt jid

M test/EmailTest.hs => test/EmailTest.hs +5 -12
@@ 4,8 4,7 @@ import Prelude ()
import BasicPrelude
import Test.Tasty.HUnit
import Test.QuickCheck.Instances ()
import qualified Data.MIME as MIME                                
import qualified Network.URI as URI
import qualified Data.MIME as MIME
import qualified Data.XML.Types as XML
import qualified Network.Protocol.XMPP as XMPP



@@ 17,12 16,6 @@ mailboxFromLocal :: Text -> MIME.Mailbox
mailboxFromLocal local = MIME.Mailbox Nothing $
	MIME.AddrSpec (encodeUtf8 local) (MIME.DomainLiteral mempty)

prop_mailboxNode :: Text -> Bool
prop_mailboxNode local =
	mailboxNode (mailboxFromLocal local) == unEscapedLocal
	where
	unEscapedLocal = fromString $ URI.unEscapeString $ textToString local

prop_jidToMailboxRoundtrip :: XMPP.JID -> MIME.Domain -> Bool
prop_jidToMailboxRoundtrip jid domain =
	mailboxNode mailbox == bareTxt jid


@@ 31,7 24,7 @@ prop_jidToMailboxRoundtrip jid domain =

unit_mailboxNodeUnescapes :: IO ()
unit_mailboxNodeUnescapes =
	mailboxNode (mailboxFromLocal $ s"boop%40example.com")
	mailboxNode (mailboxFromLocal $ s"boop=40example.com")
	@?=
	s"boop@example.com"



@@ 105,7 98,7 @@ unit_messageToEmailChat =
	email = s"MIME-Version: 1.0\r\n\
	\Chat-Version: 1.0\r\n\
	\To: t@example.com\r\n\
	\From: f%40example%2Ecom@gateway.example.com\r\n\
	\From: f=40example=2Ecom@gateway.example.com\r\n\
	\Subject: =?utf-8?B?Q2hhdDog5LiW55WMCi4K?=\r\n\
	\date: Mon, 01 Jan 1990 00:00:00 +0000\r\n\
	\Content-Transfer-Encoding: base64\r\n\


@@ 140,7 133,7 @@ unit_messageToEmailWithSubject =
	Just date = parseXMPPTime (s"1990-01-01T00:00:00Z")
	email = s"MIME-Version: 1.0\r\n\
	\To: t@example.com\r\n\
	\From: f%40example%2Ecom@gateway.example.com\r\n\
	\From: f=40example=2Ecom@gateway.example.com\r\n\
	\Subject: =?utf-8?B?5LiW55WM?=\r\n\
	\date: Mon, 01 Jan 1990 00:00:00 +0000\r\n\
	\Content-Transfer-Encoding: base64\r\n\


@@ 180,7 173,7 @@ unit_messageToEmailWithDelay =
	Just date = parseXMPPTime (s"1990-01-01T00:00:00Z")
	email = s"MIME-Version: 1.0\r\n\
	\To: t@example.com\r\n\
	\From: f%40example%2Ecom@gateway.example.com\r\n\
	\From: f=40example=2Ecom@gateway.example.com\r\n\
	\date: Sun, 22 Feb 2009 00:10:00 +0000\r\n\
	\Content-Transfer-Encoding: base64\r\n\
	\Content-Disposition: inline\r\n\