smtpClientCore.proto

% -*-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 }}