ADD module erlang 'smtp' permettant l'envoie d'emails
[euphorik.git] / modules / erl / smtp.erl
1 % -*- Erlang -*-
2 % File: smtp.erl (~jb/work/yaws/applications/mail/src/smtp.erl)
3 % Author: Johan Bevemyr
4 % Created: Tue Feb 24 23:15:59 2004
5 % Purpose:
6
7 -module('smtp').
8 -author('jb@bevemyr.com').
9
10 -export([send/6]).
11
12 %% Example
13
14 %
15 % smtp:send("mail.bevemyr.com", "jb@bevemyr.com",
16 % ["katrin@bevemyr.com","jb@bevemyr.com"],
17 % "Test Subject",
18 % "My Message", [{"file1.txt","text/plain","hej hopp igen"}]).
19 %
20
21
22 send(Server, From, To, Subject, Message, Attached) ->
23 {ok, Port} = smtp_init(Server, From, To),
24 Boundary="--Next_Part("++boundary_date()++")--",
25 CommonHeaders =
26 [mail_header("To: ", To),
27 mail_header("From: ", From),
28 mail_header("Subject: ", Subject)],
29 Headers = case Attached of
30 [] ->
31 [mail_header("Content-Type: ", "text/plain"),
32 mail_header("Content-Transfer-Encoding: ", "8bit")];
33 _ ->
34 [mail_header("Mime-Version: ", "1.0"),
35 mail_header("Content-Type: ",
36 "Multipart/Mixed;\r\n boundary=\""++
37 Boundary++"\""),
38 mail_header("Content-Transfer-Encoding: ", "8bit")]
39 end,
40 smtp_send_part(Port, [CommonHeaders, Headers, "\r\n"]),
41 case Attached of
42 [] ->
43 ok;
44 _ ->
45 smtp_send_part(Port, ["--",Boundary,"\r\n",
46 mail_header("Content-Type: ",
47 "Text/Plain; charset=us-ascii"),
48 mail_header("Content-Transfer-Encoding: ",
49 "8bit"),
50 "\r\n"])
51 end,
52 smtp_send_message(Port, Message),
53 case Attached of
54 [] ->
55 smtp_send_part(Port, ["\r\n.\r\n"]),
56 smtp_close(Port);
57 Files ->
58 smtp_send_attachments(Port, Boundary, Files),
59 smtp_send_part(Port, ["\r\n.\r\n"]),
60 smtp_close(Port)
61 end.
62
63
64 smtp_send_attachments(Port, Boundary, []) ->
65 smtp_send_part(Port, ["\r\n--",Boundary,"--\r\n"]);
66 smtp_send_attachments(Port, Boundary, [{FileName,ContentType,Data}|Rest]) ->
67 smtp_send_part(Port, ["\r\n--",Boundary,"\r\n",
68 mail_header("Content-Type: ", ContentType),
69 mail_header("Content-Transfer-Encoding: ",
70 "base64"),
71 mail_header("Content-Disposition: ",
72 "attachment; filename=\""++
73 FileName++"\""),
74 "\r\n"
75 ]),
76 smtp_send_b64(Port, Data),
77 smtp_send_attachments(Port, Boundary, Rest).
78
79
80 smtp_send_b64(Port, Data) ->
81 B64 = str2b64_final(Data),
82 gen_tcp:send(Port, B64).
83
84 boundary_date() ->
85 dat2str_boundary(calendar:local_time()).
86
87 dat2str_boundary({{Y, Mo, D}, {H, M, S}}) ->
88 lists:flatten(
89 io_lib:format("~s_~2.2.0w_~s_~w_~2.2.0w:~2.2.0w:~2.2.0w_~w",
90 [weekday(Y,Mo,D), D, int_to_mt(Mo),
91 Y,H,M,S,random:uniform(5000)])).
92
93
94 smtp_init(Server, From, Recipients) ->
95 {ok, Port} = gen_tcp:connect(Server, 25, [{active, false},
96 {reuseaddr,true},
97 binary]),
98 smtp_expect(220, Port, "SMTP server does not respond"),
99 smtp_put( smtp_from(From), Port ),
100 smtp_expect(250, Port, "Sender not accepted by mail server"),
101 send_recipients(Recipients, Port),
102 smtp_put("DATA", Port),
103 smtp_expect(354, Port, "Message not accepted by mail server."),
104 {ok, Port}.
105
106
107 smtp_close(Port) ->
108 smtp_put(".", Port),
109 smtp_expect(250, Port, "Message not accepted by mail server."),
110 gen_tcp:close(Port),
111 ok.
112
113 smtp_send_part(Port, Data) ->
114 gen_tcp:send(Port, Data).
115
116 smtp_send_message(Port, Data) ->
117 {_LastNL, Escaped} = dot_escape(Data, true),
118 gen_tcp:send(Port, Escaped).
119
120 send_recipients( Recipients, Port ) ->
121 Fun = fun (R) ->
122 smtp_put( smtp_recipient(R), Port),
123 smtp_expect(250, Port, io_lib:format("Recipient ~s not accepted.",[R]))
124 end,
125 lists:foreach( Fun, Recipients ).
126
127 smtp_put(Message, Port) ->
128 gen_tcp:send(Port, [Message,"\r\n"]).
129
130 smtp_expect(Code, Port, ErrorMsg) ->
131 smtp_expect(Code, Port, [], ErrorMsg).
132
133 smtp_expect(Code, Port, Acc, ErrorMsg) ->
134 Res = gen_tcp:recv(Port, 0, 15000),
135 case Res of
136 {ok, Bin} ->
137 NAcc = Acc++binary_to_list(Bin),
138 case string:chr(NAcc, $\n) of
139 0 ->
140 smtp_expect(Code, Port, NAcc, ErrorMsg);
141 _N ->
142 ResponseCode = to_int(NAcc),
143 if
144 ResponseCode == Code -> ok;
145 true -> throw({error, ErrorMsg})
146 end
147 end;
148 Err ->
149 throw({error, Err})
150 end.
151
152 %% add smtp from prelude. add <> around address (if needed)
153 smtp_from( Address ) ->
154 lists:append( "MAIL FROM: ", add_angle_brackets( Address ) ).
155
156 %% add smtp recipients prelude. add <> around address (if needed)
157 smtp_recipient( Address ) ->
158 lists:append( "RCPT TO: ", add_angle_brackets( Address ) ).
159
160 %% make sure the address has <> around itself
161 add_angle_brackets( Address ) ->
162 add_angle_bracket_start( add_angle_bracket_close(Address) ).
163
164 add_angle_bracket_start( [$<|T] ) -> [$<|T];
165 add_angle_bracket_start( Address ) -> [$<|Address].
166
167 %% add > at the end of address, if it is not present
168 add_angle_bracket_close( Address ) ->
169 case lists:reverse( Address ) of
170 [$>|_T] -> Address;
171 Reversed -> lists:reverse( [$>|Reversed] )
172 end.
173
174 %% Add an . at all lines starting with a dot.
175
176 dot_escape(Data, NL) ->
177 dot_escape(Data, NL, []).
178
179 dot_escape([], NL, Acc) ->
180 {NL, lists:reverse(Acc)};
181 dot_escape([$.|Rest], true, Acc) ->
182 dot_escape(Rest, false, [$.,$.|Acc]);
183 dot_escape([$\n|Rest], _, Acc) ->
184 dot_escape(Rest, true, [$\n|Acc]);
185 dot_escape([C|Rest], _, Acc) ->
186 dot_escape(Rest, false, [C|Acc]).
187
188 %%
189
190 %dot_unescape(Data) ->
191 % {_,Dt} = dot_unescape(Data, true, []),
192 % Dt.
193 %
194 %dot_unescape([], NL, Acc) ->
195 % {NL, lists:reverse(Acc)};
196 %dot_unescape([$.|Rest], true, Acc) ->
197 % dot_unescape(Rest, false, Acc);
198 %dot_unescape([$\n|Rest], _, Acc) ->
199 % dot_unescape(Rest, true, [$\n|Acc]);
200 %dot_unescape([L|Rest], NL, Acc) when list(L) ->
201 % {NL2, L2} = dot_unescape(L, NL, []),
202 % dot_unescape(Rest, NL2, [L2|Acc]);
203 %dot_unescape([C|Rest], _, Acc) ->
204 % dot_unescape(Rest, false, [C|Acc]).
205
206
207 %%
208
209 str2b64_final(String) ->
210 str2b64_final(String, []).
211
212
213 str2b64_final([], Acc) ->
214 lists:reverse(Acc);
215 str2b64_final(String, Acc) ->
216 case str2b64_line(String, []) of
217 {ok, Line, Rest} ->
218 str2b64_final(Rest, ["\n",Line|Acc]);
219 {more, Cont} ->
220 lists:reverse(["\n",str2b64_end(Cont)|Acc])
221 end.
222
223 %%
224
225 str2b64_line(S, []) -> str2b64_line(S, [], 0);
226 str2b64_line(S, {Rest,Acc,N}) -> str2b64_line(Rest ++ S, Acc, N).
227
228 str2b64_line(S, Out, 76) -> {ok,lists:reverse(Out),S};
229 str2b64_line([C1,C2,C3|S], Out, N) ->
230 O1 = e(C1 bsr 2),
231 O2 = e(((C1 band 16#03) bsl 4) bor (C2 bsr 4)),
232 O3 = e(((C2 band 16#0f) bsl 2) bor (C3 bsr 6)),
233 O4 = e(C3 band 16#3f),
234 str2b64_line(S, [O4,O3,O2,O1|Out], N+4);
235 str2b64_line(S, Out, N) ->
236 {more,{S,Out,N}}.
237
238 %%
239
240 str2b64_end({[C1,C2],Out,_N}) ->
241 O1 = e(C1 bsr 2),
242 O2 = e(((C1 band 16#03) bsl 4) bor (C2 bsr 4)),
243 O3 = e((C2 band 16#0f) bsl 2),
244 lists:reverse(Out, [O1,O2,O3,$=]);
245 str2b64_end({[C1],Out,_N}) ->
246 O1 = e(C1 bsr 2),
247 O2 = e((C1 band 16#03) bsl 4),
248 lists:reverse(Out, [O1,O2,$=,$=]);
249 str2b64_end({[],Out,_N}) -> lists:reverse(Out);
250 str2b64_end([]) -> [].
251
252 %%
253
254 e(X) when X >= 0, X < 26 -> X + $A;
255 e(X) when X >= 26, X < 52 -> X + $a - 26;
256 e(X) when X >= 52, X < 62 -> X + $0 - 52;
257 e(62) -> $+;
258 e(63) -> $/;
259 e(X) -> erlang:error({badchar,X}).
260
261
262 %%
263
264
265 weekday(Y,Mo,D) ->
266 int_to_wd(calendar:day_of_the_week(Y,Mo,D)).
267
268 int_to_wd(1) -> "Mon";
269 int_to_wd(2) -> "Tue";
270 int_to_wd(3) -> "Wed";
271 int_to_wd(4) -> "Thu";
272 int_to_wd(5) -> "Fri";
273 int_to_wd(6) -> "Sat";
274 int_to_wd(7) -> "Sun".
275
276 int_to_mt(1) -> "Jan";
277 int_to_mt(2) -> "Feb";
278 int_to_mt(3) -> "Mar";
279 int_to_mt(4) -> "Apr";
280 int_to_mt(5) -> "May";
281 int_to_mt(6) -> "Jun";
282 int_to_mt(7) -> "Jul";
283 int_to_mt(8) -> "Aug";
284 int_to_mt(9) -> "Sep";
285 int_to_mt(10) -> "Oct";
286 int_to_mt(11) -> "Nov";
287 int_to_mt(12) -> "Dec".
288
289 %%
290
291 mail_header(_Key, []) -> [];
292 mail_header(Key, Val) -> Key++Val++"\r\n".
293
294 %%
295
296 to_int(Str) ->
297 to_int(Str, 0).
298
299 to_int([D|Ds], Acc) when D >= $0, D =< $9->
300 to_int(Ds, Acc*10+D-$0);
301 to_int(_, Acc) -> Acc.
302
303 %%
304