Accept a sendmail_path on the command line.

diff --git a/src/CommandLine.hs b/src/CommandLine.hs
index 3fc8eb39098fba581ac5a5c11ae5f13ca4098682..b5487d423c9350b7d9130a00f87a6f8ec5503f3c 100644 (file)
--- a/src/CommandLine.hs
+++ b/src/CommandLine.hs
@@ -11,6 +11,7 @@ module CommandLine
 
 import Data.Maybe (fromJust, isJust, isNothing)
 import System.Console.GetOpt
+import System.Directory (doesFileExist)
 import System.Environment (getArgs)
 
 import Configuration (Cfg(..))
@@ -20,6 +21,7 @@ data Options = Options { opt_heartbeat :: Maybe Int,
                          opt_help  :: Bool,
                          opt_ignore_replies :: Bool,
                          opt_ignore_retweets :: Bool,
+                         opt_sendmail_path :: FilePath,
                          opt_from :: Maybe String,
                          opt_to :: Maybe String,
                          opt_verbose :: Bool }
@@ -32,6 +34,7 @@ default_options = Options { opt_heartbeat = Just 600,
                             opt_help = False,
                             opt_ignore_replies = False,
                             opt_ignore_retweets = False,
+                            opt_sendmail_path = "/usr/sbin/sendmail",
                             opt_from = Nothing,
                             opt_to = Nothing,
                             opt_verbose = False }
@@ -67,6 +70,11 @@ options =
       (ReqArg set_from "email_address")
       "Send tweets FROM email_address.",
 
+    Option
+      ['s']["sendmail_path"]
+      (ReqArg set_sendmail_path "sendmail_path")
+      "Use sendmail_path to send mail",
+
     Option
       ['i']["ignore-replies"]
       (NoArg set_ignore_replies)
@@ -113,6 +121,10 @@ set_verbose :: Options -> IO Options
 set_verbose opts =
   return opts { opt_verbose = True }
 
+set_sendmail_path :: String -> Options -> IO Options
+set_sendmail_path arg opts = do
+  return opts { opt_sendmail_path = arg }
+
 set_to :: String -> Options -> IO Options
 set_to arg opts = do
   return opts { opt_to = Just arg }
@@ -124,7 +136,7 @@ set_from arg opts = do
 
 -- | The usage header.
 usage :: String
-usage = "Usage: twat [-n heartbeat] [-t to_address] [-f from_address] <username1> [username2, [username3]...]"
+usage = "Usage: twat [-n heartbeat] [-t to_address] [-f from_address] [-s path-to-sendmail] <username1> [username2, [username3]...]"
 
 
 -- | Was the help option passed?
@@ -161,7 +173,7 @@ heartbeat_errors = do
     then return ["\"heartbeat\" does not appear to be an integer."]
     else return []
 
--- |Parse errors relating to the list of usernames.
+-- | Parse errors relating to the list of usernames.
 username_errors :: IO [String]
 username_errors = do
   argv <- getArgs
@@ -172,7 +184,7 @@ username_errors = do
     else return []
 
 
--- |Parse errors relating to the "To" address.
+-- | Parse errors relating to the "To" address.
 to_errors :: IO [String]
 to_errors = do
   toaddr <- parse_to_address
@@ -182,6 +194,16 @@ to_errors = do
     else return []
 
 
+-- | Errors for the sendmail path argument.
+sendmail_path_errors :: IO [String]
+sendmail_path_errors = do
+  sendmail <- parse_sendmail_path
+  exists <- doesFileExist sendmail
+  if (not exists)
+    then return ["sendmail path does not exist"]
+    else return []
+
+
 -- | Parse errors relating to the "From" address.
 from_errors :: IO [String]
 from_errors = do
@@ -206,9 +228,11 @@ parse_errors = do
   errs_username <- username_errors
   errs_to <- to_errors
   errs_from <- from_errors
+  errs_sendmail <- sendmail_path_errors
   return $ map format_error (errors ++
                              errs_heartbeat ++
                              errs_username ++
+                             errs_sendmail ++
                              errs_to ++
                              errs_from)
 
@@ -224,6 +248,12 @@ parse_to_address = do
   opts <- parse_options
   return (opt_to opts)
 
+-- | What sendmail path was given on the command line?
+parse_sendmail_path :: IO FilePath
+parse_sendmail_path = do
+  opts <- parse_options
+  return (opt_sendmail_path opts)
+
 -- | What "From" address was given on the command line?
 parse_from_address :: IO (Maybe String)
 parse_from_address = do
@@ -248,6 +278,7 @@ get_cfg = do
   return Cfg { heartbeat = fromJust $ opt_heartbeat opts,
                ignore_replies = opt_ignore_replies opts,
                ignore_retweets = opt_ignore_retweets opts,
+               sendmail_path = opt_sendmail_path opts,
                from_address = opt_from opts,
                to_address = opt_to opts,
                verbose = opt_verbose opts }

