module WASH.Mail.Email (
sendmail, inventMessageId, exitcodeToSYSEXIT, SYSEXIT(..),
module WASH.Mail.MIME, module WASH.Mail.HeaderField) where
import IO
import System
import WASH.Utility.Auxiliary
import WASH.Utility.Unique
import WASH.Mail.EmailConfig
import WASH.Mail.HeaderField
import WASH.Mail.MIME
data SYSEXIT =
EX_OK
| EX_USAGE
| EX_DATAERR
| EX_NOINPUT
| EX_NOUSER
| EX_NOHOST
| EX_UNAVAILABLE
| EX_SOFTWARE
| EX_OSERR
| EX_OSFILE
| EX_CANTCREAT
| EX_IOERR
| EX_TEMPFAIL
| EX_PROTOCOL
| EX_NOPERM
| EX_CONFIG
| 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
sendmailFlags =
["-i"
,"-t"
,"--"
]
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))