Added greeting and the functions needed to support it

[offlineimap] / src / Network / IMAP / Parser.hs

diff --git a/src/Network/IMAP/Parser.hs b/src/Network/IMAP/Parser.hs
index 7e0b13a0f030b4875267e97a6fad82d492b3b2a0..23cf07461a0f89c3c12ef53bf001f86a5e673bde 100644 (file)
--- a/src/Network/IMAP/Parser.hs
+++ b/src/Network/IMAP/Parser.hs
@@ -21,23 +21,28 @@ import Text.ParserCombinators.Parsec
 import Network.IMAP.Types
 import Text.Regex.Posix
 import Data.Int
+import Data.List
+
+import Network.IMAP.Parser.Prim
 
 {- | Read a full response from the server. -}
-{-
 readFullResponse :: Monad m => 
     IMAPConnection m ->         -- ^ The connection to the server
-    IMAPString ->               -- ^ The tag that we are awaiting
     m IMAPString
-readFullResponse conn expectedtag =
+readFullResponse conn =
     accumLines []
     where accumLines accum = 
-              do line <- getFullLine []
--}
+              do line <- getFullLine [] conn
+                 if "* " `isPrefixOf` line
+                    then accumLines (accum ++ line ++ "\r\n")
+                    else return (accum ++ line ++ "\r\n")
 
 {- | Read a full line from the server, handling any continuation stuff.
 
-FIXME: for now, we naively assume that any line ending in '}\r\n' is
-having a continuation piece. -}
+If a {x}\r\n occurs, then that string (including the \r\n) will occur
+literally in the result, followed by the literal read, and the rest of the
+data.
+ -}
 
 getFullLine :: Monad m => 
                IMAPString ->    -- ^ The accumulator (empty for first call)
@@ -50,9 +55,58 @@ getFullLine accum conn =
          Nothing -> return (accum ++ input)
          Just (size) -> 
              do literal <- readBytes conn size
-                getFullLine (accum ++ input ++ literal) conn
+                getFullLine (accum ++ input ++ "\r\n" ++ literal) conn
     where checkContinuation :: String -> Maybe Int64
           checkContinuation i =
-              case i =~ "\\{([0-9]+)\\}$" of
-                [] -> Nothing
-                x -> Just (read x)
+              case i =~ "\\{([0-9]+)\\}$" :: (String, String, String, [String]) of
+                (_, _, _, [x]) -> Just (read x)
+                _ -> Nothing
+
+----------------------------------------------------------------------
+-- Response parsing
+----------------------------------------------------------------------
+
+{- | Returns Left for a "BYE" response, or Right if we are ready to
+proceed with auth (or preauth). -}
+greeting :: IMAPParser (Either RespText (AuthReady, RespText))
+greeting =
+    do string "* "
+       (respCondBye >>= return . Left) <|>
+          (respCondAuth >>= return . Right)
+
+data AuthReady = AUTHOK | AUTHPREAUTH
+          deriving (Eq, Read, Show)
+
+data RespText = RespText {respTextCode :: Maybe String,
+                           respTextMsg :: String}
+                 deriving (Eq, Read, Show)
+
+respCondAuth :: IMAPParser (AuthReady, RespText)
+respCondAuth =
+    do s <- (string "OK" >> return AUTHOK) <|>
+            (string "PREAUTH" >> return AUTHPREAUTH)
+       sp
+       t <- respText
+       return (s, t)
+
+respCondBye :: IMAPParser RespText
+respCondBye =
+    do string "BYE "
+       respText
+
+-- Less strict than mandated in RFC3501 formal syntax
+respText :: IMAPParser RespText
+respText =
+    do code <- optionMaybe respTextCode
+       t <- text
+       return $ RespText code t
+    where respTextCode =
+              do char '['
+                 a <- atom
+                 sp
+                 b <- option "" respTextCodeText
+                 char ']'
+                 sp
+                 return (a ++ " " ++ b)
+          respTextCodeText = many1 (noneOf (']' : crlf))
+                 
\ No newline at end of file