|
@@ -10,7 +10,7 @@ import SMTP.Address
|
|
|
import SMTP.Account
|
|
|
import qualified SMTP.Mime as Mime
|
|
|
import SMTP.Response
|
|
|
-import Encoding
|
|
|
+import Data.Text.IsText
|
|
|
|
|
|
import Data.Time.ISO8601
|
|
|
import Data.IP
|
|
@@ -28,19 +28,20 @@ import Data.Attoparsec.ByteString.Char8.Extras
|
|
|
import qualified Data.ByteString as BS
|
|
|
import qualified Data.List as List
|
|
|
|
|
|
+data BackendAction = DATA deriving (Show, Read, Eq, Ord, Bounded, Enum)
|
|
|
data ClientIdentity = ClientIdentity {_clientIp :: IP, _clientPort :: Int} deriving (Show, Read, Ord, Eq)
|
|
|
|
|
|
data Metadata = Metadata {_clientId :: Maybe ClientIdentity, _clientName :: Maybe ByteString,
|
|
|
_mailFrom :: Maybe Account, _rcptTo :: [Address], _rcptFailed :: [(Address, Response)],
|
|
|
_auth :: Maybe ByteString, _recvDate :: Maybe UTCTime, _bodyEnc :: Mime.BodyEncoding,
|
|
|
- _smtpUtf8 :: Bool, _unrecognized :: [ByteString]
|
|
|
+ _smtpUtf8 :: Bool, _action :: Maybe BackendAction, _unrecognized :: [ByteString]
|
|
|
} deriving (Show, Ord, Eq)
|
|
|
|
|
|
makeLenses ''ClientIdentity
|
|
|
makeLenses ''Metadata
|
|
|
|
|
|
instance Default Metadata where
|
|
|
- def = Metadata Nothing Nothing Nothing [] [] Nothing Nothing Mime.B7BitEncoding False []
|
|
|
+ def = Metadata Nothing Nothing Nothing [] [] Nothing Nothing Mime.B7BitEncoding False Nothing []
|
|
|
|
|
|
metadataForClient :: IP -> Int -> Metadata
|
|
|
metadataForClient c p = def & clientId .~ (Just (ClientIdentity c p))
|
|
@@ -48,10 +49,11 @@ resetMetadata :: Metadata -> Metadata
|
|
|
resetMetadata d = def & clientId .~ d^.clientId & clientName .~ d^.clientName
|
|
|
|
|
|
renderMetadata :: Metadata -> Maybe ByteString
|
|
|
-renderMetadata m = BS.concat <$> serialize
|
|
|
+renderMetadata m = BS.concat . map fromText <$> serialize
|
|
|
where
|
|
|
serialize :: Maybe [ByteString]
|
|
|
serialize = do
|
|
|
+ act <- m^.action
|
|
|
cid <- m^.clientId
|
|
|
cnm <- m^.clientName
|
|
|
rfm <- m^.mailFrom
|
|
@@ -64,18 +66,20 @@ renderMetadata m = BS.concat <$> serialize
|
|
|
usrStr = case usr of
|
|
|
Nothing -> []
|
|
|
Just u -> ["Auth-User: ", u, "\r\n"]
|
|
|
- let toStr = List.concat $ map (\x -> ["To: ", renderMetadataAddress x, "\r\n"]) rto
|
|
|
+ let toStr = List.concat $ map (\x -> ["To: ", renderMetadataAddress $ x, "\r\n"]) rto
|
|
|
failStr = List.concat $ map (\(a, r) -> ["Failed: ", renderMetadataAddress a, "; ", renderResponse r, "\r\n"]) rfail
|
|
|
let unrec = m^.unrecognized
|
|
|
- return $ [
|
|
|
- "Client-Ip: ", utf8bs . show $ cid^.clientIp, "\r\n",
|
|
|
- "Client-Port: ", utf8bs . show $ cid^.clientPort, "\r\n",
|
|
|
- "Client-Name: ", cnm, "\r\n",
|
|
|
- "Return-Path: ", normalAccountName $ rfm, "\r\n",
|
|
|
- "Recv-Date: ", utf8bs . formatISO8601 $ rcv, "\r\n",
|
|
|
- "Body-Encoding: ", utf8bs . show $ enc, "\r\n",
|
|
|
- "SMTP-UTF8: ", if utf then "Yes" else "No", "\r\n"
|
|
|
- ] ++ toStr ++ failStr ++ usrStr ++ unrec
|
|
|
+ let h = [
|
|
|
+ "Action: ", show act, "\r\n",
|
|
|
+ "Client-Ip: ", show $ cid^.clientIp, "\r\n",
|
|
|
+ "Client-Port: ", show $ cid^.clientPort, "\r\n",
|
|
|
+ "Client-Name: ", fromText cnm, "\r\n",
|
|
|
+ "Return-Path: ", fromText . normalAccountName $ rfm, "\r\n",
|
|
|
+ "Recv-Date: ", formatISO8601 $ rcv, "\r\n",
|
|
|
+ "Body-Encoding: ", show $ enc, "\r\n",
|
|
|
+ "SMTP-UTF8: ", if utf then "Yes" else "No", "\r\n"
|
|
|
+ ] :: [String]
|
|
|
+ return $ map fromText h ++ toStr ++ failStr ++ usrStr ++ unrec
|
|
|
|
|
|
isMetadataComplete :: Metadata -> Bool
|
|
|
isMetadataComplete = isJust . renderMetadata
|
|
@@ -96,6 +100,9 @@ parseMetadata = do
|
|
|
parseField = do
|
|
|
skipHorizontalSpace
|
|
|
A.choice [
|
|
|
+ do
|
|
|
+ act <- hdr "Action" parseEnumCI
|
|
|
+ return $ \(m, ip, p) -> (set action (Just act) m, ip, p),
|
|
|
do
|
|
|
ip <- hdr "Client-Ip" parseRead
|
|
|
return $ \(m, _, p) -> (m, ip, p),
|
|
@@ -180,7 +187,7 @@ parseMetadata = do
|
|
|
parseRead :: Read a => Parser a
|
|
|
parseRead = do
|
|
|
v <- bsval
|
|
|
- case readMaybe . bsutf8 $ v of
|
|
|
+ case readMaybe . fromText $ v of
|
|
|
Nothing -> failParser
|
|
|
Just i -> return i
|
|
|
parseVal :: Parser a -> Parser a
|
|
@@ -195,7 +202,7 @@ parseMetadata = do
|
|
|
parseBoolVal = parseVal parseMetadataBool
|
|
|
parseISO8601Val = do
|
|
|
v <- bsval
|
|
|
- case parseISO8601 . bsutf8 $ v of
|
|
|
+ case parseISO8601 . fromText $ v of
|
|
|
Nothing -> failParser
|
|
|
Just t -> return t
|
|
|
parseMetadataBool :: Parser Bool
|