Update the default headers to include a Content-Transfer-Encoding: 8bit.

[dead/halcyon.git] / src / Mail.hs

diff --git a/src/Mail.hs b/src/Mail.hs
index 3304d7677dd501734b027bf43158876cc6672a6e..03b7284665fa40b742cc6d36fa3a9209c2a6c838 100644 (file)
--- a/src/Mail.hs
+++ b/src/Mail.hs
@@ -4,13 +4,13 @@ module Mail
 where
 
 import Control.Concurrent
 where
 
 import Control.Concurrent

-import Control.Concurrent.MVar

 import Control.Exception (evaluate)
 import Data.List (intercalate)
 import System.Exit
 import System.Process
 import System.Time (CalendarTime(..), ClockTime, getClockTime, Month, toCalendarTime)
 import Control.Exception (evaluate)
 import Data.List (intercalate)
 import System.Exit
 import System.Process
 import System.Time (CalendarTime(..), ClockTime, getClockTime, Month, toCalendarTime)

-import System.IO
+import System.IO (hClose, hGetContents, hPutStr)
+

 
 type Header = String
 
 
 type Header = String
 


@@ -22,6 +22,14 @@ data Message = Message { headers :: [Header],
                          to      :: String }
              deriving (Eq)
 
                          to      :: String }
              deriving (Eq)
 

+-- |The default headers attached to each message.
+-- The MIME junk is needed for UTF-8 to work properly.
+-- Note that your mail server should support the 8BITMIME extension.
+default_headers :: [Header]
+default_headers = ["MIME-Version: 1.0",
+                   "Content-Type: text/plain; charset=UTF-8",
+                   "Content-Transfer-Encoding: 8bit"]
+

 -- |Showing a message will print it in roughly RFC-compliant
 -- form. This form is sufficient for handing the message off to
 -- sendmail.
 -- |Showing a message will print it in roughly RFC-compliant
 -- form. This form is sufficient for handing the message off to
 -- sendmail.


@@ -118,9 +126,9 @@ sendmail message = do
   errm <- newEmptyMVar
   errs <- hGetContents errh
 
   errm <- newEmptyMVar
   errs <- hGetContents errh
 

-  forkIO $ hPutStr inh (show message) >> hClose inh
-  forkIO $ evaluate (length outs) >> putMVar outm ()
-  forkIO $ evaluate (length errs) >> putMVar errm ()
+  _ <- forkIO $ hPutStr inh (show message) >> hClose inh
+  _ <- forkIO $ evaluate (length outs) >> putMVar outm ()
+  _ <- forkIO $ evaluate (length errs) >> putMVar errm ()

 
   readMVar outm
   readMVar errm
 
   readMVar outm
   readMVar errm