X-Git-Url: http://gitweb.michael.orlitzky.com/?p=dead%2Fhalcyon.git;a=blobdiff_plain;f=src%2FMail.hs;h=2da56639667b4b2b63d387aaab601934091f5f7e;hp=3304d7677dd501734b027bf43158876cc6672a6e;hb=bfe49b970e83f1d422d57ece7cebdfe7a56b817c;hpb=6954f707adaa34e2fdc6df78b6bcce79e35279ee diff --git a/src/Mail.hs b/src/Mail.hs index 3304d76..2da5663 100644 --- 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,6 +23,14 @@ 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-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. @@ -46,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, --- --- --- --- 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 @@ -118,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