Pushed entire backend interface from walrus here, changed the ParserTools into its own lib

src/Walrus/Backend.hs

@@ -0,0 +1,107 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Walrus.Backend (
+  parseBackend,
+  runBackend
+  ) where
+
+import qualified Data.Attoparsec.ByteString.Char8 as A
+import qualified Data.Attoparsec.ByteString.Lazy as LA
+import Data.Attoparsec.ByteString.Char8.Extras
+import qualified Data.ByteString.Lazy as LBS
+import qualified Data.Char as C
+import Encoding
+
+import Walrus.Backend.Metadata
+import Walrus.Backend.Request
+
+import Control.Applicative
+
+import Network
+import System.IO
+import qualified System.Process as P
+
+data Backend = TCPBackend String Int | UnixSocketBackend String | ExecBackend String [String]
+
+parseBackend :: A.Parser Backend
+parseBackend = do
+  A.choice [
+    do
+      tp "tcp"
+      h <- tillSpace
+      p <- A.decimal
+      return $ TCPBackend h p,
+    do
+      tp "unix"
+      tp "socket"
+      p <- qStr
+      return $ UnixSocketBackend p,
+    do
+      tp "exec"
+      f <- qStr
+      pp <- parseParameters
+      return $ ExecBackend f pp
+    ]
+  where
+    tp t = do
+      skipHorizontalSpace
+      A.stringCI t
+      skipHorizontalSpace
+    tillSpace :: A.Parser String
+    tillSpace = bsutf8 <$> A.takeTill C.isSpace
+    qStr :: A.Parser String
+    qStr = bsutf8 <$> quotedString '\\' " " ""
+    parseParameters = A.many' $ do
+      p <- qStr
+      skipHorizontalSpace
+      return p
+
+runBackend :: Backend -> (Request, Metadata, LBS.ByteString) -> IO (Either String (Metadata, LBS.ByteString))
+runBackend b (req, m, qdt) = case renderMetadata m of
+  Nothing -> return $ Left "Metadata error"
+  Just rm -> do
+    edt' <- intBk b $ LBS.concat [
+      LBS.fromStrict . utf8bs . show $ req,
+      LBS.fromStrict rm,
+      "\r\n",
+      qdt]
+    case LA.parse repParse edt' of
+      LA.Fail _ _ e -> return $ Left e
+      LA.Done edt m' -> return $ Right (m', edt)
+  where
+    intBk :: Backend -> LBS.ByteString -> IO LBS.ByteString
+    intBk (TCPBackend h p) = runTcp h p
+    intBk (UnixSocketBackend f) = runUnix f
+    intBk (ExecBackend f aa) = runExec f aa
+    repParse = do
+      m' <- parseMetadata
+      A.endOfLine
+      return m'
+
+runTcp :: String -> Int -> LBS.ByteString -> IO LBS.ByteString
+runTcp host port dt = do
+  h <- connectTo host (PortNumber . fromIntegral $ port)
+  bkgTrans h dt
+
+runUnix :: String -> LBS.ByteString -> IO LBS.ByteString
+runUnix path dt = do
+  h <- connectTo "localhost" (UnixSocket path)
+  bkgTrans h dt
+
+bkgTrans :: Handle -> LBS.ByteString -> IO LBS.ByteString
+bkgTrans h dt = do
+  hSetNewlineMode h noNewlineTranslation
+  LBS.hPut h dt
+  hFlush h
+  LBS.hGetContents h
+
+runExec :: String -> [String] -> LBS.ByteString -> IO LBS.ByteString
+runExec f args dt = do
+  (Just i, Just o, _, _) <- P.createProcess (
+    (P.proc f args){P.std_in=P.CreatePipe}{
+     P.std_out=P.CreatePipe}{P.std_err=P.Inherit}
+    )
+  mapM (\h -> hSetNewlineMode h noNewlineTranslation) [i, o]
+  LBS.hPut i dt
+  hFlush i
+  LBS.hGetContents o

src/Walrus/Backend/Metadata.hs

@@ -24,7 +24,7 @@ import Data.Maybe (isJust)
 
 import Data.Attoparsec.ByteString.Char8 (Parser)
 import qualified Data.Attoparsec.ByteString.Char8 as A
-import SMTP.Parser.ParserTools
+import Data.Attoparsec.ByteString.Char8.Extras
 import qualified Data.ByteString as BS
 import qualified Data.List as List
 
@@ -34,7 +34,7 @@ data Metadata = Metadata {_clientId :: Maybe ClientIdentity, _clientName :: Mayb
                           _mailFrom :: Maybe Account, _rcptTo :: [Address], _rcptFailed :: [(Address, Response)],
                           _auth :: Maybe ByteString, _recvDate :: Maybe UTCTime, _bodyEnc :: Mime.BodyEncoding,
                           _smtpUtf8 :: Bool, _unrecognized :: [ByteString]
-                         } deriving (Read, Show, Ord, Eq)
+                         } deriving (Show, Ord, Eq)
 
 makeLenses ''ClientIdentity
 makeLenses ''Metadata
@@ -82,7 +82,7 @@ isMetadataComplete = isJust . renderMetadata
 
 parseMetadata :: A.Parser Metadata
 parseMetadata = do
-  (m', h', p') <- parseFold parseField (def, Nothing, Nothing)
+  (m', h', p') <- parserFold parseField (def, Nothing, Nothing)
   let i = do
         h <- h'
         p <- p'

src/Walrus/Backend/Request.hs

@@ -0,0 +1,9 @@
+module Walrus.Backend.Request where
+
+import Data.Attoparsec.ByteString
+import Data.Attoparsec.ByteString.Char8.Extras
+
+data Request = DATA deriving (Show, Read, Eq, Ord, Bounded, Enum)
+
+parseRequest :: Parser Request
+parseRequest = parseEnumCI

walrus-backend.cabal

@@ -16,7 +16,10 @@ build-type:          Simple
 cabal-version:       >=1.10
 
 library
-  exposed-modules:     Walrus.Backend.Metadata
+  exposed-modules:
+    Walrus.Backend
+    Walrus.Backend.Metadata
+    Walrus.Backend.Request
   -- other-modules:       
   other-extensions:    OverloadedStrings, TemplateHaskell
   build-depends:
@@ -29,8 +32,11 @@ library
     iproute >=1.7,
     data-default-class,
     attoparsec >=0.11,
+    network >= 2.6,
+    process >= 1.2,
     lens,
     iso8601-time,
+    tools-for-attoparsec,
     hssealtools
   hs-source-dirs:      src
   default-language:    Haskell2010