From fdc80f514bfe9005f55768f63b619ad170ad1b56 Mon Sep 17 00:00:00 2001 From: Michael Orlitzky Date: Tue, 6 Nov 2012 13:33:23 -0500 Subject: [PATCH] Accept a sendmail_path on the command line. --- src/CommandLine.hs | 37 ++++++++++++++++++++++++++++++++++--- src/Configuration.hs | 1 + src/Mail.hs | 10 +++++----- src/Main.hs | 20 +++++++++++--------- 4 files changed, 51 insertions(+), 17 deletions(-) diff --git a/src/CommandLine.hs b/src/CommandLine.hs index 3fc8eb3..b5487d4 100644 --- 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] [username2, [username3]...]" +usage = "Usage: twat [-n heartbeat] [-t to_address] [-f from_address] [-s path-to-sendmail] [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 248c91f..e83dc29 100644 --- 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 2da5663..2e86a20 100644 --- 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 bd749f8..a52a73f 100644 --- 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 -- 2.43.2