Commit 84acbcec authored by Stephane Glondu's avatar Stephane Glondu

Add (optional) return path to mails sent by server

parent 42385cfd
......@@ -28,6 +28,7 @@ open Web_serializable_j
let spool_dir = ref "."
let server_mail = ref "noreply@belenios.org"
let return_path = ref None
let contact_uri = ref None
module LwtRandom = struct
......@@ -195,6 +196,13 @@ let string_of_user {user_domain; user_name} =
let underscorize x =
String.map (function '-' -> '_' | c -> c) (raw_string_of_uuid x)
let sendmail ?return_path message =
let mailer =
match return_path with
| None -> None
| Some x -> Some (Printf.sprintf "/usr/lib/sendmail -f %s" x) in
Netsendmail.sendmail ?mailer message
let send_email recipient subject body =
let contents =
Netsendmail.compose
......@@ -203,9 +211,11 @@ let send_email recipient subject body =
~in_charset:`Enc_utf8 ~out_charset:`Enc_utf8
~subject body
in
let return_path = !return_path in
let sendmail = sendmail ?return_path in
let rec loop () =
try%lwt
Lwt_preemptive.detach Netsendmail.sendmail contents
Lwt_preemptive.detach sendmail contents
with Unix.Unix_error (Unix.EAGAIN, _, _) ->
Lwt_unix.sleep 1. >> loop ()
in loop ()
......
......@@ -24,6 +24,7 @@ open Web_serializable_t
val spool_dir : string ref
val server_mail : string ref
val return_path : string option ref
val contact_uri : string option ref
module LwtRandom : RANDOM with type 'a t = 'a Lwt.t
......
......@@ -58,11 +58,18 @@ let () =
failwith "UUID length is too small"
| Element ("contact", ["uri", uri], []) ->
Web_common.contact_uri := Some uri
| Element ("server", ["mail", mail], []) ->
if is_email mail then
server_mail := mail
else
Printf.ksprintf failwith "%s is not a valid e-mail address" mail
| Element ("server", attrs, []) ->
let set attr setter =
try
let mail = List.assoc attr attrs in
if is_email mail then
setter mail
else
Printf.ksprintf failwith "%s is not a valid e-mail address" mail
with Not_found -> ()
in
set "mail" (fun x -> server_mail := x);
set "return-path" (fun x -> return_path := Some x);
| Element ("spool", ["dir", dir], []) ->
spool_dir := Some dir
| Element ("rewrite-prefix", ["src", src; "dst", dst], []) ->
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment