Browse Source

Fixes bugs on parsing and rendeing Metadata and Backend

Marcos Dumay de Medeiros 8 years ago
parent
commit
5649daef67
3 changed files with 9 additions and 17 deletions
  1. 5 14
      src/Walrus/Backend.hs
  2. 2 2
      src/Walrus/Backend/Metadata.hs
  3. 2 1
      walrus-backend.cabal

+ 5 - 14
src/Walrus/Backend.hs

@@ -20,9 +20,12 @@ import Control.Applicative
 
 import Network
 import System.IO
+--import System.IO.Uniform
+--import System.IO.Uniform.HandlePair as HP
+--import System.IO.Uniform.Network as Net
 import qualified System.Process as P
 
-data Backend = TCPBackend String Int | UnixSocketBackend String |
+data Backend = TCPBackend String Int |
                ExecBackend String [String] deriving (Show, Read, Ord, Eq)
 
 parseBackend :: A.Parser Backend
@@ -33,14 +36,10 @@ parseBackend = do
       h <- tillSpace
       p <- A.decimal
       return $ TCPBackend h p,
-    do
-      tp "unix"
-      tp "socket"
-      p <- qStr
-      return $ UnixSocketBackend p,
     do
       tp "exec"
       f <- qStr
+      skipHorizontalSpace
       pp <- parseParameters
       return $ ExecBackend f pp
     ]
@@ -66,7 +65,6 @@ runBackend b (m, qdt) = do
   let rm = renderMetadata m
   edt' <- intBk b $ LBS.concat [
     fromTextual rm,
-    "\r\n",
     qdt]
   case LA.parse repParse edt' of
     LA.Fail _ _ e -> return $ Left e
@@ -74,11 +72,9 @@ runBackend b (m, qdt) = do
   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
@@ -86,11 +82,6 @@ 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

+ 2 - 2
src/Walrus/Backend/Metadata.hs

@@ -106,7 +106,7 @@ renderMetadata m = BS.concat serialize
         Nothing -> []
         Just u -> ["Auth-User: ", u, "\r\n"]
       toStr = List.concat $ map (\x -> ["To: ", renderMetadataAddress $ x, "\r\n"]) rto
-      failStr = List.concat $ map (\(a, r) -> ["Failed: ", renderMetadataAddress a, ";", renderLineResponse r, "\r\n"]) rfail
+      failStr = List.concat $ map (\(a, r) -> ["Failed: ", renderMetadataAddress a, "; ", renderLineResponse r, "\r\n"]) rfail
       unrec = m^.unrecognized
       h = [
         "Action: ", show act, "\r\n",
@@ -173,7 +173,7 @@ parseMetadata = do
           utf <- hdr "SMTP-UTF8" parseMetadataBool
           return $ \(m, ip, p) -> (set msmtpUtf8 utf m, ip, p),
         do
-          usr <- hdr "Auth-User" bsval
+          usr <- hdr "Auth-User" A.takeByteString
           return $ \(m, ip, p) -> (set mauth (Just usr) m, ip, p),
         do
           sz <- hdr "Data-Size" A.decimal

+ 2 - 1
walrus-backend.cabal

@@ -37,7 +37,8 @@ library
     iso8601-time,
     tools-for-attoparsec,
     textual,
-    hssealtools
+    hssealtools,
+    uniform-io >= 1.1.1
   hs-source-dirs:      src
   ghc-options: -Wall -fno-warn-unused-do-bind -fwarn-incomplete-patterns -threaded
   default-language:    Haskell2010