/deps/gen_smtp/src/gen_smtp_client.erl

https://code.google.com/p/zotonic/ · Erlang · 1019 lines · 903 code · 38 blank · 78 comment · 7 complexity · 31b1c68e5a429b5d7ca3496a09e9eb7b MD5 · raw file

  1. %%% Copyright 2009 Andrew Thompson <andrew@hijacked.us>. All rights reserved.
  2. %%%
  3. %%% Redistribution and use in source and binary forms, with or without
  4. %%% modification, are permitted provided that the following conditions are met:
  5. %%%
  6. %%% 1. Redistributions of source code must retain the above copyright notice,
  7. %%% this list of conditions and the following disclaimer.
  8. %%% 2. Redistributions in binary form must reproduce the above copyright
  9. %%% notice, this list of conditions and the following disclaimer in the
  10. %%% documentation and/or other materials provided with the distribution.
  11. %%%
  12. %%% THIS SOFTWARE IS PROVIDED BY THE FREEBSD PROJECT ``AS IS'' AND ANY EXPRESS OR
  13. %%% IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
  14. %%% MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO
  15. %%% EVENT SHALL THE FREEBSD PROJECT OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
  16. %%% INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
  17. %%% (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
  18. %%% LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
  19. %%% ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
  20. %%% (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
  21. %%% SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  22. %% @doc A simple SMTP client used for sending mail - assumes relaying via a
  23. %% smarthost.
  24. -module(gen_smtp_client).
  25. -define(DEFAULT_OPTIONS, [
  26. {ssl, false}, % whether to connect on 465 in ssl mode
  27. {tls, if_available}, % always, never, if_available
  28. {auth, if_available},
  29. {hostname, smtp_util:guess_FQDN()},
  30. {retries, 1} % how many retries per smtp host on temporary failure
  31. ]).
  32. -define(AUTH_PREFERENCE, [
  33. "CRAM-MD5",
  34. "LOGIN",
  35. "PLAIN"
  36. ]).
  37. -define(TIMEOUT, 1200000).
  38. -ifdef(TEST).
  39. -include_lib("eunit/include/eunit.hrl").
  40. -compile(export_all).
  41. -else.
  42. -export([send/2, send/3, send_blocking/2]).
  43. -endif.
  44. -type email() :: {string() | binary(), [string() | binary(), ...], string() | binary() | function()}.
  45. -spec send(Email :: {string() | binary(), [string() | binary(), ...], string() | binary() | function()}, Options :: list()) -> {'ok', pid()} | {'error', any()}.
  46. %% @doc Send an email in a non-blocking fashion via a spawned_linked process.
  47. %% The process will exit abnormally on a send failure.
  48. send(Email, Options) ->
  49. send(Email, Options, undefined).
  50. %% @doc Send an email nonblocking and invoke a callback with the result of the send.
  51. %% The callback will receive either `{ok, Receipt}' where Receipt is the SMTP server's receipt
  52. %% identifier, `{error, Type, Message}' or `{exit, ExitReason}', as the single argument.
  53. -spec send(Email :: {string() | binary(), [string() | binary(), ...], string() | binary() | function()}, Options :: list(), Callback :: function() | 'undefined') -> {'ok', pid()} | {'error', any()}.
  54. send(Email, Options, Callback) ->
  55. NewOptions = lists:ukeymerge(1, lists:sort(Options),
  56. lists:sort(?DEFAULT_OPTIONS)),
  57. case check_options(NewOptions) of
  58. ok when is_function(Callback) ->
  59. spawn(fun() ->
  60. process_flag(trap_exit, true),
  61. Pid = spawn_link(fun() ->
  62. send_it_nonblock(Email, NewOptions, Callback)
  63. end
  64. ),
  65. receive
  66. {'EXIT', Pid, Reason} ->
  67. case Reason of
  68. X when X == normal; X == shutdown ->
  69. ok;
  70. Error ->
  71. Callback({exit, Error})
  72. end
  73. end
  74. end);
  75. ok ->
  76. Pid = spawn_link(fun () ->
  77. send_it_nonblock(Email, NewOptions, Callback)
  78. end
  79. ),
  80. {ok, Pid};
  81. {error, Reason} ->
  82. {error, Reason}
  83. end.
  84. -spec send_blocking(Email :: {string() | binary(), [string() | binary(), ...], string() | binary() | function()}, Options :: list()) -> binary() | {'error', atom(), any()} | {'error', any()}.
  85. %% @doc Send an email and block waiting for the reply. Returns either a binary that contains
  86. %% the SMTP server's receipt or `{error, Type, Message}' or `{error, Reason}'.
  87. send_blocking(Email, Options) ->
  88. NewOptions = lists:ukeymerge(1, lists:sort(Options),
  89. lists:sort(?DEFAULT_OPTIONS)),
  90. case check_options(NewOptions) of
  91. ok ->
  92. send_it(Email, NewOptions);
  93. {error, Reason} ->
  94. {error, Reason}
  95. end.
  96. -spec send_it_nonblock(Email :: email(), Options :: list(), Callback :: function() | 'undefined') ->{'ok', binary()} | {'error', any(), any()}.
  97. send_it_nonblock(Email, Options, Callback) ->
  98. case send_it(Email, Options) of
  99. {error, Type, Message} when is_function(Callback) ->
  100. Callback({error, Type, Message}),
  101. {error, Type, Message};
  102. {error, Type, Message} ->
  103. erlang:exit({error, Type, Message});
  104. Receipt when is_function(Callback) ->
  105. Callback({ok, Receipt}),
  106. {ok, Receipt};
  107. Receipt ->
  108. {ok, Receipt}
  109. end.
  110. -spec send_it(Email :: {string() | binary(), [string() | binary(), ...], string() | binary() | function()}, Options :: list()) -> binary() | {'error', any(), any()}.
  111. send_it(Email, Options) ->
  112. RelayDomain = proplists:get_value(relay, Options),
  113. MXRecords = case proplists:get_value(no_mx_lookups, Options) of
  114. true ->
  115. [];
  116. _ ->
  117. smtp_util:mxlookup(RelayDomain)
  118. end,
  119. %io:format("MX records for ~s are ~p~n", [RelayDomain, MXRecords]),
  120. Hosts = case MXRecords of
  121. [] ->
  122. [{0, RelayDomain}]; % maybe we're supposed to relay to a host directly
  123. _ ->
  124. MXRecords
  125. end,
  126. try_smtp_sessions(Hosts, Email, Options, []).
  127. -spec try_smtp_sessions(Hosts :: [{non_neg_integer(), string()}, ...], Email :: email(), Options :: list(), RetryList :: list()) -> binary() | {'error', any(), any()}.
  128. try_smtp_sessions([{Distance, Host} | Tail], Email, Options, RetryList) ->
  129. Retries = proplists:get_value(retries, Options),
  130. try do_smtp_session(Host, Email, Options) of
  131. Res -> Res
  132. catch
  133. throw:{permanent_failure, Message} ->
  134. % permanent failure means no retries, and don't even continue with other hosts
  135. {error, no_more_hosts, {permanent_failure, Host, Message}};
  136. throw:{FailureType, Message} ->
  137. case proplists:get_value(Host, RetryList) of
  138. RetryCount when is_integer(RetryCount), RetryCount >= Retries ->
  139. % out of chances
  140. %io:format("retries for ~s exceeded (~p of ~p)~n", [Host, RetryCount, Retries]),
  141. NewHosts = Tail,
  142. NewRetryList = lists:keydelete(Host, 1, RetryList);
  143. RetryCount when is_integer(RetryCount) ->
  144. %io:format("scheduling ~s for retry (~p of ~p)~n", [Host, RetryCount, Retries]),
  145. NewHosts = Tail ++ [{Distance, Host}],
  146. NewRetryList = lists:keydelete(Host, 1, RetryList) ++ [{Host, RetryCount + 1}];
  147. _ when Retries == 0 ->
  148. % done retrying completely
  149. NewHosts = Tail,
  150. NewRetryList = lists:keydelete(Host, 1, RetryList);
  151. _ ->
  152. % otherwise...
  153. %io:format("scheduling ~s for retry (~p of ~p)~n", [Host, 1, Retries]),
  154. NewHosts = Tail ++ [{Distance, Host}],
  155. NewRetryList = lists:keydelete(Host, 1, RetryList) ++ [{Host, 1}]
  156. end,
  157. case NewHosts of
  158. [] ->
  159. {error, retries_exceeded, {FailureType, Host, Message}};
  160. _ ->
  161. try_smtp_sessions(NewHosts, Email, Options, NewRetryList)
  162. end
  163. end.
  164. -spec do_smtp_session(Host :: string(), Email :: email(), Options :: list()) -> binary().
  165. do_smtp_session(Host, Email, Options) ->
  166. {ok, Socket, _Host, _Banner} = connect(Host, Options),
  167. %io:format("connected to ~s; banner was ~s~n", [Host, Banner]),
  168. {ok, Extensions} = try_EHLO(Socket, Options),
  169. %io:format("Extensions are ~p~n", [Extensions]),
  170. {Socket2, Extensions2} = try_STARTTLS(Socket, Options, Extensions),
  171. %io:format("Extensions are ~p~n", [Extensions2]),
  172. _Authed = try_AUTH(Socket2, Options, proplists:get_value(<<"AUTH">>, Extensions2)),
  173. %io:format("Authentication status is ~p~n", [Authed]),
  174. Receipt = try_sending_it(Email, Socket2, Extensions2),
  175. %io:format("Mail sending successful~n"),
  176. quit(Socket2),
  177. Receipt.
  178. -spec try_sending_it(Email :: email(), Socket :: socket:socket(), Extensions :: list()) -> binary().
  179. try_sending_it({From, To, Body}, Socket, Extensions) ->
  180. try_MAIL_FROM(From, Socket, Extensions),
  181. try_RCPT_TO(To, Socket, Extensions),
  182. try_DATA(Body, Socket, Extensions).
  183. -spec try_MAIL_FROM(From :: string() | binary(), Socket :: socket:socket(), Extensions :: list()) -> true.
  184. try_MAIL_FROM(From, Socket, Extensions) when is_binary(From) ->
  185. try_MAIL_FROM(binary_to_list(From), Socket, Extensions);
  186. try_MAIL_FROM("<" ++ _ = From, Socket, _Extensions) ->
  187. % TODO do we need to bother with SIZE?
  188. socket:send(Socket, ["MAIL FROM: ", From, "\r\n"]),
  189. case read_possible_multiline_reply(Socket) of
  190. {ok, <<"250", _Rest/binary>>} ->
  191. true;
  192. {ok, <<"4", _Rest/binary>> = Msg} ->
  193. quit(Socket),
  194. throw({temporary_failure, Msg});
  195. {ok, Msg} ->
  196. %io:format("Mail FROM rejected: ~p~n", [Msg]),
  197. quit(Socket),
  198. throw({permanent_failure, Msg})
  199. end;
  200. try_MAIL_FROM(From, Socket, Extensions) ->
  201. % someone was bad and didn't put in the angle brackets
  202. try_MAIL_FROM("<"++From++">", Socket, Extensions).
  203. -spec try_RCPT_TO(Tos :: [binary() | string()], Socket :: socket:socket(), Extensions :: list()) -> true.
  204. try_RCPT_TO([], _Socket, _Extensions) ->
  205. true;
  206. try_RCPT_TO([To | Tail], Socket, Extensions) when is_binary(To) ->
  207. try_RCPT_TO([binary_to_list(To) | Tail], Socket, Extensions);
  208. try_RCPT_TO(["<" ++ _ = To | Tail], Socket, Extensions) ->
  209. socket:send(Socket, ["RCPT TO: ",To,"\r\n"]),
  210. case read_possible_multiline_reply(Socket) of
  211. {ok, <<"250", _Rest/binary>>} ->
  212. try_RCPT_TO(Tail, Socket, Extensions);
  213. {ok, <<"251", _Rest/binary>>} ->
  214. try_RCPT_TO(Tail, Socket, Extensions);
  215. {ok, <<"4", _Rest/binary>> = Msg} ->
  216. quit(Socket),
  217. throw({temporary_failure, Msg});
  218. {ok, Msg} ->
  219. quit(Socket),
  220. throw({permanent_failure, Msg})
  221. end;
  222. try_RCPT_TO([To | Tail], Socket, Extensions) ->
  223. % someone was bad and didn't put in the angle brackets
  224. try_RCPT_TO(["<"++To++">" | Tail], Socket, Extensions).
  225. -spec try_DATA(Body :: binary() | function(), Socket :: socket:socket(), Extensions :: list()) -> binary().
  226. try_DATA(Body, Socket, Extensions) when is_function(Body) ->
  227. try_DATA(Body(), Socket, Extensions);
  228. try_DATA(Body, Socket, _Extensions) ->
  229. socket:send(Socket, "DATA\r\n"),
  230. case read_possible_multiline_reply(Socket) of
  231. {ok, <<"354", _Rest/binary>>} ->
  232. socket:send(Socket, [Body, "\r\n.\r\n"]),
  233. case read_possible_multiline_reply(Socket) of
  234. {ok, <<"250 ", Receipt/binary>>} ->
  235. Receipt;
  236. {ok, <<"4", _Rest2/binary>> = Msg} ->
  237. quit(Socket),
  238. throw({temporary_failure, Msg});
  239. {ok, Msg} ->
  240. quit(Socket),
  241. throw({permanent_failure, Msg})
  242. end;
  243. {ok, <<"4", _Rest/binary>> = Msg} ->
  244. quit(Socket),
  245. throw({temporary_failure, Msg});
  246. {ok, Msg} ->
  247. quit(Socket),
  248. throw({permanent_failure, Msg})
  249. end.
  250. -spec try_AUTH(Socket :: socket:socket(), Options :: list(), AuthTypes :: [string()]) -> boolean().
  251. try_AUTH(Socket, Options, []) ->
  252. case proplists:get_value(auth, Options) of
  253. always ->
  254. quit(Socket),
  255. erlang:throw({missing_requirement, auth});
  256. _ ->
  257. false
  258. end;
  259. try_AUTH(Socket, Options, undefined) ->
  260. case proplists:get_value(auth, Options) of
  261. always ->
  262. quit(Socket),
  263. erlang:throw({missing_requirement, auth});
  264. _ ->
  265. false
  266. end;
  267. try_AUTH(Socket, Options, AuthTypes) ->
  268. case proplists:is_defined(username, Options) and
  269. proplists:is_defined(password, Options) and
  270. (proplists:get_value(auth, Options) =/= never) of
  271. false ->
  272. case proplists:get_value(auth, Options) of
  273. always ->
  274. quit(Socket),
  275. erlang:throw({missing_requirement, auth});
  276. _ ->
  277. false
  278. end;
  279. true ->
  280. Username = proplists:get_value(username, Options),
  281. Password = proplists:get_value(password, Options),
  282. %io:format("Auth types: ~p~n", [AuthTypes]),
  283. Types = re:split(AuthTypes, " ", [{return, list}, trim]),
  284. case do_AUTH(Socket, Username, Password, Types) of
  285. false ->
  286. case proplists:get_value(auth, Options) of
  287. always ->
  288. quit(Socket),
  289. erlang:throw({permanent_failure, auth_failed});
  290. _ ->
  291. false
  292. end;
  293. true ->
  294. true
  295. end
  296. end.
  297. -spec do_AUTH(Socket :: socket:socket(), Username :: string(), Password :: string(), Types :: [string()]) -> boolean().
  298. do_AUTH(Socket, Username, Password, Types) ->
  299. FixedTypes = [string:to_upper(X) || X <- Types],
  300. %io:format("Fixed types: ~p~n", [FixedTypes]),
  301. AllowedTypes = [X || X <- ?AUTH_PREFERENCE, lists:member(X, FixedTypes)],
  302. %io:format("available authentication types, in order of preference: ~p~n",
  303. % [AllowedTypes]),
  304. do_AUTH_each(Socket, Username, Password, AllowedTypes).
  305. -spec do_AUTH_each(Socket :: socket:socket(), Username :: string() | binary(), Password :: string() | binary(), AuthTypes :: [string()]) -> boolean().
  306. do_AUTH_each(_Socket, _Username, _Password, []) ->
  307. false;
  308. do_AUTH_each(Socket, Username, Password, ["CRAM-MD5" | Tail]) ->
  309. socket:send(Socket, "AUTH CRAM-MD5\r\n"),
  310. case read_possible_multiline_reply(Socket) of
  311. {ok, <<"334 ", Rest/binary>>} ->
  312. Seed64 = binstr:strip(binstr:strip(Rest, right, $\n), right, $\r),
  313. Seed = base64:decode_to_string(Seed64),
  314. Digest = smtp_util:compute_cram_digest(Password, Seed),
  315. String = base64:encode(list_to_binary([Username, " ", Digest])),
  316. socket:send(Socket, [String, "\r\n"]),
  317. case read_possible_multiline_reply(Socket) of
  318. {ok, <<"235", _Rest/binary>>} ->
  319. %io:format("authentication accepted~n"),
  320. true;
  321. {ok, _Msg} ->
  322. %io:format("authentication rejected: ~s~n", [Msg]),
  323. do_AUTH_each(Socket, Username, Password, Tail)
  324. end;
  325. {ok, _Something} ->
  326. %io:format("got ~s~n", [Something]),
  327. do_AUTH_each(Socket, Username, Password, Tail)
  328. end;
  329. do_AUTH_each(Socket, Username, Password, ["LOGIN" | Tail]) ->
  330. socket:send(Socket, "AUTH LOGIN\r\n"),
  331. case read_possible_multiline_reply(Socket) of
  332. {ok, <<"334 VXNlcm5hbWU6\r\n">>} ->
  333. %io:format("username prompt~n"),
  334. U = base64:encode(Username),
  335. socket:send(Socket, [U,"\r\n"]),
  336. case read_possible_multiline_reply(Socket) of
  337. {ok, <<"334 UGFzc3dvcmQ6\r\n">>} ->
  338. %io:format("password prompt~n"),
  339. P = base64:encode(Password),
  340. socket:send(Socket, [P,"\r\n"]),
  341. case read_possible_multiline_reply(Socket) of
  342. {ok, <<"235 ", _Rest/binary>>} ->
  343. %io:format("authentication accepted~n"),
  344. true;
  345. {ok, _Msg} ->
  346. %io:format("password rejected: ~s", [Msg]),
  347. do_AUTH_each(Socket, Username, Password, Tail)
  348. end;
  349. {ok, _Msg2} ->
  350. %io:format("username rejected: ~s", [Msg2]),
  351. do_AUTH_each(Socket, Username, Password, Tail)
  352. end;
  353. {ok, _Something} ->
  354. %io:format("got ~s~n", [Something]),
  355. do_AUTH_each(Socket, Username, Password, Tail)
  356. end;
  357. do_AUTH_each(Socket, Username, Password, ["PLAIN" | Tail]) ->
  358. AuthString = base64:encode("\0"++Username++"\0"++Password),
  359. socket:send(Socket, ["AUTH PLAIN ", AuthString, "\r\n"]),
  360. case read_possible_multiline_reply(Socket) of
  361. {ok, <<"235", _Rest/binary>>} ->
  362. %io:format("authentication accepted~n"),
  363. true;
  364. _Else ->
  365. % TODO do we need to bother trying the multi-step PLAIN?
  366. %io:format("authentication rejected~n"),
  367. %io:format("~p~n", [Else]),
  368. do_AUTH_each(Socket, Username, Password, Tail)
  369. end;
  370. do_AUTH_each(Socket, Username, Password, [_Type | Tail]) ->
  371. %io:format("unsupported AUTH type ~s~n", [Type]),
  372. do_AUTH_each(Socket, Username, Password, Tail).
  373. -spec try_EHLO(Socket :: socket:socket(), Options :: list()) -> {ok, list()}.
  374. try_EHLO(Socket, Options) ->
  375. ok = socket:send(Socket, ["EHLO ", proplists:get_value(hostname, Options, smtp_util:guess_FQDN()), "\r\n"]),
  376. case read_possible_multiline_reply(Socket) of
  377. {ok, <<"500", _Rest/binary>>} ->
  378. % Unrecognized command, fall back to HELO
  379. try_HELO(Socket, Options);
  380. {ok, <<"4", _Rest/binary>> = Msg} ->
  381. quit(Socket),
  382. throw({temporary_failure, Msg});
  383. {ok, Reply} ->
  384. {ok, parse_extensions(Reply)}
  385. end.
  386. -spec try_HELO(Socket :: socket:socket(), Options :: list()) -> {ok, list()}.
  387. try_HELO(Socket, Options) ->
  388. ok = socket:send(Socket, ["HELO ", proplists:get_value(hostname, Options, smtp_util:guess_FQDN()), "\r\n"]),
  389. case read_possible_multiline_reply(Socket) of
  390. {ok, <<"250", _Rest/binary>>} ->
  391. {ok, []};
  392. {ok, <<"4", _Rest/binary>> = Msg} ->
  393. quit(Socket),
  394. throw({temporary_failure, Msg});
  395. {ok, Msg} ->
  396. quit(Socket),
  397. throw({permanent_failure, Msg})
  398. end.
  399. % check if we should try to do TLS
  400. -spec try_STARTTLS(Socket :: socket:socket(), Options :: list(), Extensions :: list()) -> {socket:socket(), list()}.
  401. try_STARTTLS(Socket, Options, Extensions) ->
  402. case {proplists:get_value(tls, Options),
  403. proplists:get_value(<<"STARTTLS">>, Extensions)} of
  404. {Atom, true} when Atom =:= always; Atom =:= if_available ->
  405. %io:format("Starting TLS~n"),
  406. case {do_STARTTLS(Socket, Options), Atom} of
  407. {false, always} ->
  408. %io:format("TLS failed~n"),
  409. quit(Socket),
  410. erlang:throw({temporary_failure, tls_failed});
  411. {false, if_available} ->
  412. %io:format("TLS failed~n"),
  413. {Socket, Extensions};
  414. {{S, E}, _} ->
  415. %io:format("TLS started~n"),
  416. {S, E}
  417. end;
  418. {always, _} ->
  419. quit(Socket),
  420. erlang:throw({missing_requirement, tls});
  421. _ ->
  422. {Socket, Extensions}
  423. end.
  424. %% attempt to upgrade socket to TLS
  425. -spec do_STARTTLS(Socket :: socket:socket(), Options :: list()) -> {socket:socket(), list()} | false.
  426. do_STARTTLS(Socket, Options) ->
  427. socket:send(Socket, "STARTTLS\r\n"),
  428. case read_possible_multiline_reply(Socket) of
  429. {ok, <<"220", _Rest/binary>>} ->
  430. application:start(crypto),
  431. application:start(public_key),
  432. application:start(ssl),
  433. case socket:to_ssl_client(Socket, [], 5000) of
  434. {ok, NewSocket} ->
  435. %NewSocket;
  436. {ok, Extensions} = try_EHLO(NewSocket, Options),
  437. {NewSocket, Extensions};
  438. _Else ->
  439. %io:format("~p~n", [Else]),
  440. false
  441. end;
  442. {ok, <<"4", _Rest/binary>> = Msg} ->
  443. quit(Socket),
  444. throw({temporary_failure, Msg});
  445. {ok, Msg} ->
  446. quit(Socket),
  447. throw({permanent_failure, Msg})
  448. end.
  449. %% try connecting to a host
  450. connect(Host, Options) when is_binary(Host) ->
  451. connect(binary_to_list(Host), Options);
  452. connect(Host, Options) ->
  453. SockOpts = [binary, {packet, line}, {keepalive, true}, {active, false}],
  454. Proto = case proplists:get_value(ssl, Options) of
  455. true ->
  456. application:start(crypto),
  457. application:start(public_key),
  458. application:start(ssl),
  459. ssl;
  460. _ ->
  461. tcp
  462. end,
  463. Port = case proplists:get_value(port, Options) of
  464. undefined when Proto =:= ssl ->
  465. 465;
  466. OPort when is_integer(OPort) ->
  467. OPort;
  468. _ ->
  469. 25
  470. end,
  471. case socket:connect(Proto, Host, Port, SockOpts, 5000) of
  472. {ok, Socket} ->
  473. case read_possible_multiline_reply(Socket) of
  474. {ok, <<"220", Banner/binary>>} ->
  475. {ok, Socket, Host, Banner};
  476. {ok, <<"4", _Rest/binary>> = Msg} ->
  477. quit(Socket),
  478. throw({temporary_failure, Msg});
  479. {ok, Msg} ->
  480. quit(Socket),
  481. throw({permanent_failure, Msg})
  482. end;
  483. {error, Reason} ->
  484. throw({network_failure, {error, Reason}})
  485. end.
  486. %% read a multiline reply (eg. EHLO reply)
  487. -spec read_possible_multiline_reply(Socket :: socket:socket()) -> {ok, binary()}.
  488. read_possible_multiline_reply(Socket) ->
  489. case socket:recv(Socket, 0, ?TIMEOUT) of
  490. {ok, Packet} ->
  491. case binstr:substr(Packet, 4, 1) of
  492. <<"-">> ->
  493. Code = binstr:substr(Packet, 1, 3),
  494. read_multiline_reply(Socket, Code, [Packet]);
  495. <<" ">> ->
  496. {ok, Packet}
  497. end;
  498. Error ->
  499. throw({network_failure, Error})
  500. end.
  501. -spec read_multiline_reply(Socket :: socket:socket(), Code :: binary(), Acc :: [binary()]) -> {ok, binary()}.
  502. read_multiline_reply(Socket, Code, Acc) ->
  503. case socket:recv(Socket, 0, ?TIMEOUT) of
  504. {ok, Packet} ->
  505. case {binstr:substr(Packet, 1, 3), binstr:substr(Packet, 4, 1)} of
  506. {Code, <<" ">>} ->
  507. {ok, list_to_binary(lists:reverse([Packet | Acc]))};
  508. {Code, <<"-">>} ->
  509. read_multiline_reply(Socket, Code, [Packet | Acc]);
  510. _ ->
  511. quit(Socket),
  512. throw({unexpected_response, lists:reverse([Packet | Acc])})
  513. end;
  514. Error ->
  515. throw({network_failure, Error})
  516. end.
  517. quit(Socket) ->
  518. socket:send(Socket, "QUIT\r\n"),
  519. socket:close(Socket),
  520. ok.
  521. % TODO - more checking
  522. check_options(Options) ->
  523. case proplists:get_value(relay, Options) of
  524. undefined ->
  525. {error, no_relay};
  526. _ ->
  527. case proplists:get_value(auth, Options) of
  528. Atom when Atom =:= always ->
  529. case proplists:is_defined(username, Options) and
  530. proplists:is_defined(password, Options) of
  531. false ->
  532. {error, no_credentials};
  533. true ->
  534. ok
  535. end;
  536. _ ->
  537. ok
  538. end
  539. end.
  540. -spec parse_extensions(Reply :: binary()) -> [{binary(), binary()}].
  541. parse_extensions(Reply) ->
  542. [_ | Reply2] = re:split(Reply, "\r\n", [{return, binary}, trim]),
  543. [
  544. begin
  545. Body = binstr:substr(Entry, 5),
  546. case re:split(Body, " ", [{return, binary}, trim, {parts, 2}]) of
  547. [Verb, Parameters] ->
  548. {binstr:to_upper(Verb), Parameters};
  549. [Body] ->
  550. case binstr:strchr(Body, $=) of
  551. 0 ->
  552. {binstr:to_upper(Body), true};
  553. _ ->
  554. %io:format("discarding option ~p~n", [Body]),
  555. []
  556. end
  557. end
  558. end || Entry <- Reply2].
  559. -ifdef(TEST).
  560. session_start_test_() ->
  561. {foreach,
  562. local,
  563. fun() ->
  564. {ok, ListenSock} = socket:listen(tcp, 9876),
  565. {ListenSock}
  566. end,
  567. fun({ListenSock}) ->
  568. socket:close(ListenSock)
  569. end,
  570. [fun({ListenSock}) ->
  571. {"simple session initiation",
  572. fun() ->
  573. Options = [{relay, "localhost"}, {port, 9876}, {hostname, "testing"}],
  574. {ok, _Pid} = send({"test@foo.com", ["foo@bar.com"], "hello world"}, Options),
  575. {ok, X} = socket:accept(ListenSock, 1000),
  576. socket:send(X, "220 Some banner\r\n"),
  577. ?assertMatch({ok, "EHLO testing\r\n"}, socket:recv(X, 0, 1000)),
  578. ok
  579. end
  580. }
  581. end,
  582. fun({ListenSock}) ->
  583. {"retry on crashed EHLO twice if requested",
  584. fun() ->
  585. Options = [{relay, "localhost"}, {port, 9876}, {hostname, "testing"}, {retries, 2}],
  586. {ok, _Pid} = send({"test@foo.com", ["foo@bar.com"], "hello world"}, Options),
  587. {ok, X} = socket:accept(ListenSock, 1000),
  588. socket:send(X, "220 Some banner\r\n"),
  589. ?assertMatch({ok, "EHLO testing\r\n"}, socket:recv(X, 0, 1000)),
  590. socket:close(X),
  591. {ok, Y} = socket:accept(ListenSock, 1000),
  592. socket:send(Y, "220 Some banner\r\n"),
  593. ?assertMatch({ok, "EHLO testing\r\n"}, socket:recv(Y, 0, 1000)),
  594. socket:close(Y),
  595. {ok, Z} = socket:accept(ListenSock, 1000),
  596. socket:send(Z, "220 Some banner\r\n"),
  597. ?assertMatch({ok, "EHLO testing\r\n"}, socket:recv(Z, 0, 1000)),
  598. ok
  599. end
  600. }
  601. end,
  602. fun({ListenSock}) ->
  603. {"retry on crashed EHLO",
  604. fun() ->
  605. Options = [{relay, "localhost"}, {port, 9876}, {hostname, "testing"}],
  606. {ok, Pid} = send({"test@foo.com", ["foo@bar.com"], "hello world"}, Options),
  607. unlink(Pid),
  608. Monitor = erlang:monitor(process, Pid),
  609. {ok, X} = socket:accept(ListenSock, 1000),
  610. socket:send(X, "220 Some banner\r\n"),
  611. ?assertMatch({ok, "EHLO testing\r\n"}, socket:recv(X, 0, 1000)),
  612. socket:close(X),
  613. {ok, Y} = socket:accept(ListenSock, 1000),
  614. socket:send(Y, "220 Some banner\r\n"),
  615. ?assertMatch({ok, "EHLO testing\r\n"}, socket:recv(Y, 0, 1000)),
  616. socket:close(Y),
  617. ?assertEqual({error, timeout}, socket:accept(ListenSock, 1000)),
  618. receive {'DOWN', Monitor, _, _, Error} -> ?assertMatch({error, retries_exceeded, _}, Error) end,
  619. ok
  620. end
  621. }
  622. end,
  623. fun({ListenSock}) ->
  624. {"abort on 554 greeting",
  625. fun() ->
  626. Options = [{relay, "localhost"}, {port, 9876}, {hostname, "testing"}],
  627. {ok, Pid} = send({"test@foo.com", ["foo@bar.com"], "hello world"}, Options),
  628. unlink(Pid),
  629. Monitor = erlang:monitor(process, Pid),
  630. {ok, X} = socket:accept(ListenSock, 1000),
  631. socket:send(X, "554 get lost, kid\r\n"),
  632. ?assertMatch({ok, "QUIT\r\n"}, socket:recv(X, 0, 1000)),
  633. receive {'DOWN', Monitor, _, _, Error} -> ?assertMatch({error, no_more_hosts, _}, Error) end,
  634. ok
  635. end
  636. }
  637. end,
  638. fun({ListenSock}) ->
  639. {"retry on 421 greeting",
  640. fun() ->
  641. Options = [{relay, "localhost"}, {port, 9876}, {hostname, "testing"}],
  642. {ok, _Pid} = send({"test@foo.com", ["foo@bar.com"], "hello world"}, Options),
  643. {ok, X} = socket:accept(ListenSock, 1000),
  644. socket:send(X, "421 can't you see I'm busy?\r\n"),
  645. ?assertMatch({ok, "QUIT\r\n"}, socket:recv(X, 0, 1000)),
  646. {ok, Y} = socket:accept(ListenSock, 1000),
  647. socket:send(Y, "220 Some banner\r\n"),
  648. ?assertMatch({ok, "EHLO testing\r\n"}, socket:recv(Y, 0, 1000)),
  649. ok
  650. end
  651. }
  652. end,
  653. fun({ListenSock}) ->
  654. {"retry on messed up EHLO response",
  655. fun() ->
  656. Options = [{relay, "localhost"}, {port, 9876}, {hostname, "testing"}],
  657. {ok, Pid} = send({"test@foo.com", ["foo@bar.com"], "hello world"}, Options),
  658. unlink(Pid),
  659. Monitor = erlang:monitor(process, Pid),
  660. {ok, X} = socket:accept(ListenSock, 1000),
  661. socket:send(X, "220 Some banner\r\n"),
  662. ?assertMatch({ok, "EHLO testing\r\n"}, socket:recv(X, 0, 1000)),
  663. socket:send(X, "250-server.example.com EHLO\r\n250-AUTH LOGIN PLAIN\r\n421 too busy\r\n"),
  664. ?assertMatch({ok, "QUIT\r\n"}, socket:recv(X, 0, 1000)),
  665. {ok, Y} = socket:accept(ListenSock, 1000),
  666. socket:send(Y, "220 Some banner\r\n"),
  667. ?assertMatch({ok, "EHLO testing\r\n"}, socket:recv(Y, 0, 1000)),
  668. socket:send(Y, "250-server.example.com EHLO\r\n250-AUTH LOGIN PLAIN\r\n421 too busy\r\n"),
  669. ?assertMatch({ok, "QUIT\r\n"}, socket:recv(Y, 0, 1000)),
  670. receive {'DOWN', Monitor, _, _, Error} -> ?assertMatch({error, retries_exceeded, _}, Error) end,
  671. ok
  672. end
  673. }
  674. end,
  675. fun({ListenSock}) ->
  676. {"retry with HELO when EHLO not accepted",
  677. fun() ->
  678. Options = [{relay, "localhost"}, {port, 9876}, {hostname, "testing"}],
  679. {ok, _Pid} = send({"test@foo.com", ["foo@bar.com"], "hello world"}, Options),
  680. {ok, X} = socket:accept(ListenSock, 1000),
  681. socket:send(X, "220 \r\n"),
  682. ?assertMatch({ok, "EHLO testing\r\n"}, socket:recv(X, 0, 1000)),
  683. socket:send(X, "500 5.3.3 Unrecognized command\r\n"),
  684. ?assertMatch({ok, "HELO testing\r\n"}, socket:recv(X, 0, 1000)),
  685. socket:send(X, "250 Some banner\r\n"),
  686. ?assertMatch({ok, "MAIL FROM: <test@foo.com>\r\n"}, socket:recv(X, 0, 1000)),
  687. socket:send(X, "250 ok\r\n"),
  688. ?assertMatch({ok, "RCPT TO: <foo@bar.com>\r\n"}, socket:recv(X, 0, 1000)),
  689. socket:send(X, "250 ok\r\n"),
  690. ?assertMatch({ok, "DATA\r\n"}, socket:recv(X, 0, 1000)),
  691. socket:send(X, "354 ok\r\n"),
  692. ?assertMatch({ok, "hello world\r\n"}, socket:recv(X, 0, 1000)),
  693. ?assertMatch({ok, ".\r\n"}, socket:recv(X, 0, 1000)),
  694. socket:send(X, "250 ok\r\n"),
  695. ?assertMatch({ok, "QUIT\r\n"}, socket:recv(X, 0, 1000)),
  696. ok
  697. end
  698. }
  699. end,
  700. fun({ListenSock}) ->
  701. {"a valid complete transaction without TLS advertised should succeed",
  702. fun() ->
  703. Options = [{relay, "localhost"}, {port, 9876}, {hostname, "testing"}],
  704. {ok, _Pid} = send({"test@foo.com", ["foo@bar.com"], "hello world"}, Options),
  705. {ok, X} = socket:accept(ListenSock, 1000),
  706. socket:send(X, "220 Some banner\r\n"),
  707. ?assertMatch({ok, "EHLO testing\r\n"}, socket:recv(X, 0, 1000)),
  708. socket:send(X, "250 hostname\r\n"),
  709. ?assertMatch({ok, "MAIL FROM: <test@foo.com>\r\n"}, socket:recv(X, 0, 1000)),
  710. socket:send(X, "250 ok\r\n"),
  711. ?assertMatch({ok, "RCPT TO: <foo@bar.com>\r\n"}, socket:recv(X, 0, 1000)),
  712. socket:send(X, "250 ok\r\n"),
  713. ?assertMatch({ok, "DATA\r\n"}, socket:recv(X, 0, 1000)),
  714. socket:send(X, "354 ok\r\n"),
  715. ?assertMatch({ok, "hello world\r\n"}, socket:recv(X, 0, 1000)),
  716. ?assertMatch({ok, ".\r\n"}, socket:recv(X, 0, 1000)),
  717. socket:send(X, "250 ok\r\n"),
  718. ?assertMatch({ok, "QUIT\r\n"}, socket:recv(X, 0, 1000)),
  719. ok
  720. end
  721. }
  722. end,
  723. fun({ListenSock}) ->
  724. {"a valid complete transaction with binary arguments shoyld succeed",
  725. fun() ->
  726. Options = [{relay, "localhost"}, {port, 9876}, {hostname, "testing"}],
  727. {ok, _Pid} = send({<<"test@foo.com">>, [<<"foo@bar.com">>], <<"hello world">>}, Options),
  728. {ok, X} = socket:accept(ListenSock, 1000),
  729. socket:send(X, "220 Some banner\r\n"),
  730. ?assertMatch({ok, "EHLO testing\r\n"}, socket:recv(X, 0, 1000)),
  731. socket:send(X, "250 hostname\r\n"),
  732. ?assertMatch({ok, "MAIL FROM: <test@foo.com>\r\n"}, socket:recv(X, 0, 1000)),
  733. socket:send(X, "250 ok\r\n"),
  734. ?assertMatch({ok, "RCPT TO: <foo@bar.com>\r\n"}, socket:recv(X, 0, 1000)),
  735. socket:send(X, "250 ok\r\n"),
  736. ?assertMatch({ok, "DATA\r\n"}, socket:recv(X, 0, 1000)),
  737. socket:send(X, "354 ok\r\n"),
  738. ?assertMatch({ok, "hello world\r\n"}, socket:recv(X, 0, 1000)),
  739. ?assertMatch({ok, ".\r\n"}, socket:recv(X, 0, 1000)),
  740. socket:send(X, "250 ok\r\n"),
  741. ?assertMatch({ok, "QUIT\r\n"}, socket:recv(X, 0, 1000)),
  742. ok
  743. end
  744. }
  745. end,
  746. fun({ListenSock}) ->
  747. {"a valid complete transaction with TLS advertised should succeed",
  748. fun() ->
  749. Options = [{relay, "localhost"}, {port, 9876}, {hostname, <<"testing">>}],
  750. {ok, _Pid} = send({"test@foo.com", ["foo@bar.com"], "hello world"}, Options),
  751. {ok, X} = socket:accept(ListenSock, 1000),
  752. socket:send(X, "220 Some banner\r\n"),
  753. ?assertMatch({ok, "EHLO testing\r\n"}, socket:recv(X, 0, 1000)),
  754. socket:send(X, "250-hostname\r\n250 STARTTLS\r\n"),
  755. ?assertMatch({ok, "STARTTLS\r\n"}, socket:recv(X, 0, 1000)),
  756. application:start(crypto),
  757. application:start(public_key),
  758. application:start(ssl),
  759. socket:send(X, "220 ok\r\n"),
  760. {ok, Y} = socket:to_ssl_server(X, [{certfile, "../testdata/server.crt"}, {keyfile, "../testdata/server.key"}], 5000),
  761. ?assertMatch({ok, "EHLO testing\r\n"}, socket:recv(Y, 0, 1000)),
  762. socket:send(Y, "250-hostname\r\n250 STARTTLS\r\n"),
  763. ?assertMatch({ok, "MAIL FROM: <test@foo.com>\r\n"}, socket:recv(Y, 0, 1000)),
  764. socket:send(Y, "250 ok\r\n"),
  765. ?assertMatch({ok, "RCPT TO: <foo@bar.com>\r\n"}, socket:recv(Y, 0, 1000)),
  766. socket:send(Y, "250 ok\r\n"),
  767. ?assertMatch({ok, "DATA\r\n"}, socket:recv(Y, 0, 1000)),
  768. socket:send(Y, "354 ok\r\n"),
  769. ?assertMatch({ok, "hello world\r\n"}, socket:recv(Y, 0, 1000)),
  770. ?assertMatch({ok, ".\r\n"}, socket:recv(Y, 0, 1000)),
  771. socket:send(Y, "250 ok\r\n"),
  772. ?assertMatch({ok, "QUIT\r\n"}, socket:recv(Y, 0, 1000)),
  773. ok
  774. end
  775. }
  776. end,
  777. fun({ListenSock}) ->
  778. {"a valid complete transaction with TLS advertised and binary arguments should succeed",
  779. fun() ->
  780. Options = [{relay, "localhost"}, {port, 9876}, {hostname, <<"testing">>}],
  781. {ok, _Pid} = send({<<"test@foo.com">>, [<<"foo@bar.com">>], <<"hello world">>}, Options),
  782. {ok, X} = socket:accept(ListenSock, 1000),
  783. socket:send(X, "220 Some banner\r\n"),
  784. ?assertMatch({ok, "EHLO testing\r\n"}, socket:recv(X, 0, 1000)),
  785. socket:send(X, "250-hostname\r\n250 STARTTLS\r\n"),
  786. ?assertMatch({ok, "STARTTLS\r\n"}, socket:recv(X, 0, 1000)),
  787. application:start(crypto),
  788. application:start(public_key),
  789. application:start(ssl),
  790. socket:send(X, "220 ok\r\n"),
  791. {ok, Y} = socket:to_ssl_server(X, [{certfile, "../testdata/server.crt"}, {keyfile, "../testdata/server.key"}], 5000),
  792. ?assertMatch({ok, "EHLO testing\r\n"}, socket:recv(Y, 0, 1000)),
  793. socket:send(Y, "250-hostname\r\n250 STARTTLS\r\n"),
  794. ?assertMatch({ok, "MAIL FROM: <test@foo.com>\r\n"}, socket:recv(Y, 0, 1000)),
  795. socket:send(Y, "250 ok\r\n"),
  796. ?assertMatch({ok, "RCPT TO: <foo@bar.com>\r\n"}, socket:recv(Y, 0, 1000)),
  797. socket:send(Y, "250 ok\r\n"),
  798. ?assertMatch({ok, "DATA\r\n"}, socket:recv(Y, 0, 1000)),
  799. socket:send(Y, "354 ok\r\n"),
  800. ?assertMatch({ok, "hello world\r\n"}, socket:recv(Y, 0, 1000)),
  801. ?assertMatch({ok, ".\r\n"}, socket:recv(Y, 0, 1000)),
  802. socket:send(Y, "250 ok\r\n"),
  803. ?assertMatch({ok, "QUIT\r\n"}, socket:recv(Y, 0, 1000)),
  804. ok
  805. end
  806. }
  807. end,
  808. fun({ListenSock}) ->
  809. {"AUTH PLAIN should work",
  810. fun() ->
  811. Options = [{relay, "localhost"}, {port, 9876}, {hostname, "testing"}, {username, "user"}, {password, "pass"}],
  812. {ok, _Pid} = send({"test@foo.com", ["foo@bar.com"], "hello world"}, Options),
  813. {ok, X} = socket:accept(ListenSock, 1000),
  814. socket:send(X, "220 Some banner\r\n"),
  815. ?assertMatch({ok, "EHLO testing\r\n"}, socket:recv(X, 0, 1000)),
  816. socket:send(X, "250-hostname\r\n250 AUTH PLAIN\r\n"),
  817. AuthString = binary_to_list(base64:encode("\0user\0pass")),
  818. AuthPacket = "AUTH PLAIN "++AuthString++"\r\n",
  819. ?assertEqual({ok, AuthPacket}, socket:recv(X, 0, 1000)),
  820. socket:send(X, "235 ok\r\n"),
  821. ?assertMatch({ok, "MAIL FROM: <test@foo.com>\r\n"}, socket:recv(X, 0, 1000)),
  822. ok
  823. end
  824. }
  825. end,
  826. fun({ListenSock}) ->
  827. {"AUTH LOGIN should work",
  828. fun() ->
  829. Options = [{relay, "localhost"}, {port, 9876}, {hostname, "testing"}, {username, "user"}, {password, "pass"}],
  830. {ok, _Pid} = send({"test@foo.com", ["foo@bar.com"], "hello world"}, Options),
  831. {ok, X} = socket:accept(ListenSock, 1000),
  832. socket:send(X, "220 Some banner\r\n"),
  833. ?assertMatch({ok, "EHLO testing\r\n"}, socket:recv(X, 0, 1000)),
  834. socket:send(X, "250-hostname\r\n250 AUTH LOGIN\r\n"),
  835. ?assertEqual({ok, "AUTH LOGIN\r\n"}, socket:recv(X, 0, 1000)),
  836. socket:send(X, "334 VXNlcm5hbWU6\r\n"),
  837. UserString = binary_to_list(base64:encode("user")),
  838. ?assertEqual({ok, UserString++"\r\n"}, socket:recv(X, 0, 1000)),
  839. socket:send(X, "334 UGFzc3dvcmQ6\r\n"),
  840. PassString = binary_to_list(base64:encode("pass")),
  841. ?assertEqual({ok, PassString++"\r\n"}, socket:recv(X, 0, 1000)),
  842. socket:send(X, "235 ok\r\n"),
  843. ?assertMatch({ok, "MAIL FROM: <test@foo.com>\r\n"}, socket:recv(X, 0, 1000)),
  844. ok
  845. end
  846. }
  847. end,
  848. fun({ListenSock}) ->
  849. {"AUTH CRAM-MD5 should work",
  850. fun() ->
  851. Options = [{relay, "localhost"}, {port, 9876}, {hostname, "testing"}, {username, "user"}, {password, "pass"}],
  852. {ok, _Pid} = send({"test@foo.com", ["foo@bar.com"], "hello world"}, Options),
  853. {ok, X} = socket:accept(ListenSock, 1000),
  854. socket:send(X, "220 Some banner\r\n"),
  855. ?assertMatch({ok, "EHLO testing\r\n"}, socket:recv(X, 0, 1000)),
  856. socket:send(X, "250-hostname\r\n250 AUTH CRAM-MD5\r\n"),
  857. ?assertEqual({ok, "AUTH CRAM-MD5\r\n"}, socket:recv(X, 0, 1000)),
  858. Seed = smtp_util:get_cram_string(smtp_util:guess_FQDN()),
  859. DecodedSeed = base64:decode_to_string(Seed),
  860. Digest = smtp_util:compute_cram_digest("pass", DecodedSeed),
  861. String = binary_to_list(base64:encode(list_to_binary(["user ", Digest]))),
  862. socket:send(X, "334 "++Seed++"\r\n"),
  863. {ok, Packet} = socket:recv(X, 0, 1000),
  864. CramDigest = smtp_util:trim_crlf(Packet),
  865. ?assertEqual(String, CramDigest),
  866. socket:send(X, "235 ok\r\n"),
  867. ?assertMatch({ok, "MAIL FROM: <test@foo.com>\r\n"}, socket:recv(X, 0, 1000)),
  868. ok
  869. end
  870. }
  871. end,
  872. fun({ListenSock}) ->
  873. {"AUTH CRAM-MD5 should work",
  874. fun() ->
  875. Options = [{relay, <<"localhost">>}, {port, 9876}, {hostname, <<"testing">>}, {username, <<"user">>}, {password, <<"pass">>}],
  876. {ok, _Pid} = send({<<"test@foo.com">>, [<<"foo@bar.com">>, <<"baz@bar.com">>], <<"hello world">>}, Options),
  877. {ok, X} = socket:accept(ListenSock, 1000),
  878. socket:send(X, "220 Some banner\r\n"),
  879. ?assertMatch({ok, "EHLO testing\r\n"}, socket:recv(X, 0, 1000)),
  880. socket:send(X, "250-hostname\r\n250 AUTH CRAM-MD5\r\n"),
  881. ?assertEqual({ok, "AUTH CRAM-MD5\r\n"}, socket:recv(X, 0, 1000)),
  882. Seed = smtp_util:get_cram_string(smtp_util:guess_FQDN()),
  883. DecodedSeed = base64:decode_to_string(Seed),
  884. Digest = smtp_util:compute_cram_digest("pass", DecodedSeed),
  885. String = binary_to_list(base64:encode(list_to_binary(["user ", Digest]))),
  886. socket:send(X, "334 "++Seed++"\r\n"),
  887. {ok, Packet} = socket:recv(X, 0, 1000),
  888. CramDigest = smtp_util:trim_crlf(Packet),
  889. ?assertEqual(String, CramDigest),
  890. socket:send(X, "235 ok\r\n"),
  891. ?assertMatch({ok, "MAIL FROM: <test@foo.com>\r\n"}, socket:recv(X, 0, 1000)),
  892. ok
  893. end
  894. }
  895. end,
  896. fun({ListenSock}) ->
  897. {"should bail when AUTH is required but not provided",
  898. fun() ->
  899. Options = [{relay, <<"localhost">>}, {port, 9876}, {hostname, <<"testing">>}, {auth, always}, {username, <<"user">>}, {retries, 0}, {password, <<"pass">>}],
  900. {ok, Pid} = send({<<"test@foo.com">>, [<<"foo@bar.com">>, <<"baz@bar.com">>], <<"hello world">>}, Options),
  901. unlink(Pid),
  902. Monitor = erlang:monitor(process, Pid),
  903. {ok, X} = socket:accept(ListenSock, 1000),
  904. socket:send(X, "220 Some banner\r\n"),
  905. ?assertMatch({ok, "EHLO testing\r\n"}, socket:recv(X, 0, 1000)),
  906. socket:send(X, "250-hostname\r\n250 8BITMIME\r\n"),
  907. ?assertEqual({ok, "QUIT\r\n"}, socket:recv(X, 0, 1000)),
  908. receive {'DOWN', Monitor, _, _, Error} -> ?assertMatch({error, retries_exceeded, {missing_requirement, _, auth}}, Error) end,
  909. ok
  910. end
  911. }
  912. end,
  913. fun({ListenSock}) ->
  914. {"should bail when AUTH is required but of an unsupported type",
  915. fun() ->
  916. Options = [{relay, <<"localhost">>}, {port, 9876}, {hostname, <<"testing">>}, {auth, always}, {username, <<"user">>}, {retries, 0}, {password, <<"pass">>}],
  917. {ok, Pid} = send({<<"test@foo.com">>, [<<"foo@bar.com">>, <<"baz@bar.com">>], <<"hello world">>}, Options),
  918. unlink(Pid),
  919. Monitor = erlang:monitor(process, Pid),
  920. {ok, X} = socket:accept(ListenSock, 1000),
  921. socket:send(X, "220 Some banner\r\n"),
  922. ?assertMatch({ok, "EHLO testing\r\n"}, socket:recv(X, 0, 1000)),
  923. socket:send(X, "250-hostname\r\n250-AUTH GSSAPI\r\n250 8BITMIME\r\n"),
  924. ?assertEqual({ok, "QUIT\r\n"}, socket:recv(X, 0, 1000)),
  925. receive {'DOWN', Monitor, _, _, Error} -> ?assertMatch({error, no_more_hosts, {permanent_failure, _, auth_failed}}, Error) end,
  926. ok
  927. end
  928. }
  929. end,
  930. fun({_ListenSock}) ->
  931. {"Connecting to a SSL socket directly should work",
  932. fun() ->
  933. application:start(crypto),
  934. application:start(public_key),
  935. application:start(ssl),
  936. {ok, ListenSock} = socket:listen(ssl, 9877, [{certfile, "../testdata/server.crt"}, {keyfile, "../testdata/server.key"}]),
  937. Options = [{relay, <<"localhost">>}, {port, 9877}, {hostname, <<"testing">>}, {ssl, true}],
  938. {ok, _Pid} = send({<<"test@foo.com">>, [<<"<foo@bar.com>">>, <<"baz@bar.com">>], <<"hello world">>}, Options),
  939. {ok, X} = socket:accept(ListenSock, 1000),
  940. socket:send(X, "220 Some banner\r\n"),
  941. ?assertMatch({ok, "EHLO testing\r\n"}, socket:recv(X, 0, 1000)),
  942. socket:send(X, "250-hostname\r\n250 AUTH CRAM-MD5\r\n"),
  943. ?assertEqual({ok, "MAIL FROM: <test@foo.com>\r\n"}, socket:recv(X, 0, 1000)),
  944. socket:send(X, "250 ok\r\n"),
  945. ?assertMatch({ok, "RCPT TO: <foo@bar.com>\r\n"}, socket:recv(X, 0, 1000)),
  946. socket:send(X, "250 ok\r\n"),
  947. ?assertMatch({ok, "RCPT TO: <baz@bar.com>\r\n"}, socket:recv(X, 0, 1000)),
  948. socket:send(X, "250 ok\r\n"),
  949. ?assertMatch({ok, "DATA\r\n"}, socket:recv(X, 0, 1000)),
  950. socket:send(X, "354 ok\r\n"),
  951. ?assertMatch({ok, "hello world\r\n"}, socket:recv(X, 0, 1000)),
  952. ?assertMatch({ok, ".\r\n"}, socket:recv(X, 0, 1000)),
  953. socket:send(X, "250 ok\r\n"),
  954. ?assertMatch({ok, "QUIT\r\n"}, socket:recv(X, 0, 1000)),
  955. socket:close(ListenSock),
  956. ok
  957. end
  958. }
  959. end
  960. ]
  961. }.
  962. extension_parse_test_() ->
  963. [
  964. {"parse extensions",
  965. fun() ->
  966. Res = parse_extensions(<<"250-smtp.example.com\r\n250-PIPELINING\r\n250-SIZE 20971520\r\n250-VRFY\r\n250-ETRN\r\n250-STARTTLS\r\n250-AUTH CRAM-MD5 PLAIN DIGEST-MD5 LOGIN\r\n250-AUTH=CRAM-MD5 PLAIN DIGEST-MD5 LOGIN\r\n250-ENHANCEDSTATUSCODES\r\n250-8BITMIME\r\n250 DSN">>),
  967. ?assertEqual(true, proplists:get_value(<<"PIPELINING">>, Res)),
  968. ?assertEqual(<<"20971520">>, proplists:get_value(<<"SIZE">>, Res)),
  969. ?assertEqual(true, proplists:get_value(<<"VRFY">>, Res)),
  970. ?assertEqual(true, proplists:get_value(<<"ETRN">>, Res)),
  971. ?assertEqual(true, proplists:get_value(<<"STARTTLS">>, Res)),
  972. ?assertEqual(<<"CRAM-MD5 PLAIN DIGEST-MD5 LOGIN">>, proplists:get_value(<<"AUTH">>, Res)),
  973. ?assertEqual(true, proplists:get_value(<<"ENHANCEDSTATUSCODES">>, Res)),
  974. ?assertEqual(true, proplists:get_value(<<"8BITMIME">>, Res)),
  975. ?assertEqual(true, proplists:get_value(<<"DSN">>, Res)),
  976. ?assertEqual(10, length(Res)),
  977. ok
  978. end
  979. }
  980. ].
  981. -endif.