code.delx.au - offlineimap/blob - src/Network/IMAP/Parser.hs

   1 {- offlineimap component
   2 Copyright (C) 2008 John Goerzen <jgoerzen@complete.org>
   3
   4 This program is free software; you can redistribute it and/or modify
   5 it under the terms of the GNU General Public License as published by
   6 the Free Software Foundation; either version 2 of the License, or
   7 (at your option) any later version.
   8
   9 This program is distributed in the hope that it will be useful,
  10 but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12 GNU General Public License for more details.
  13
  14 You should have received a copy of the GNU General Public License
  15 along with this program; if not, write to the Free Software
  16 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  17 -}
  18
  19 module Network.IMAP.Parser where
  20 import Text.ParserCombinators.Parsec
  21 import Network.IMAP.Types
  22 import Text.Regex.Posix
  23 import Data.Int
  24 import Data.List
  25
  26 import Network.IMAP.Parser.Prim
  27
  28 {- | Read a full response from the server. -}
  29 readFullResponse :: Monad m =>
  30     IMAPConnection m ->         -- ^ The connection to the server
  31     m IMAPString
  32 readFullResponse conn =
  33     accumLines []
  34     where accumLines accum =
  35               do line <- getFullLine [] conn
  36                  if "* " `isPrefixOf` line
  37                     then accumLines (accum ++ line ++ "\r\n")
  38                     else return (accum ++ line ++ "\r\n")
  39
  40 {- | Read a full line from the server, handling any continuation stuff.
  41
  42 If a {x}\r\n occurs, then that string (including the \r\n) will occur
  43 literally in the result, followed by the literal read, and the rest of the
  44 data.
  45  -}
  46
  47 getFullLine :: Monad m =>
  48                IMAPString ->    -- ^ The accumulator (empty for first call)
  49                IMAPConnection m -> -- ^ IMAP connection
  50                m IMAPString        -- ^ Result
  51
  52 getFullLine accum conn =
  53     do input <- readLine conn
  54        case checkContinuation input of
  55          Nothing -> return (accum ++ input)
  56          Just (size) ->
  57              do literal <- readBytes conn size
  58                 getFullLine (accum ++ input ++ "\r\n" ++ literal) conn
  59     where checkContinuation :: String -> Maybe Int64
  60           checkContinuation i =
  61               case i =~ "\\{([0-9]+)\\}$" :: (String, String, String, [String]) of
  62                 (_, _, _, [x]) -> Just (read x)
  63                 _ -> Nothing
  64
  65 ----------------------------------------------------------------------
  66 -- Response parsing
  67 ----------------------------------------------------------------------
  68
  69 {- | Returns Left for a "BYE" response, or Right if we are ready to
  70 proceed with auth (or preauth). -}
  71 greeting :: IMAPParser (Either RespText (AuthReady, RespText))
  72 greeting =
  73     do string "* "
  74        (respCondBye >>= return . Left) <|>
  75           (respCondAuth >>= return . Right)
  76
  77 data AuthReady = AUTHOK | AUTHPREAUTH
  78           deriving (Eq, Read, Show)
  79
  80 data RespText = RespText {respTextCode :: Maybe String,
  81                            respTextMsg :: String}
  82                  deriving (Eq, Read, Show)
  83
  84 respCondAuth :: IMAPParser (AuthReady, RespText)
  85 respCondAuth =
  86     do s <- (string "OK" >> return AUTHOK) <|>
  87             (string "PREAUTH" >> return AUTHPREAUTH)
  88        sp
  89        t <- respText
  90        return (s, t)
  91
  92 respCondBye :: IMAPParser RespText
  93 respCondBye =
  94     do string "BYE "
  95        respText
  96
  97 -- Less strict than mandated in RFC3501 formal syntax
  98 respText :: IMAPParser RespText
  99 respText =
 100     do code <- optionMaybe respTextCode
 101        t <- text
 102        return $ RespText code t
 103     where respTextCode =
 104               do char '['
 105                  a <- atom
 106                  b <- option "" (sp >> respTextCodeText)
 107                  char ']'
 108                  sp
 109                  return (a ++ " " ++ b)
 110           respTextCodeText = many1 (noneOf (']' : crlf))
 111