ADD module erlang 'smtp' permettant l'envoie d'emails
authorGreg Burri <greg.burri@gmail.com>
Thu, 31 Jul 2008 16:41:48 +0000 (16:41 +0000)
committerGreg Burri <greg.burri@gmail.com>
Thu, 31 Jul 2008 16:41:48 +0000 (16:41 +0000)
modules/erl/smtp.erl [new file with mode: 0644]

diff --git a/modules/erl/smtp.erl b/modules/erl/smtp.erl
new file mode 100644 (file)
index 0000000..00a3721
--- /dev/null
@@ -0,0 +1,304 @@
+%    -*- Erlang -*- \r
+%    File:     smtp.erl  (~jb/work/yaws/applications/mail/src/smtp.erl)\r
+%    Author:   Johan Bevemyr\r
+%    Created:  Tue Feb 24 23:15:59 2004\r
+%    Purpose:   \r
+\r
+-module('smtp').\r
+-author('jb@bevemyr.com').\r
+\r
+-export([send/6]).\r
+\r
+%% Example\r
+\r
+%\r
+% smtp:send("mail.bevemyr.com", "jb@bevemyr.com", \r
+%         ["katrin@bevemyr.com","jb@bevemyr.com"],\r
+%         "Test Subject",\r
+%         "My Message", [{"file1.txt","text/plain","hej hopp igen"}]).\r
+%\r
+\r
+\r
+send(Server, From, To, Subject, Message, Attached) ->\r
+    {ok, Port} = smtp_init(Server, From, To),\r
+    Boundary="--Next_Part("++boundary_date()++")--",\r
+    CommonHeaders = \r
+       [mail_header("To: ", To),\r
+        mail_header("From: ", From),\r
+        mail_header("Subject: ", Subject)],\r
+    Headers = case Attached of\r
+                 [] ->\r
+                     [mail_header("Content-Type: ", "text/plain"),\r
+                      mail_header("Content-Transfer-Encoding: ", "8bit")];\r
+                 _ ->\r
+                     [mail_header("Mime-Version: ", "1.0"),\r
+                      mail_header("Content-Type: ",\r
+                                  "Multipart/Mixed;\r\n boundary=\""++\r
+                                  Boundary++"\""),\r
+                      mail_header("Content-Transfer-Encoding: ", "8bit")]\r
+             end,\r
+    smtp_send_part(Port, [CommonHeaders, Headers, "\r\n"]),\r
+    case Attached of\r
+       [] ->\r
+           ok;\r
+       _ ->\r
+           smtp_send_part(Port, ["--",Boundary,"\r\n",\r
+                                 mail_header("Content-Type: ",\r
+                                             "Text/Plain; charset=us-ascii"),\r
+                                 mail_header("Content-Transfer-Encoding: ",\r
+                                             "8bit"),\r
+                                 "\r\n"])\r
+    end,\r
+    smtp_send_message(Port, Message),\r
+    case Attached of\r
+       [] ->\r
+           smtp_send_part(Port, ["\r\n.\r\n"]),\r
+           smtp_close(Port);\r
+       Files ->\r
+           smtp_send_attachments(Port, Boundary, Files),\r
+           smtp_send_part(Port, ["\r\n.\r\n"]),\r
+           smtp_close(Port)\r
+    end.\r
+\r
+\r
+smtp_send_attachments(Port, Boundary, []) ->\r
+    smtp_send_part(Port, ["\r\n--",Boundary,"--\r\n"]);\r
+smtp_send_attachments(Port, Boundary, [{FileName,ContentType,Data}|Rest]) ->\r
+    smtp_send_part(Port, ["\r\n--",Boundary,"\r\n",\r
+                         mail_header("Content-Type: ", ContentType),\r
+                         mail_header("Content-Transfer-Encoding: ",\r
+                                     "base64"),\r
+                         mail_header("Content-Disposition: ",\r
+                                     "attachment; filename=\""++\r
+                                     FileName++"\""),\r
+                         "\r\n"\r
+                        ]),\r
+    smtp_send_b64(Port, Data),\r
+    smtp_send_attachments(Port, Boundary, Rest).\r
+\r
+\r
+smtp_send_b64(Port, Data) ->\r
+    B64 = str2b64_final(Data),\r
+    gen_tcp:send(Port, B64).\r
+\r
+boundary_date() ->\r
+    dat2str_boundary(calendar:local_time()).\r
+\r
+dat2str_boundary({{Y, Mo, D}, {H, M, S}}) ->\r
+    lists:flatten(\r
+      io_lib:format("~s_~2.2.0w_~s_~w_~2.2.0w:~2.2.0w:~2.2.0w_~w",\r
+                   [weekday(Y,Mo,D), D, int_to_mt(Mo),\r
+                    Y,H,M,S,random:uniform(5000)])).\r
+\r
+\r
+smtp_init(Server, From, Recipients) ->\r
+    {ok, Port} = gen_tcp:connect(Server, 25, [{active, false},\r
+                                             {reuseaddr,true},\r
+                                             binary]),\r
+    smtp_expect(220, Port, "SMTP server does not respond"),\r
+    smtp_put( smtp_from(From), Port ),\r
+    smtp_expect(250, Port, "Sender not accepted by mail server"),\r
+    send_recipients(Recipients, Port),\r
+    smtp_put("DATA", Port),\r
+    smtp_expect(354, Port, "Message not accepted by mail server."),\r
+    {ok, Port}.\r
+\r
+\r
+smtp_close(Port) ->\r
+    smtp_put(".", Port),\r
+    smtp_expect(250, Port, "Message not accepted by mail server."),\r
+    gen_tcp:close(Port),\r
+    ok.\r
+\r
+smtp_send_part(Port, Data) ->\r
+    gen_tcp:send(Port, Data).\r
+\r
+smtp_send_message(Port, Data) ->\r
+    {_LastNL, Escaped} = dot_escape(Data, true),\r
+    gen_tcp:send(Port, Escaped).\r
+\r
+send_recipients( Recipients, Port ) ->\r
+       Fun = fun (R) ->\r
+                       smtp_put( smtp_recipient(R), Port),\r
+                       smtp_expect(250, Port, io_lib:format("Recipient ~s not accepted.",[R]))\r
+               end,\r
+       lists:foreach( Fun, Recipients ).\r
+\r
+smtp_put(Message, Port) ->\r
+    gen_tcp:send(Port, [Message,"\r\n"]).\r
+\r
+smtp_expect(Code, Port, ErrorMsg) ->\r
+    smtp_expect(Code, Port, [], ErrorMsg).\r
+\r
+smtp_expect(Code, Port, Acc, ErrorMsg) ->\r
+    Res = gen_tcp:recv(Port, 0, 15000),\r
+    case Res of\r
+       {ok, Bin} ->\r
+           NAcc = Acc++binary_to_list(Bin),\r
+           case string:chr(NAcc, $\n) of\r
+               0 ->\r
+                   smtp_expect(Code, Port, NAcc, ErrorMsg);\r
+               _N ->\r
+                   ResponseCode = to_int(NAcc),\r
+                   if \r
+                       ResponseCode == Code -> ok;\r
+                       true -> throw({error, ErrorMsg})\r
+                   end\r
+           end;\r
+       Err ->\r
+           throw({error, Err})\r
+    end.\r
+\r
+%% add smtp from prelude. add <> around address (if needed)\r
+smtp_from( Address ) ->\r
+       lists:append( "MAIL FROM: ", add_angle_brackets( Address ) ).\r
+\r
+%% add smtp recipients prelude. add <> around address (if needed)\r
+smtp_recipient( Address ) ->\r
+       lists:append( "RCPT TO: ", add_angle_brackets( Address ) ).\r
+\r
+%% make sure the address has <> around itself\r
+add_angle_brackets( Address ) ->\r
+       add_angle_bracket_start( add_angle_bracket_close(Address) ).\r
+\r
+add_angle_bracket_start( [$<|T] ) -> [$<|T];\r
+add_angle_bracket_start( Address ) -> [$<|Address].\r
+\r
+%% add > at the end of address, if it is not present\r
+add_angle_bracket_close( Address ) ->\r
+       case lists:reverse( Address ) of\r
+       [$>|_T] -> Address;\r
+       Reversed -> lists:reverse( [$>|Reversed] )\r
+       end.\r
+\r
+%% Add an . at all lines starting with a dot.\r
+\r
+dot_escape(Data, NL) ->\r
+    dot_escape(Data, NL, []).\r
+\r
+dot_escape([], NL, Acc) ->\r
+    {NL, lists:reverse(Acc)};\r
+dot_escape([$.|Rest], true, Acc) ->\r
+    dot_escape(Rest, false, [$.,$.|Acc]);\r
+dot_escape([$\n|Rest], _, Acc) ->\r
+    dot_escape(Rest, true, [$\n|Acc]);\r
+dot_escape([C|Rest], _, Acc) ->    \r
+    dot_escape(Rest, false, [C|Acc]).\r
+\r
+%%\r
+\r
+%dot_unescape(Data) ->\r
+%    {_,Dt} = dot_unescape(Data, true, []),\r
+%    Dt.\r
+%\r
+%dot_unescape([], NL, Acc) ->\r
+%    {NL, lists:reverse(Acc)};\r
+%dot_unescape([$.|Rest], true, Acc) ->\r
+%    dot_unescape(Rest, false, Acc);\r
+%dot_unescape([$\n|Rest], _, Acc) ->\r
+%    dot_unescape(Rest, true, [$\n|Acc]);\r
+%dot_unescape([L|Rest], NL, Acc) when list(L) ->\r
+%    {NL2, L2} = dot_unescape(L, NL, []),\r
+%    dot_unescape(Rest, NL2, [L2|Acc]);\r
+%dot_unescape([C|Rest], _, Acc) ->\r
+%    dot_unescape(Rest, false, [C|Acc]).\r
+\r
+\r
+%%\r
+\r
+str2b64_final(String) ->\r
+    str2b64_final(String, []).\r
+\r
+\r
+str2b64_final([], Acc) ->\r
+    lists:reverse(Acc);\r
+str2b64_final(String, Acc) ->\r
+    case str2b64_line(String, []) of\r
+       {ok, Line, Rest} ->\r
+           str2b64_final(Rest, ["\n",Line|Acc]);\r
+       {more, Cont} ->\r
+           lists:reverse(["\n",str2b64_end(Cont)|Acc])\r
+    end.\r
+\r
+%%\r
+\r
+str2b64_line(S, []) -> str2b64_line(S, [], 0);\r
+str2b64_line(S, {Rest,Acc,N}) -> str2b64_line(Rest ++ S, Acc, N).\r
+\r
+str2b64_line(S, Out, 76) -> {ok,lists:reverse(Out),S};\r
+str2b64_line([C1,C2,C3|S], Out, N) ->\r
+    O1 = e(C1 bsr 2),\r
+    O2 = e(((C1 band 16#03) bsl 4) bor (C2 bsr 4)),\r
+    O3 = e(((C2 band 16#0f) bsl 2) bor (C3 bsr 6)),\r
+    O4 = e(C3 band 16#3f),\r
+    str2b64_line(S, [O4,O3,O2,O1|Out], N+4);\r
+str2b64_line(S, Out, N) ->\r
+    {more,{S,Out,N}}.\r
+\r
+%%\r
+\r
+str2b64_end({[C1,C2],Out,_N}) ->\r
+    O1 = e(C1 bsr 2),\r
+    O2 = e(((C1 band 16#03) bsl 4) bor (C2 bsr 4)),\r
+    O3 = e((C2 band 16#0f) bsl 2),\r
+    lists:reverse(Out, [O1,O2,O3,$=]);\r
+str2b64_end({[C1],Out,_N}) ->\r
+    O1 = e(C1 bsr 2),\r
+    O2 = e((C1 band 16#03) bsl 4),\r
+    lists:reverse(Out, [O1,O2,$=,$=]);\r
+str2b64_end({[],Out,_N}) -> lists:reverse(Out);\r
+str2b64_end([]) -> [].\r
+\r
+%%\r
+\r
+e(X) when X >= 0, X < 26 -> X + $A;\r
+e(X) when X >= 26, X < 52 -> X + $a - 26;\r
+e(X) when X >= 52, X < 62 -> X + $0 - 52;\r
+e(62) -> $+;\r
+e(63) -> $/;\r
+e(X) -> erlang:error({badchar,X}).\r
+\r
+\r
+%%\r
+\r
+\r
+weekday(Y,Mo,D) ->\r
+    int_to_wd(calendar:day_of_the_week(Y,Mo,D)).\r
+\r
+int_to_wd(1) -> "Mon";\r
+int_to_wd(2) -> "Tue";\r
+int_to_wd(3) -> "Wed";\r
+int_to_wd(4) -> "Thu";\r
+int_to_wd(5) -> "Fri";\r
+int_to_wd(6) -> "Sat";\r
+int_to_wd(7) -> "Sun".\r
+\r
+int_to_mt(1)  -> "Jan";\r
+int_to_mt(2)  -> "Feb";\r
+int_to_mt(3)  -> "Mar";\r
+int_to_mt(4)  -> "Apr";\r
+int_to_mt(5)  -> "May";\r
+int_to_mt(6)  -> "Jun";\r
+int_to_mt(7)  -> "Jul";\r
+int_to_mt(8)  -> "Aug";\r
+int_to_mt(9)  -> "Sep";\r
+int_to_mt(10) -> "Oct";\r
+int_to_mt(11) -> "Nov";\r
+int_to_mt(12) -> "Dec".\r
+\r
+%%\r
+\r
+mail_header(_Key, []) -> [];\r
+mail_header(Key, Val) -> Key++Val++"\r\n".\r
+\r
+%%\r
+\r
+to_int(Str) ->\r
+    to_int(Str, 0).\r
+\r
+to_int([D|Ds], Acc) when D >= $0, D =< $9->\r
+    to_int(Ds, Acc*10+D-$0);\r
+to_int(_, Acc) -> Acc.\r
+\r
+%%\r
+\r