Permalink
Browse files

[cleanup] Mail: mail related cleanup

  • Loading branch information...
Aqua-Ye committed Jan 3, 2012
1 parent 364e6e4 commit 70d63e5738e1b878150067385a9dcc7c8e586162
Showing with 69 additions and 64 deletions.
  1. +46 −40 libnet/smtpClient.ml
  2. +23 −24 opabsl/mlbsl/bslMail.ml
View
@@ -212,7 +212,8 @@ let analyze_error = Mailerror.parse_mailerror_error
let mail_send_aux ?client_certificate ?verify_params ?(secure=false) sched
?subject mfrom mdst ?mto mdata ?return_path ?html ?files ?custom_headers ?cte ?charset nb_attempt ?(port=25) cont () =
- let mto = match mto with
+ let mto =
+ match mto with
| Some tos -> tos
| None -> mdst in
let wait_and_retry x k = ignore(Scheduler.sleep sched x k) in
@@ -241,51 +242,56 @@ let mail_send_aux ?client_certificate ?verify_params ?(secure=false) sched
| dst_ip :: mx_servers as ips ->
let tools = {
SCC.log = _log " " ;
- elog = _log "-" ;
- k = (function
- | SCC.Error_MX -> try_mx mail (pred attempt) ~ip_list:mx_servers cont
- | SCC.Error msg ->
- ( prerr_endline ("ERROR: " ^ msg) ;
- try
- let _pos, res = analyze_error msg in
- match res with
- | Mailerror.GreylistedSec x ->
- let x = if x < 90 then 90 else x in
- Logger.debug "::: greylisted (%d secs)" x;
- wait_and_retry (Time.seconds x) (fun () -> try_mx mail (pred attempt) ~ip_list:ips cont)
- | Mailerror.GreylistedMin x ->
- Logger.debug "::: greylisted (%d mins)" x;
- let x = x * 60 in
- wait_and_retry (Time.seconds x) (fun () -> try_mx mail (pred attempt) ~ip_list:ips cont)
- | Mailerror.Add_cc s ->
- let new_mail = { mail with SCC.body = Printf.sprintf "Cc: %s\r\n%s" s mail.SCC.body } in
- wait_and_retry (Time.seconds 1) (fun () -> try_mx new_mail (pred attempt) ~ip_list:ips cont)
- | _ when fst (read_code msg) = 451 ->
- let x = 60 * attempt * attempt in
- Logger.debug "::: waiting (%d sec)" x;
- wait_and_retry (Time.seconds x) (fun () -> try_mx mail (pred attempt) ~ip_list:ips cont)
- | _ -> cont (SCC.Error msg)
- with Not_found | Failure _ | Trx_runtime.SyntaxError _ -> cont (SCC.Error msg))
- | res -> cont res) ;
+ SCC.elog = _log "-" ;
+ SCC.k = (function
+ | SCC.Error_MX -> try_mx mail (pred attempt) ~ip_list:mx_servers cont
+ | SCC.Error msg ->
+ ( prerr_endline ("ERROR: " ^ msg) ;
+ try
+ let _pos, res = analyze_error msg in
+ match res with
+ | Mailerror.GreylistedSec x ->
+ let x = if x < 90 then 90 else x in
+ Logger.debug "::: greylisted (%d secs)" x;
+ wait_and_retry (Time.seconds x) (fun () -> try_mx mail (pred attempt) ~ip_list:ips cont)
+ | Mailerror.GreylistedMin x ->
+ Logger.debug "::: greylisted (%d mins)" x;
+ let x = x * 60 in
+ wait_and_retry (Time.seconds x) (fun () -> try_mx mail (pred attempt) ~ip_list:ips cont)
+ | Mailerror.Add_cc s ->
+ let new_mail = { mail with SCC.body = Printf.sprintf "Cc: %s\r\n%s" s mail.SCC.body } in
+ wait_and_retry (Time.seconds 1) (fun () -> try_mx new_mail (pred attempt) ~ip_list:ips cont)
+ | _ when fst (read_code msg) = 451 ->
+ let x = 60 * attempt * attempt in
+ Logger.debug "::: waiting (%d sec)" x;
+ wait_and_retry (Time.seconds x) (fun () -> try_mx mail (pred attempt) ~ip_list:ips cont)
+ | _ -> cont (SCC.Error msg)
+ with Not_found | Failure _ | Trx_runtime.SyntaxError _ -> cont (SCC.Error msg))
+ | res -> cont res) ;
+ } in
+ let client = {
+ SCC.runtime = {
+ SCC.rt_plim = 128;
+ SCC.rt_proto = {
+ SCC.rt_name = "";
+ rt_addr = "";
+ rt_port = 0;
+ rt_secure_mode = Network.Unsecured;
+ rt_block_size = 4096;
+ rt_backtrace = true;
+ rt_server_write_timeout = Time.hours 2;
+ rt_payload = ();
+ };
+ };
+ SCC.err_cont = None;
+ SCC.extra_params = (mail,domain_from,tools)
} in
- let client = { SCC.runtime = { SCC.rt_plim = 128; rt_proto = { SCC.rt_name = "";
- rt_addr = "";
- rt_port = 0;
- rt_secure_mode = Network.Unsecured;
- rt_block_size = 4096;
- rt_backtrace = true;
- rt_server_write_timeout = Time.hours 2;
- rt_payload = ();
- }; };
- err_cont = None;
- extra_params = (mail,domain_from,tools) } in
let dst_string = Network.string_of_ipv4 dst_ip in
let secure_mode =
if secure
then Network.Secured (client_certificate, verify_params)
else Network.Unsecured
- in
- SCC.connect client ~secure_mode sched dst_string port
+ in SCC.connect client ~secure_mode sched dst_string port
in try_mx mail nb_attempt cont
let mail_send ?client_certificate ?verify_params ?secure sched
View
@@ -15,10 +15,8 @@
You should have received a copy of the GNU Affero General Public License
along with OPA. If not, see <http://www.gnu.org/licenses/>.
*)
-##module mailserve
- (* ##register valid_email : string -> bool *)
- (* let valid_email = SmtpClient.valid_email *)
+##module mailserve
let status_ok = ServerLib.static_field_of_name "ok"
let status_bad_sender = ServerLib.static_field_of_name "bad_sender"
@@ -46,7 +44,7 @@
ServerLib.make_record rc
| SmtpClientCore.Error_MX ->
let rc = ServerLib.empty_record_constructor in
- let rc = ServerLib.add_field rc status_error (ServerLib.wrap_string "Error Mx") in
+ let rc = ServerLib.add_field rc status_error (ServerLib.wrap_string "Error MX") in
ServerLib.make_record rc
| SmtpClientCore.Delayed i ->
let rc = ServerLib.empty_record_constructor in
@@ -64,25 +62,26 @@
##module mailserver
-##register init_server : int, string, SSL.secure_type, \
- (opa[string], opa[list(string)], opa[string] -> opa[tuple_2(int, string)]) -> void
-let init_server port addr secure_type handler =
- let ssl_certificate,ssl_verify_params=secure_type in
- let caml_handler email =
- let f = ServerLib.wrap_string email.SmtpServerCore.from in
- let c = Rcontent.get_content email.SmtpServerCore.body in
- let c = ServerLib.wrap_string c in
- let t = BslNativeLib.caml_list_to_opa_list ServerLib.wrap_string email.SmtpServerCore.dests in
- let res = handler f t c in
- let i, s = BslNativeLib.ocaml_tuple_2 res in
- ServerLib.unwrap_int i, ServerLib.unwrap_string s
- in
- Runtime.add_smtpServer "name" {SmtpServer.default_options with
- SmtpServer.opt_addr = addr;
- SmtpServer.opt_port = port;
- SmtpServer.opt_ssl_certificate = ssl_certificate;
- SmtpServer.opt_ssl_verify_params = ssl_verify_params;
- SmtpServer.opt_email_handler = caml_handler;
- }
+ ##register init_server : int, string, SSL.secure_type, \
+ (opa[string], opa[list(string)], opa[string] -> opa[tuple_2(int, string)]) -> void
+ let init_server port addr secure_type handler =
+ let ssl_certificate, ssl_verify_params = secure_type in
+ let caml_handler email =
+ let f = ServerLib.wrap_string email.SmtpServerCore.from in
+ let c = Rcontent.get_content email.SmtpServerCore.body in
+ let c = ServerLib.wrap_string c in
+ let t = BslNativeLib.caml_list_to_opa_list ServerLib.wrap_string email.SmtpServerCore.dests in
+ let res = handler f t c in
+ let i, s = BslNativeLib.ocaml_tuple_2 res in
+ ServerLib.unwrap_int i, ServerLib.unwrap_string s
+ in
+ Runtime.add_smtpServer "smtpServer" {
+ SmtpServer.default_options with
+ SmtpServer.opt_addr = addr;
+ SmtpServer.opt_port = port;
+ SmtpServer.opt_ssl_certificate = ssl_certificate;
+ SmtpServer.opt_ssl_verify_params = ssl_verify_params;
+ SmtpServer.opt_email_handler = caml_handler;
+ }
##endmodule

0 comments on commit 70d63e5

Please sign in to comment.