Supply the "to" address to sendmail on the commandline.

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

diff --git a/src/Mail.hs b/src/Mail.hs
index 2da56639667b4b2b63d387aaab601934091f5f7e..c54255a56a26a1e620a0f53f0d7386545ed55161 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,15 @@ 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)]
+                       (from message),
+                       (to 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