diff --git a/src/Handler/MailCenter.hs b/src/Handler/MailCenter.hs index b9182fd7c..2fe335e32 100644 --- a/src/Handler/MailCenter.hs +++ b/src/Handler/MailCenter.hs @@ -24,32 +24,22 @@ import qualified Database.Esqueleto.Experimental as E import qualified Database.Esqueleto.Utils as E import Database.Esqueleto.Utils.TH --- import Utils.Print - -import Handler.Utils --- import Handler.Utils.Csv --- import qualified Data.Csv as Csv --- import qualified Data.CaseInsensitive as CI - --- import Jobs.Queue import qualified Data.Aeson as Aeson import Text.Blaze.Html (preEscapedToHtml) -- import Text.Blaze.Html5 as H (html, body, pre, p, h1) -- import Text.Blaze.Html.Renderer.String (renderHtml) +import Numeric (readHex) import qualified Data.Text as T --- import qualified Data.Text.Lazy as LT --- import qualified Data.Text.Lazy.Encoding as LT +import qualified Data.Text.Encoding as TE +import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as LB --- import Data.Char as C --- import qualified Data.Text.Encoding as TE --- import qualified Data.ByteString.Char8 as BS +import Handler.Utils + --- import Data.Bits --- import Data.Word -- avoids repetition of local definitions single :: (k,a) -> Map k a @@ -106,7 +96,7 @@ mkMCTable = do , sortable Nothing (i18nCell MsgCommSubject) $ \(view resultMail -> Entity k v) -> let subject = v ^? _sentMailHeaders . _mailHeaders' . _mailHeader' "Subject" linkWgt = maybe (msg2widget MsgUtilEMail) text2widget subject - in anchorCellM (MailHtmlR <$> encrypt k) linkWgt + in anchorCellM (MailPlainR <$> encrypt k) linkWgt -- , sortable Nothing (i18nCell MsgCommContent) $ \(view $ resultMail . _entityKey -> k) -> anchorCellM (MailHtmlR <$> encrypt k) (text2widget "html") -- , sortable Nothing (i18nCell MsgCommSubject) $ \(preview $ resultMail . _entityVal . _sentMailHeaders . _mailHeaders' . _mailHeader' "Subject" -> h) -> cellMaybe textCell h ] @@ -202,19 +192,24 @@ handleMailShow hdr prefTypes cusm = do ^{userIdWidget usr} $maybe r <- getHeader "To"
- _{MsgPrintRecipient} + To
- #{decodeMime r} + #{decodeEncodedWord r} + $maybe r <- getHeader "Cc" +
+ Cc +
+ #{decodeEncodedWord r} $maybe r <- getHeader "From"
- _{MsgPrintSender} + From
- #{decodeMime r} + #{decodeEncodedWord r} $maybe r <- getHeader "Subject"
_{MsgCommSubject}
- #{decodeMime r} + #{decodeEncodedWord r}
$forall mc <- mcontent @@ -222,6 +217,7 @@ handleMailShow hdr prefTypes cusm = do

^{part2widget pt} |] + -- Include for Debugging: -- ^{jsonWidget (sm ^. _sentMailHeaders)} -- ^{jsonWidget (sentMailContentContent cn)} @@ -265,10 +261,47 @@ part2widget Part{partContent=PartContent (LB.toStrict -> pc), partType=pt, partD | otherwise = [whamlet|part2widget cannot decode parts of type #{pt} yet.|] +------------------------------ +-- Decode MIME Encoded Word + -- | decode the MIME encoded-word format, which is used in email headers to encode non-ASCII text. This format is specified in RFC 2047. -decodeMime :: Text -> Text -decodeMime t - | Just r <- T.stripPrefix "=?utf-8?Q?" t - = T.replace "_" " " $ T.replace "?=" "" r -- TODO: this only works in plain cases without special characters; e.g. umlauts are not handled correctly - | otherwise - = t +decodeEncodedWord :: Text -> Text +decodeEncodedWord tinp + | (pl, T.drop 2 -> cf) <- T.breakOn "=?" tinp + , (cw, T.drop 2 -> rm) <- T.breakOn "?=" cf + , notNull cw + = pl <> decodeEncodedWordHeader cw <> decodeEncodedWord rm + | otherwise + = tinp + +decodeEncodedWordHeader :: Text -> Text +decodeEncodedWordHeader tinp + | [enc, bin, cw] <- T.splitOn "?" tinp + , "utf-8" == T.toLower enc + , "Q" == T.toUpper bin -- Quoted Printable Text + = decEncWrdUtf8Q cw + -- TODO: add more decoders for other possible encodings here, but "=?utf-8?Q?..?=" is the only one used by Network.Mail.Mime at the moment + | otherwise + = tinp + +decEncWrdUtf8Q :: Text -> Text +decEncWrdUtf8Q tinp + | Right ok <- TE.decodeUtf8' $ decWds tinp + = ok + | otherwise + = tinp + where + decWds :: Text -> S.ByteString + decWds t + | (h:tl) <- T.splitOn "=" t + = mconcat $ TE.encodeUtf8 h : map deco tl + | otherwise + = TE.encodeUtf8 t + + deco :: Text -> S.ByteString + deco w + | (c,r) <- T.splitAt 2 w + , [(v,"")] <- readHex $ T.unpack c + = S.cons v $ TE.encodeUtf8 r + | otherwise + = TE.encodeUtf8 w diff --git a/test/Database/Fill.hs b/test/Database/Fill.hs index ebd39a99b..8cf77fdef 100644 --- a/test/Database/Fill.hs +++ b/test/Database/Fill.hs @@ -127,7 +127,7 @@ fillDb = do , userTokensIssuedAfter = Nothing , userMatrikelnummer = Nothing , userEmail = "AVSNO:123456" - , userDisplayEmail = "" + , userDisplayEmail = "felix.hamann@campus.lmu.de" , userDisplayName = "Felix Hamann" , userSurname = "Hamann" , userFirstName = "Felix"