1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77

---------------------------------------------------------------------------
--- This library contains operations for sending emails.
--- The implementation might need to be adapted to the local
--- environment.
---
--- @author Michael Hanus
--- @version February 2021
---------------------------------------------------------------------------

module Mail ( sendMail, MailOption(..), sendMailWithOptions )
 where

import Directory   ( doesFileExist )
import FilePath    ( (</>) )
import IOExts      ( evalCmd )
import IO          ( hClose, hPutStrLn, stderr )
import List        ( splitOn )

import System.Path ( fileInPath )

--- Sends an email via mailx command.
--- @param from - the email address of the sender
--- @param to - the email address of the recipient
--- @param subject - the subject of the email
--- @param contents - the contents of the email
sendMail :: String -> String -> String -> String -> IO ()
sendMail from to subject = sendMailWithOptions from subject [TO to]

--- Options for sending emails.
--- @cons CC  - recipient of a carbon copy
--- @cons BCC - recipient of a blind carbon copy
--- @cons TO  - recipient of the email
data MailOption = CC String | BCC String | TO String
 deriving Eq

--- Sends an email via mailx command and various options.
--- Note that multiple options are allowed, e.g., more than one CC option
--- for multiple recipient of carbon copies.
---
--- Important note: The implementation of this operation is based on the
--- command "mailx" and must be adapted according to your local environment!
---
--- @param from - the email address of the sender
--- @param subject - the subject of the email
--- @param options - send options, e.g., multiple recipients
--- @param contents - the contents of the email
sendMailWithOptions :: String -> String -> [MailOption] -> String -> IO ()
sendMailWithOptions from subject options contents = do
  mailcmdexists <- fileInPath "mailx"
  if mailcmdexists
    then
      -- if mailx has the option -r:
      --execMailCmd ("mailx -n -r \"" ++ from ++ "\" -s \"" ++ subject++"\" "++
      -- if mailx has the option -a:
      execMailCmd "mailx"
        (["-n", "-a", "From: " ++ from, "-s", subject] ++ ccs ++ bccs ++ tos)
        contents
    else error "Command 'mailx' not found in path!"
 where
   tos  = [ s | TO  s <- options ]
   ccs  = concatMap (\m -> ["-a", "Cc: "  ++ m]) [ s | CC  s <- options ]
   bccs = concatMap (\m -> ["-a", "Bcc: " ++ m]) [ s | BCC s <- options ]


--- Executes a command to send an email and pass the contents via stdin.
--- Note that \r characters in the contents are removed due to problems
--- with such contents in some Unix environments.
execMailCmd :: String -> [String] -> String -> IO ()
execMailCmd cmd args contents = do
  (rc,out,err) <- evalCmd cmd args (filter isUnixChar contents)
  unless (rc == 0) $ putStrLn "ERROR during sending email!"
  unless (null out) $ putStrLn out
  unless (null err) $ hPutStrLn stderr err
 where
  isUnixChar c = c /= '\r'

---------------------------------------------------------------------------