Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
tree: e52bd65cf4
Fetching contributors…

Cannot retrieve contributors at this time

209 lines (190 sloc) 6.297 kb
% -*-erlang-*-
%
% Copyright © 2011 MLstate
%
% This file is part of OPA.
%
% OPA is free software: you can redistribute it and/or modify it under the
% terms of the GNU Affero General Public License, version 3, as published by
% the Free Software Foundation.
%
% OPA is distributed in the hope that it will be useful, but WITHOUT ANY
% WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
% FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
% more details.
%
% You should have received a copy of the GNU Affero General Public License
% along with OPA. If not, see <http://www.gnu.org/licenses/>.
%
-generate client
-debugvar PROTOCOL_DEBUG
-protocol SMTP
-open Printf
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Les types %%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-type email = { from : string ; dests : string list ; body : string }
-type result =
| Ok
| Error of string
| Error_MX
| Delayed of int
| Bad_Sender
| Bad_Recipient
-type cont = result -> unit
-type imports = {
log : int -> string -> unit ;
elog : int -> string -> unit ;
k : cont
}
-type payload = unit
-include "libnet/rt_proto.proto"
%-type rt_proto = {
% rt_block_size : int;
% rt_backtrace : bool;
% rt_server_write_timeout : Time.t;
%}
-type runtime = {
rt_plim : int;
rt_proto : rt_proto;
}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Messages envoyés/reçus %%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-define (Ehlo host) = "EHLO " host "\r\n"
-define (Helo host) = "HELO " host "\r\n"
-define (From str) = "MAIL FROM:<" str ">\r\n"
-define (To str) = "RCPT TO:<" str ">\r\n"
-define Data = "DATA\r\n"
-define Dot = ".\r\n"
-define EndData = "\r\n.\r\n"
-define Quit = "QUIT\r\n"
-define (ENs (num : int, str)) = num "-" str "\r\n"
-define (Ns (num : int, str)) = num " " str "\r\n"
-define RawInput str = str
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% L'automate %%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+ehlo(mail : email, domain, tools : imports):
debug {{ Printexc.record_backtrace true }}
debug {{ eprintf "smtpClientCore: from=%s to=%s\n" mail.from (String.concat ", " mail.dests) }}
receive
| ENs (220, _msg) ->
debug {{ eprintf "ehlo received ENs: %d %s\n" 220 _msg }}
ehlo(mail, domain, tools)
| Ns (220, _msg) ->
debug {{ eprintf "received Ns: %d %s\n" 220 _msg }}
send (Ehlo domain);
from(mail, tools)
| ENs (a, b) ->
debug {{ eprintf "received ENs(error): %d %s\n" a b }}
{{ tools.elog a b }}
finish_error(tools)
| Ns (a, b) ->
debug {{ eprintf "received Ns(error): %d %s\n" a b }}
{{ tools.log a b }}
handle_error(tools, a, b)
| err ->
debug {{ eprintf "received err: %s\n" (string_of_msg err) }}
error({{ string_of_msg err }}, tools)
catch
| exn ->
{{ eprintf "SmtpClientCore.ehlo: 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) ->
debug {{ eprintf "finish_error received ENs: %d %s\n" code _msg }}
{{ tools.elog code _msg }}
finish_error(tools)
| Ns (code, _msg) ->
{{ tools.log code _msg }}
handle_error(tools, code, _msg)
| err ->
debug {{ eprintf "received err: %s\n" (string_of_msg err) }}
error({{ string_of_msg err }}, tools)
catch
| exn ->
{{ eprintf "SmtpClientCore.finish_error: exn=%s\n" (Printexc.to_string exn) }}
debug {{ Printexc.print_backtrace stderr; Pervasives.flush stderr }}
{{ tools.k Error_MX }}
from(mail, tools):
receive
| ENs (250, _) -> from(mail, tools)
| Ns (250, _) ->
send (From mail.from);
to(mail, tools)
| ENs (a, b) ->
debug {{ eprintf "from received ENs: %d %s\n" a b }}
{{ tools.elog a b }} finish_error(tools)
| Ns (a, b) -> {{ tools.log a b }} handle_error(tools, a, b)
| err -> error({{ string_of_msg err }}, tools)
catch
| _ -> {{ tools.k Error_MX }}
to(mail, tools):
receive
| ENs (250, _) -> to(mail, tools)
| Ns (250, _) ->
if {{ List.is_empty mail.dests }} then
send Data;
data(mail, tools)
else
send (To (List.hd mail.dests));
let new_mail = {{ { mail with dests = List.tl mail.dests } }}
to(new_mail, tools)
| ENs (a, b) ->
debug {{ eprintf "to received ENs: %d %s\n" a b }}
{{ tools.elog a b }} finish_error(tools)
| Ns (a, b) -> {{ tools.log a b }} handle_error(tools, a, b)
| err -> error({{ string_of_msg err }}, tools)
catch
| _ -> {{ tools.k Error_MX }}
data(mail, tools):
receive
| Ns (354, _) ->
% TODO: more efficient than Str?
let dot_stuff = {{ Str.global_replace (Str.regexp_string "\r\n.") "\r\n.." mail.body }}
send (RawInput dot_stuff);
enddata(tools, {{ String.is_suffix "\r\n" dot_stuff }})
| ENs (a, b) ->
debug {{ eprintf "data received ENs: %d %s\n" a b }}
{{ tools.elog a b }} handle_error(tools, a,b)
| Ns (a, b) -> {{ tools.log a b }} handle_error(tools, a, b)
| err -> error({{ string_of_msg err }}, tools)
catch
| _ -> {{ tools.k Error_MX }}
enddata(tools, has_crlf):
if {{ has_crlf }}
then
send(Dot);
wait_for_ack(tools)
else
send(EndData);
wait_for_ack(tools)
wait_for_ack(tools):
receive
| Ns (250, _) ->
quit(tools)
| ENs (a, b) ->
debug {{ eprintf "wait_for_ack received ENs: %d %s\n" a b }}
{{ tools.elog a b }} finish_error(tools)
| Ns (a, b) ->
{{ tools.log a b }} handle_error(tools, a, b)
| err ->
error({{ string_of_msg err }}, tools)
catch
| _ -> {{ tools.k Error_MX }}
quit(tools):
send Quit; -!- {{ tools.k Ok }}
error(_msg : string, tools : imports):
debug {{ eprintf "error: %s\n" _msg; Pervasives.flush stderr }}
-!-
{{ Logger.error "Error: %s" _msg;
tools.k (Error _msg) }}
handle_error(tools, code, err):
debug {{ eprintf "handle_error: %s\n" err; Pervasives.flush stderr }}
if {{ code = 450 }} then
error(err, tools)
else
{{ tools.k Error_MX }}
Jump to Line
Something went wrong with that request. Please try again.