Use a more flexible curl function to make HTTP requests.

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

diff --git a/src/Mail.hs b/src/Mail.hs
index c93a6cff2e9cc53e11e96e9b0e4c36f7733b17fd..2da56639667b4b2b63d387aaab601934091f5f7e 100644 (file)
--- a/src/Mail.hs
+++ b/src/Mail.hs
@@ -4,13 +4,14 @@ module Mail
 where
 
 import Control.Concurrent
-import Control.Concurrent.MVar
 import Control.Exception (evaluate)
 import Data.List (intercalate)
+import Data.Time (formatTime, getZonedTime)
 import System.Exit
+import System.Locale (defaultTimeLocale, rfc822DateFormat)
 import System.Process
-import System.Time (CalendarTime(..), ClockTime, getClockTime, Month, toCalendarTime)
-import System.IO
+import System.IO (hClose, hGetContents, hPutStr)
+
 
 type Header = String
 
@@ -22,9 +23,13 @@ data Message = Message { headers :: [Header],
                          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-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
@@ -50,59 +55,12 @@ pad_left str n
 
 
 
--- |Formats a month name according to RFC822.
-format_month :: Month -> String
-format_month month = take 3 (show month)
-
-
--- |Takes an offset from UTC (in seconds) and returns the four-digit
--- offset as a 'String' in +hhmm format.
-format_timezone :: Int -> String
-format_timezone seconds =
-    sign ++ pad_hh ++ pad_mm
-    where
-      seconds_norm = abs seconds
-      hh = seconds_norm `div` 3600
-      mm = (seconds_norm - (hh*3600)) `div` 60
-      pad_hh = pad_left (show hh) 2
-      pad_mm = pad_left (show mm) 2
-      sign = if seconds < 0 then "-" else "+"
-
-
--- |Takes a 'ClockTime' as an argument, and formats it as an RFC822 Date header.
---
--- See,
---
---   <http://cr.yp.to/immhf/date.html>
---
--- for information.
-format_clocktime :: ClockTime -> IO String
-format_clocktime ct = do
-  caltime <- (toCalendarTime ct)
-
-  let days = pad_left (show (ctDay caltime)) 2
-  let month = format_month (ctMonth caltime)
-  let year = show $ ctYear caltime
-  let hours = pad_left (show (ctHour caltime)) 2
-  let minutes = pad_left (show (ctMin caltime)) 2
-  let seconds = pad_left (show (ctSec caltime)) 2
-  let timezone = format_timezone (ctTZ caltime)
-
-  return $ concat [(show $ ctWDay caltime) ++ ", ",
-                   days ++ " ",
-                   month ++ " ",
-                   year ++ " ",
-                   hours ++ ":",
-                   minutes ++ ":",
-                   seconds ++ " ",
-                   timezone]
-
-
--- |Constructs an RFC822 Date header with the current date/time.
-construct_date_header :: IO String
-construct_date_header = do
-  date <- getClockTime
-  format_clocktime date
+-- | Constructs a 'String' in RFC822 date format for the current
+--   date/time.
+rfc822_now :: IO String
+rfc822_now = do
+  date <- getZonedTime
+  return $ formatTime defaultTimeLocale rfc822DateFormat date
 
 
 
@@ -122,9 +80,9 @@ sendmail message = do
   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