Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

[feature] smtpClient: Added plain authentication to smtpClient. Updat…

…ed to optionally use nominated server instead of MX from to header.
  • Loading branch information...
commit 03afae5ab92b9628262b025452b2871d0acb15a9 1 parent 84f98f6
@nrs135 nrs135 authored Aqua-Ye committed
View
23 libnet/smtpClient.ml
@@ -236,7 +236,8 @@ let read_code s =
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) ?via cont () =
+ ?subject mfrom mdst ?mto mdata ?return_path ?html ?files ?custom_headers ?cte ?charset nb_attempt ?(port=25)
+ ?via ?addr ?auth ?user ?pass cont () =
let mto =
match mto with
| Some tos -> tos
@@ -250,12 +251,24 @@ let mail_send_aux ?client_certificate ?verify_params ?(secure=false) sched
| None,_ -> cont SCC.Bad_Sender
| _,None -> cont SCC.Bad_Recipient
| (Some (_,domain_from)),(Some (_,dst)) ->
- let mail = { SCC.from = simple_mail mfrom ; dests = [mdst] ; body = mdata } in
+ let mail = { SCC.from = simple_mail mfrom;
+ dests = [mdst];
+ body = mdata;
+ auth = Option.default "" auth; user = Option.default "" user; pass = Option.default "" pass;
+ }
+ in
let rec try_mx mail attempt ?ip_list cont =
let ip_list =
match ip_list with
| Some list -> list
- | None -> resolve_mx dst in
+ | None ->
+ (match addr with
+ | Some dst ->
+ (match resolve_UNIX dst with
+ | Some ip -> [ip]
+ | None -> [])
+ | None -> resolve_mx dst)
+ in
match ip_list with
| [] ->
if attempt < 0 then
@@ -323,7 +336,7 @@ let mail_send_aux ?client_certificate ?verify_params ?(secure=false) sched
let mail_send ?client_certificate ?verify_params ?secure sched
?subject mfrom mdst ?mto mdata ?return_path ?html ?files ?cte ?charset nb_attempt
- ?port cont () =
+ ?port ?via ?addr ?auth ?user ?pass cont () =
let files = match files with
| Some l ->
let res =
@@ -335,5 +348,5 @@ let mail_send ?client_certificate ?verify_params ?secure sched
| None -> None in
mail_send_aux ?client_certificate ?verify_params ?secure sched
?subject mfrom mdst ?mto mdata ?return_path ?html ?files ?cte ?charset nb_attempt
- ?port cont ()
+ ?port ?via ?addr ?auth ?user ?pass cont ()
View
48 libnet/smtpClientCore.proto
@@ -25,7 +25,14 @@
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Les types %%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
--type email = { from : string ; dests : string list ; body : string }
+-type email = {
+ from : string;
+ dests : string list;
+ body : string;
+ auth : string;
+ user : string;
+ pass : string
+}
-type result =
| Ok
@@ -56,9 +63,15 @@
rt_proto : rt_proto;
}
+{{
+let encode_plain user pass = String.base64encode(sprintf "\000%s\000%s" user pass)
+}}
+
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Messages envoyés/reçus %%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+-define (AuthPlain userpass) = "AUTH PLAIN " userpass "\r\n"
+-define (AuthLogin user) = "AUTH LOGIN " user "\r\n"
-define (Ehlo host) = "EHLO " host "\r\n"
-define (Helo host) = "HELO " host "\r\n"
-define (From str) = "MAIL FROM:<" str ">\r\n"
@@ -83,8 +96,12 @@
ehlo(mail, domain, tools)
| Ns (220, _msg) ->
debug {{ eprintf "received Ns: %d %s\n" 220 _msg }}
- send (Ehlo domain);
- from(mail, tools)
+ if {{ mail.auth = "plain" }}
+ then
+ auth_plain(mail, domain, tools)
+ else
+ send (Ehlo domain);
+ from(mail, tools)
| ENs (a, b) ->
debug {{ eprintf "received ENs(error): %d %s\n" a b }}
{{ tools.elog a b }}
@@ -102,6 +119,31 @@
debug {{ Printexc.print_backtrace stderr; Pervasives.flush stderr }}
{{ tools.k Error_MX }}
+auth_plain(mail, domain, tools):
+ %debug {{ eprintf "auth plain: %s\n%!" (encode_plain mail.user mail.pass)}}
+ send(AuthPlain (encode_plain mail.user mail.pass));
+ receive
+ | Ns (235, _msg) ->
+ debug {{ eprintf "auth_plain received Ns: %d %s\n" 235 _msg }}
+ send (Ehlo domain);
+ from(mail, tools)
+ | ENs (a, b) ->
+ debug {{ eprintf "auth_plain received ENs(error): %d %s\n" a b }}
+ {{ tools.elog a b }}
+ finish_error(tools)
+ | Ns (a, b) ->
+ debug {{ eprintf "auth_plain received Ns(error): %d %s\n" a b }}
+ {{ tools.log a b }}
+ handle_error(tools, a, b)
+ | err ->
+ debug {{ eprintf "auth_plain received err: %s\n" (string_of_msg err) }}
+ error({{ string_of_msg err }}, tools)
+ catch
+ | exn ->
+ {{ eprintf "SmtpClientCore.auth_plain: exn=%s\n" (Printexc.to_string exn) }}
+ debug {{ Printexc.print_backtrace stderr; Pervasives.flush stderr }}
+ {{ tools.k Error_MX }}
+
finish_error(tools : imports):
receive
| ENs (code, _msg) ->
View
44 opabsl/mlbsl/bslMail.ml
@@ -25,13 +25,14 @@
##opa-type Email.send_status
- ##register [cps-bypass] mail_send_fun : string, string, string, string, string, string, string,\
+ ##register [cps-bypass] mail_send_fun : string, string, string, string, string, string, string, \
caml_list(caml_tuple_4(string,string,string,string)), \
caml_list(caml_tuple_2(string,string)), \
- option(string), \
+ option(string), option(string), option(string), option(string), option(string), \
(opa[email_send_status], continuation(opa[void]) -> void), \
continuation(opa[void]) -> void
- let mail_send_fun mfrom mfrom_address_only mdst mto subject mdata html files custom_headers via cont k =
+ let mail_send_fun mfrom mfrom_address_only mdst mto subject mdata html files custom_headers
+ via addr auth user pass cont k =
let cont = BslUtils.proj_cps k cont in
let cont x =
let res =
@@ -55,7 +56,42 @@
in
let html = if html = "" then None else Some html
and mto = if mto = "" then None else Some mto in
- SmtpClient.mail_send_aux BslScheduler.opa ~charset:"UTF-8" ~subject mfrom mdst ?mto:mto mdata ?html:html ~files ~custom_headers ~return_path:mfrom_address_only 10 ?via:via cont ();
+ SmtpClient.mail_send_aux BslScheduler.opa ~charset:"UTF-8" ~subject mfrom mdst ?mto:mto mdata ?html:html ~files ~custom_headers ~return_path:mfrom_address_only 10 ?via:via ?addr:addr ?auth:auth ?user:user ?pass:pass cont ();
+ QmlCpsServerLib.return k ServerLib.void
+
+ ##register [cps-bypass] mail_send_fun_secure : string, string, string, string, string, string, string, \
+ caml_list(caml_tuple_4(string,string,string,string)), \
+ caml_list(caml_tuple_2(string,string)), \
+ option(string), option(string), option(int), option(string), option(string), option(string), SSL.secure_type, \
+ (opa[email_send_status], continuation(opa[void]) -> void), \
+ continuation(opa[void]) -> void
+ let mail_send_fun_secure mfrom mfrom_address_only mdst mto subject mdata html files custom_headers
+ via addr port auth user pass secure_type cont k =
+ let cont = BslUtils.proj_cps k cont in
+ let cont x =
+ let res =
+ match x with
+ | SmtpClientCore.Ok -> ServerLib.make_simple_record status_ok
+ | SmtpClientCore.Bad_Sender -> ServerLib.make_simple_record status_bad_sender
+ | SmtpClientCore.Bad_Recipient -> ServerLib.make_simple_record status_bad_recipient
+ | SmtpClientCore.Error err ->
+ let rc = ServerLib.empty_record_constructor in
+ let rc = ServerLib.add_field rc status_error (ServerLib.wrap_string err) in
+ 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
+ ServerLib.make_record rc
+ | SmtpClientCore.Delayed i ->
+ let rc = ServerLib.empty_record_constructor in
+ let rc = ServerLib.add_field rc status_error (ServerLib.wrap_string ("Delayed "^(string_of_int i))) in
+ ServerLib.make_record rc
+ in cont (wrap_opa_email_send_status res)
+ in
+ let html = if html = "" then None else Some html
+ and mto = if mto = "" then None else Some mto in
+ let client_certificate, verify_params = secure_type in
+ SmtpClient.mail_send_aux ?client_certificate ?verify_params ~secure:true BslScheduler.opa ~charset:"UTF-8" ~subject mfrom mdst ?mto:mto mdata ?html:html ~files ~custom_headers ~return_path:mfrom_address_only 10 ?port:port ?via:via ?addr:addr ?auth:auth ?user:user ?pass:pass cont ();
QmlCpsServerLib.return k ServerLib.void
##endmodule
View
34 stdlib/web/mail/email.opa
@@ -97,6 +97,12 @@ type Email.options = {
custom_headers : list((string, string))
files : Email.attachments
via : option(string)
+ server_addr : option(string)
+ server_port : option(int)
+ auth : option(string)
+ user : option(string)
+ pass : option(string)
+ secure_type : option(SSL.secure_type)
}
type Email.imap_command =
@@ -127,6 +133,12 @@ Email = {{
custom_headers = []
files = []
via = none
+ server_addr = none
+ server_port = none
+ auth = none
+ user = none
+ pass = none
+ secure_type = none
} : Email.options
/**
@@ -271,7 +283,10 @@ Email = {{
aux(List.rev(l),%%BslNativeLib.empty_list%%)
@private
- send_mail = %% BslMail.Mailserve.mail_send_fun %% : string , string, string , string , string , string, string, caml_list(caml_tuple_4(string,string,string,string)), caml_list(caml_tuple_2(string, string)), option(string), (Email.send_status -> void) -> void
+ send_mail = %% BslMail.Mailserve.mail_send_fun %% : string , string, string , string , string , string, string, caml_list(caml_tuple_4(string,string,string,string)), caml_list(caml_tuple_2(string, string)), option(string), option(string), option(string), option(string), option(string), (Email.send_status -> void) -> void
+
+ @private
+ send_mail_secure = %% BslMail.Mailserve.mail_send_fun_secure %% : string , string, string , string , string , string, string, caml_list(caml_tuple_4(string,string,string,string)), caml_list(caml_tuple_2(string, string)), option(string), option(string), option(int), option(string), option(string), option(string), SSL.secure_type, (Email.send_status -> void) -> void
@private
send_async(
@@ -316,10 +331,19 @@ Email = {{
if i == 0 then to_string(e)
else acc ^ ", " ^ to_string(e)
, options.to, "")
- send_mail(
- to_string(from), to_string_only_address(from), to_string_only_address(to), mto,
- subject, text, html, files, custom_headers, options.via, k
- )
+ match options.secure_type with
+ | {some=secure_type} ->
+ send_mail_secure(
+ to_string(from), to_string_only_address(from), to_string_only_address(to), mto,
+ subject, text, html, files, custom_headers,
+ options.via, options.server_addr, options.server_port, options.auth, options.user, options.pass, secure_type, k
+ )
+ | {none} ->
+ send_mail(
+ to_string(from), to_string_only_address(from), to_string_only_address(to), mto,
+ subject, text, html, files, custom_headers,
+ options.via, options.server_addr, options.auth, options.user, options.pass, k
+ )
/**
* Try to send a mail {b synchronously}
Please sign in to comment.
Something went wrong with that request. Please try again.