-- © 2001, 2002 Peter Thiemann module WASH.Mail.Email ( sendmail, inventMessageId, exitcodeToSYSEXIT, SYSEXIT(..), module WASH.Mail.MIME, module WASH.Mail.HeaderField) where -- from standard library import IO import System -- from utility import WASH.Utility.Auxiliary import WASH.Utility.Unique -- from package import WASH.Mail.EmailConfig import WASH.Mail.HeaderField import WASH.Mail.MIME -- |from sysexit.h data SYSEXIT = EX_OK -- 0 /* successful termination */ | EX_USAGE -- 64 /* command line usage error */ | EX_DATAERR -- 65 /* data format error */ | EX_NOINPUT -- 66 /* cannot open input */ | EX_NOUSER -- 67 /* addressee unknown */ | EX_NOHOST -- 68 /* host name unknown */ | EX_UNAVAILABLE -- 69 /* service unavailable */ | EX_SOFTWARE -- 70 /* internal software error */ | EX_OSERR -- 71 /* system error (e.g., can't fork) */ | EX_OSFILE -- 72 /* critical OS file missing */ | EX_CANTCREAT -- 73 /* can't create (user) output file */ | EX_IOERR -- 74 /* input/output error */ | EX_TEMPFAIL -- 75 /* temp failure; user is invited to retry */ | EX_PROTOCOL -- 76 /* remote error in protocol */ | EX_NOPERM -- 77 /* permission denied */ | EX_CONFIG -- 78 /* configuration error */ | EX_UNKNOWN Int exitcodeToSYSEXIT :: ExitCode -> SYSEXIT exitcodeToSYSEXIT exitcode = case exitcode of ExitSuccess -> EX_OK ExitFailure 64 -> EX_USAGE ExitFailure 65 -> EX_DATAERR ExitFailure 66 -> EX_NOINPUT ExitFailure 67 -> EX_NOUSER ExitFailure 68 -> EX_NOHOST ExitFailure 69 -> EX_UNAVAILABLE ExitFailure 70 -> EX_SOFTWARE ExitFailure 71 -> EX_OSERR ExitFailure 72 -> EX_OSFILE ExitFailure 73 -> EX_CANTCREAT ExitFailure 74 -> EX_IOERR ExitFailure 75 -> EX_TEMPFAIL ExitFailure 76 -> EX_PROTOCOL ExitFailure 77 -> EX_NOPERM ExitFailure 78 -> EX_CONFIG ExitFailure sc -> EX_UNKNOWN sc instance Show SYSEXIT where showsPrec i se = case se of EX_OK -> showString "successful termination" EX_USAGE -> showString "command line usage error" EX_DATAERR -> showString "data format error" EX_NOINPUT -> showString "cannot open input" EX_NOUSER -> showString "addressee unknown" EX_NOHOST -> showString "host name unknown" EX_UNAVAILABLE -> showString "service unavailable" EX_SOFTWARE -> showString "internal software error" EX_OSERR -> showString "system error (e.g., can't fork)" EX_OSFILE -> showString "critical OS file missing" EX_CANTCREAT -> showString "can't create (user) output file" EX_IOERR -> showString "input/output error" EX_TEMPFAIL -> showString "temp failure; user is invited to retry" EX_PROTOCOL -> showString "remote error in protocol" EX_NOPERM -> showString "permission denied" EX_CONFIG -> showString "configuration error" EX_UNKNOWN sc -> showString "unknown return code: " . shows sc -- facilities for sending email sendmailFlags = ["-i" -- ignore dots alone on a line ,"-t" -- read message for recipients ,"--" -- end of flag arguments ] -- , "-v" for verbose mode sendmail :: Mail -> IO ExitCode sendmail mail = do filename <- inventBoundary let tempfilename = emailTmpDir ++ filename tempfilename2 = emailTmpDir ++ "T" ++ filename h <- openFile tempfilename WriteMode hSend smtpSendControl{ sendH = h } mail hClose h exitcode <- system (sendmailProgram ++ pFlags sendmailFlags ++ " < " ++ tempfilename ++ " > " ++ tempfilename2) system ("rm " ++ tempfilename) system ("rm " ++ tempfilename2) return exitcode pFlags [] = "" pFlags (flag:flags) = ' ' : flag ++ pFlags flags inventMessageId :: IO Header inventMessageId = do randomKey <- inventStdKey hostname <- protectedGetEnv "SERVER_NAME" "localhost" let messageId = "<" ++ randomKey ++ ".Email@" ++ hostname ++ ">" return (Header ("Message-Id", messageId))