Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 209 lines (190 sloc) 6.297 kb
fccc685 Initial open-source release
MLstate authored
1 % -*-erlang-*-
2
3 %
4 % Copyright © 2011 MLstate
5 %
6 % This file is part of OPA.
7 %
8 % OPA is free software: you can redistribute it and/or modify it under the
9 % terms of the GNU Affero General Public License, version 3, as published by
10 % the Free Software Foundation.
11 %
12 % OPA is distributed in the hope that it will be useful, but WITHOUT ANY
13 % WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
14 % FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
15 % more details.
16 %
17 % You should have received a copy of the GNU Affero General Public License
18 % along with OPA. If not, see <http://www.gnu.org/licenses/>.
19 %
20 -generate client
21 -debugvar PROTOCOL_DEBUG
22 -protocol SMTP
23 -open Printf
24
25 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
26 %% Les types %%
27 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
28 -type email = { from : string ; dests : string list ; body : string }
29
30 -type result =
31 | Ok
32 | Error of string
33 | Error_MX
34 | Delayed of int
35 | Bad_Sender
36 | Bad_Recipient
37
38 -type cont = result -> unit
39
40 -type imports = {
41 log : int -> string -> unit ;
42 elog : int -> string -> unit ;
43 k : cont
44 }
45
46 -type payload = unit
47 -include "libnet/rt_proto.proto"
48 %-type rt_proto = {
49 % rt_block_size : int;
50 % rt_backtrace : bool;
51 % rt_server_write_timeout : Time.t;
52 %}
53
54 -type runtime = {
55 rt_plim : int;
56 rt_proto : rt_proto;
57 }
58
59 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
60 %% Messages envoyés/reçus %%
61 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
62 -define (Ehlo host) = "EHLO " host "\r\n"
63 -define (Helo host) = "HELO " host "\r\n"
64 -define (From str) = "MAIL FROM:<" str ">\r\n"
65 -define (To str) = "RCPT TO:<" str ">\r\n"
66 -define Data = "DATA\r\n"
67 -define Dot = ".\r\n"
68 -define EndData = "\r\n.\r\n"
69 -define Quit = "QUIT\r\n"
70 -define (ENs (num : int, str)) = num "-" str "\r\n"
71 -define (Ns (num : int, str)) = num " " str "\r\n"
72 -define RawInput str = str
73
74 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
75 %% L'automate %%
76 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
77 +ehlo(mail : email, domain, tools : imports):
78 debug {{ Printexc.record_backtrace true }}
79 debug {{ eprintf "smtpClientCore: from=%s to=%s\n" mail.from (String.concat ", " mail.dests) }}
80 receive
81 | ENs (220, _msg) ->
82 debug {{ eprintf "ehlo received ENs: %d %s\n" 220 _msg }}
83 ehlo(mail, domain, tools)
84 | Ns (220, _msg) ->
85 debug {{ eprintf "received Ns: %d %s\n" 220 _msg }}
86 send (Ehlo domain);
87 from(mail, tools)
88 | ENs (a, b) ->
89 debug {{ eprintf "received ENs(error): %d %s\n" a b }}
90 {{ tools.elog a b }}
91 finish_error(tools)
92 | Ns (a, b) ->
93 debug {{ eprintf "received Ns(error): %d %s\n" a b }}
94 {{ tools.log a b }}
95 handle_error(tools, a, b)
96 | err ->
97 debug {{ eprintf "received err: %s\n" (string_of_msg err) }}
98 error({{ string_of_msg err }}, tools)
99 catch
100 | exn ->
101 {{ eprintf "SmtpClientCore.ehlo: exn=%s\n" (Printexc.to_string exn) }}
102 debug {{ Printexc.print_backtrace stderr; Pervasives.flush stderr }}
103 {{ tools.k Error_MX }}
104
105 finish_error(tools : imports):
106 receive
107 | ENs (code, _msg) ->
108 debug {{ eprintf "finish_error received ENs: %d %s\n" code _msg }}
109 {{ tools.elog code _msg }}
110 finish_error(tools)
111 | Ns (code, _msg) ->
112 {{ tools.log code _msg }}
113 handle_error(tools, code, _msg)
114 | err ->
115 debug {{ eprintf "received err: %s\n" (string_of_msg err) }}
116 error({{ string_of_msg err }}, tools)
117 catch
118 | exn ->
119 {{ eprintf "SmtpClientCore.finish_error: exn=%s\n" (Printexc.to_string exn) }}
120 debug {{ Printexc.print_backtrace stderr; Pervasives.flush stderr }}
121 {{ tools.k Error_MX }}
122
123 from(mail, tools):
124 receive
125 | ENs (250, _) -> from(mail, tools)
126 | Ns (250, _) ->
127 send (From mail.from);
128 to(mail, tools)
129 | ENs (a, b) ->
130 debug {{ eprintf "from received ENs: %d %s\n" a b }}
131 {{ tools.elog a b }} finish_error(tools)
132 | Ns (a, b) -> {{ tools.log a b }} handle_error(tools, a, b)
133 | err -> error({{ string_of_msg err }}, tools)
134 catch
135 | _ -> {{ tools.k Error_MX }}
136
137 to(mail, tools):
138 receive
139 | ENs (250, _) -> to(mail, tools)
140 | Ns (250, _) ->
141 if {{ List.is_empty mail.dests }} then
142 send Data;
143 data(mail, tools)
144 else
145 send (To (List.hd mail.dests));
146 let new_mail = {{ { mail with dests = List.tl mail.dests } }}
147 to(new_mail, tools)
148 | ENs (a, b) ->
149 debug {{ eprintf "to received ENs: %d %s\n" a b }}
150 {{ tools.elog a b }} finish_error(tools)
151 | Ns (a, b) -> {{ tools.log a b }} handle_error(tools, a, b)
152 | err -> error({{ string_of_msg err }}, tools)
153 catch
154 | _ -> {{ tools.k Error_MX }}
155
156 data(mail, tools):
157 receive
158 | Ns (354, _) ->
159 % TODO: more efficient than Str?
160 let dot_stuff = {{ Str.global_replace (Str.regexp_string "\r\n.") "\r\n.." mail.body }}
161 send (RawInput dot_stuff);
162 enddata(tools, {{ String.is_suffix "\r\n" dot_stuff }})
163 | ENs (a, b) ->
164 debug {{ eprintf "data received ENs: %d %s\n" a b }}
165 {{ tools.elog a b }} handle_error(tools, a,b)
166 | Ns (a, b) -> {{ tools.log a b }} handle_error(tools, a, b)
167 | err -> error({{ string_of_msg err }}, tools)
168 catch
169 | _ -> {{ tools.k Error_MX }}
170
171 enddata(tools, has_crlf):
172 if {{ has_crlf }}
173 then
174 send(Dot);
175 wait_for_ack(tools)
176 else
177 send(EndData);
178 wait_for_ack(tools)
179
180 wait_for_ack(tools):
181 receive
182 | Ns (250, _) ->
183 quit(tools)
184 | ENs (a, b) ->
185 debug {{ eprintf "wait_for_ack received ENs: %d %s\n" a b }}
186 {{ tools.elog a b }} finish_error(tools)
187 | Ns (a, b) ->
188 {{ tools.log a b }} handle_error(tools, a, b)
189 | err ->
190 error({{ string_of_msg err }}, tools)
191 catch
192 | _ -> {{ tools.k Error_MX }}
193
194 quit(tools):
195 send Quit; -!- {{ tools.k Ok }}
196
197 error(_msg : string, tools : imports):
198 debug {{ eprintf "error: %s\n" _msg; Pervasives.flush stderr }}
199 -!-
200 {{ Logger.error "Error: %s" _msg;
201 tools.k (Error _msg) }}
202
203 handle_error(tools, code, err):
204 debug {{ eprintf "handle_error: %s\n" err; Pervasives.flush stderr }}
205 if {{ code = 450 }} then
206 error(err, tools)
207 else
208 {{ tools.k Error_MX }}
Something went wrong with that request. Please try again.