[Pkg-haskell-commits] [SCM] haskell-testpack branch, master, updated. debian/1.0.2-1-4-gb0d6b36
John Goerzen
jgoerzen at complete.org
Fri Apr 23 14:50:24 UTC 2010
The following commit has been merged in the master branch:
commit 0bbc75e4d6a4b96e0019512e8048109061eb7013
Author: John Goerzen <jgoerzen at complete.org>
Date: Thu Dec 9 10:59:37 2004 +0100
Finishing up initial write of the mail parser
Keywords:
(jgoerzen at complete.org--projects/missingh--head--0.7--patch-52)
diff --git a/ChangeLog b/ChangeLog
index b62226d..fdd5c8e 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -2,6 +2,22 @@
# arch-tag: automatic-ChangeLog--jgoerzen at complete.org--projects/missingh--head--0.7
#
+2004-12-09 03:59:37 GMT John Goerzen <jgoerzen at complete.org> patch-52
+
+ Summary:
+ Finishing up initial write of the mail parser
+ Revision:
+ missingh--head--0.7--patch-52
+
+
+ modified files:
+ ChangeLog libsrc/MissingH/Email/Parser.hs
+
+ renamed files:
+ libsrc/MissingH/Email/MailParser.hs
+ ==> libsrc/MissingH/Email/Parser.hs
+
+
2004-12-09 03:26:55 GMT John Goerzen <jgoerzen at complete.org> patch-51
Summary:
diff --git a/libsrc/MissingH/Email/MailParser.hs b/libsrc/MissingH/Email/MailParser.hs
deleted file mode 100644
index b47692e..0000000
--- a/libsrc/MissingH/Email/MailParser.hs
+++ /dev/null
@@ -1,112 +0,0 @@
-{- arch-tag: E-Mail Parsing Utility
-Copyright (C) 2004 John Goerzen <jgoerzen at complete.org>
-
-This program is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2 of the License, or
-(at your option) any later version.
-
-This program is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with this program; if not, write to the Free Software
-Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
--}
-
-{- |
- Module : MissingH.Email.Parser
- Copyright : Copyright (C) 2004 John Goerzen
- License : GNU GPL, version 2 or above
-
- Maintainer : John Goerzen,
- Maintainer : jgoerzen at complete.org
- Stability : provisional
- Portability: portable
-
-Parses an e-mail message
-Written by John Goerzen, jgoerzen\@complete.org
--}
-
-module MissingH.Email.Parser(mailParser)
-where
-
-import MissingH.Hsemail.Rfc2822
-import Text.ParserCombinators.Parsec
-
-getHeaders :: String -> CharParser a [(String, String)]
-getHeaders = many $ optional_field
-
-parseMsg = do
-
-mailParser :: String ->
-mailParser s = let m = message s
- (
-import MissingH.Cmd
-import System.Directory
-import System.IO
-
-sendmails = ["/usr/sbin/sendmail",
- "/usr/local/sbin/sendmail",
- "/usr/local/bin/sendmail",
- "/usr/bin/sendmail",
- "/etc/sendmail",
- "/usr/etc/sendmail"]
-
-findsendmail :: IO String
-findsendmail =
- let worker [] = return "sendmail"
- worker (this:next) =
- do
- e <- doesFileExist this
- if e then
- do
- p <- getPermissions this
- if executable p then
- return this
- else worker next
- else worker next
- in
- worker sendmails
-
-{- | Transmits an e-mail message using the system's mail transport agent.
-
-This function takes a message, a list of recipients, and an optional sender,
-and transmits it using the system's MTA, sendmail.
-
-If @sendmail@ is on the @PATH@, it will be used; otherwise, a list of system
-default locations will be searched.
-
-A failure will be logged, since this function uses 'MissingH.Cmd.safeSystem'
-internally.
-
-This function will first try @sendmail at . If it does not exist, an error is
-logged under @MissingH.Cmd.pOpen3@ and various default @sendmail@ locations
-are tried. If that still fails, an error is logged and an exception raised.
-
- -}
-sendmail :: Maybe String -- ^ The envelope from address. If not specified, takes the system's default, which is usually based on the effective userid of the current process. This is not necessarily what you want, so I recommend specifying it.
- -> [String] -- ^ A list of recipients for your message. An empty list is an error.
- -> String -- ^ The message itself.
- -> IO ()
-sendmail _ [] _ = fail "sendmail: no recipients specified"
-sendmail Nothing recipients msg = sendmail_worker recipients msg
-sendmail (Just from) recipients msg =
- sendmail_worker (("-f" ++ from) : recipients) msg
-
-sendmail_worker :: [String] -> String -> IO ()
-sendmail_worker args msg =
- let func h = hPutStr h msg
- in
- do
- --pOpen WriteToPipe "/usr/sbin/sendmail" args func
- rv <- try (pOpen WriteToPipe "sendmail" args func)
- case rv of
- Right x -> return x
- Left _ -> do
- sn <- findsendmail
- rv <- pOpen WriteToPipe sn args func
- return $! rv
-
diff --git a/libsrc/MissingH/Email/Parser.hs b/libsrc/MissingH/Email/Parser.hs
new file mode 100644
index 0000000..205b5fd
--- /dev/null
+++ b/libsrc/MissingH/Email/Parser.hs
@@ -0,0 +1,72 @@
+{- arch-tag: E-Mail Parsing Utility
+Copyright (C) 2004 John Goerzen <jgoerzen at complete.org>
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+-}
+
+{- |
+ Module : MissingH.Email.Parser
+ Copyright : Copyright (C) 2004 John Goerzen
+ License : GNU GPL, version 2 or above
+
+ Maintainer : John Goerzen,
+ Maintainer : jgoerzen at complete.org
+ Stability : provisional
+ Portability: portable
+
+Parses an e-mail message
+
+Written by John Goerzen, jgoerzen\@complete.org
+-}
+
+module MissingH.Email.Parser(mailParser)
+where
+
+import MissingH.Hsemail.Rfc2234(crlf)
+import MissingH.Hsemail.Rfc2822 hiding (Message)
+import MissingH.Wash.Mail.MailParser(RawMessage(..), digestMessage)
+import MissingH.Wash.Mail.HeaderField(Header(..))
+import qualified MissingH.Wash.Mail.Message
+import Text.ParserCombinators.Parsec
+import Control.Monad.Error
+import Text.ParserCombinators.Parsec.Error
+import Text.ParserCombinators.Parsec.Pos(newPos)
+
+instance Error ParseError where
+ noMsg = strMsg ""
+ strMsg s = newErrorMessage (Message s) (newPos "" 0 0)
+
+getHeaders :: CharParser a [(String, String)]
+getHeaders = many $ optional_field
+
+parseMsg :: CharParser a ([(String, String)], String)
+parseMsg = do f <- getHeaders
+ crlf
+ b <- body
+ return (f, b)
+
+{- | Parse a string as an e-mail, returning a
+'MissingH.Wash.Mail.Message.Message' object.
+
+ParseError is defined in Text.ParserCombinators.Parsec.Error.
+-}
+
+mailParser :: String -> Either ParseError MissingH.Wash.Mail.Message.Message
+mailParser s = do
+ p <- parse parseMsg "" s
+ let raw = RawMessage {rawHeaders = map Header (fst p),
+ rawLines = lines (snd p)}
+ return $ digestMessage raw
+
--
haskell-testpack
More information about the Pkg-haskell-commits
mailing list