diff --git a/src/Configuration.hs b/src/Configuration.hs
index 248c91faeb460f99adaf69f566b5a527d1fff2ba..e83dc29c8616e755048cb4c39d0461da750c1766 100644 (file)
--- a/src/Configuration.hs
+++ b/src/Configuration.hs
@@ -9,6 +9,7 @@ where
 data Cfg = Cfg { heartbeat :: Int,
                  ignore_replies :: Bool,
                  ignore_retweets :: Bool,
+                 sendmail_path :: String,
                  from_address :: Maybe String,
                  to_address :: Maybe String,
                  verbose :: Bool }

diff --git a/src/Mail.hs b/src/Mail.hs
index 2da56639667b4b2b63d387aaab601934091f5f7e..2e86a204e003ceda90bfb32994fe4e83f386ad48 100644 (file)
--- a/src/Mail.hs
+++ b/src/Mail.hs
@@ -33,7 +33,7 @@ default_headers = ["MIME-Version: 1.0",
 
 -- |Showing a message will print it in roughly RFC-compliant
 -- form. This form is sufficient for handing the message off to
--- sendmail.
+-- sendmail (or compatible).
 instance Show Message where
     show m =
         concat [ if (length (headers m) == 0) then "" else (intercalate "\n" (headers m)) ++ "\n",
@@ -65,14 +65,14 @@ rfc822_now = do
 
 
 -- |Takes a message as an argument, and passes it to the system's
--- sendmail binary.
-sendmail :: Message -> IO (String, String, ExitCode)
-sendmail message = do
+-- sendmail (or compatible) binary.
+sendmail :: FilePath -> Message -> IO (String, String, ExitCode)
+sendmail sendmail_path message = do
   let sendmail_args = ["-f",
                        (from message)]
 
   (inh, outh, errh, ph) <-
-      runInteractiveProcess "/usr/bin/sendmail" sendmail_args Nothing Nothing
+      runInteractiveProcess sendmail_path sendmail_args Nothing Nothing
 
   outm <- newEmptyMVar
   outs <- hGetContents outh

diff --git a/src/Main.hs b/src/Main.hs
index bd749f8ca47115b89e7f57c38301ad3f7f7f11e7..a52a73fa51d37215255d2a2b17aec5e56737d1ea 100644 (file)
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -41,19 +41,19 @@ message_from_status message default_date status =
 
 -- | If the given Message is not Nothing, send a copy of it for every
 -- Status in the list.
-send_messages :: Maybe Message -> [Status] -> IO ()
-send_messages maybe_message statuses =
+send_messages :: Cfg -> Maybe Message -> [Status] -> IO ()
+send_messages cfg maybe_message statuses =
   case maybe_message of
     Nothing -> return ()
     Just message -> do
       default_date <- rfc822_now
       let mfs = message_from_status message (default_date)
       let messages = map mfs statuses
-      sendmail_results <- mapM sendmail messages
+      sendmail_results <- mapM sendmail' messages
       _ <- mapM print_sendmail_result sendmail_results
       return ()
-
-
+  where
+    sendmail' = sendmail (sendmail_path cfg)
 
 -- | Display the number of skipped replies if ignore_replies is true
 --   and verbose is enabled.
@@ -123,7 +123,7 @@ recurse cfg username latest_status_id maybe_message = do
 
       _ <- mapM (putStrLn . pretty_print) good_statuses
 
-      send_messages maybe_message good_statuses
+      send_messages cfg maybe_message good_statuses
 
       let new_latest_status_id = get_max_status_id new_statuses
       do_recurse new_latest_status_id
@@ -228,8 +228,8 @@ main = do
 
 -- | A debugging tool that will parse, print, and email a single
 --   status (given by its id).
-twat_single_status :: Integer -> (Maybe Message) -> IO ()
-twat_single_status the_status_id maybe_message = do
+twat_single_status :: Cfg -> Integer -> (Maybe Message) -> IO ()
+twat_single_status cfg the_status_id maybe_message = do
     xmldata <- get_status the_status_id
 
     -- Parsing an empty result can blow up. Just pretend there are
@@ -252,6 +252,8 @@ twat_single_status the_status_id maybe_message = do
           Just message -> do
              default_date <- rfc822_now
              let messages = map (message_from_status message (default_date)) statuses
-             sendmail_results <- mapM sendmail messages
+             sendmail_results <- mapM sendmail' messages
              _ <- mapM print_sendmail_result sendmail_results
              return ()
+    where
+      sendmail' = sendmail (sendmail_path cfg)
\ No newline at end of file