PageRenderTime 52ms CodeModel.GetById 19ms RepoModel.GetById 0ms app.codeStats 1ms

/src/gen_smtp_client.erl

https://github.com/JackDanger/gen_smtp
Erlang | 974 lines | 859 code | 37 blank | 78 comment | 7 complexity | df41e10bacbb70be9187762010d6ff8e 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:{permanant_failure, Message} ->
  134. % permanant failure means no retries, and don't even continue with other hosts
  135. {error, no_more_hosts, {permanant_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({permanant_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({permanant_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({permanant_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({permanant_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({permanant_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. socket:send(Socket, ["EHLO ", proplists:get_value(hostname, Options, smtp_util:guess_FQDN()), "\r\n"]),
  376. %% TODO handle fallback to HELO!
  377. {ok, Reply} = read_possible_multiline_reply(Socket),
  378. Extensions = parse_extensions(Reply),
  379. {ok, Extensions}.
  380. % check if we should try to do TLS
  381. -spec try_STARTTLS(Socket :: socket:socket(), Options :: list(), Extensions :: list()) -> {socket:socket(), list()}.
  382. try_STARTTLS(Socket, Options, Extensions) ->
  383. case {proplists:get_value(tls, Options),
  384. proplists:get_value(<<"STARTTLS">>, Extensions)} of
  385. {Atom, true} when Atom =:= always; Atom =:= if_available ->
  386. %io:format("Starting TLS~n"),
  387. case {do_STARTTLS(Socket, Options), Atom} of
  388. {false, always} ->
  389. %io:format("TLS failed~n"),
  390. quit(Socket),
  391. erlang:throw({temporary_failure, tls_failed});
  392. {false, if_available} ->
  393. %io:format("TLS failed~n"),
  394. {Socket, Extensions};
  395. {{S, E}, _} ->
  396. %io:format("TLS started~n"),
  397. {S, E}
  398. end;
  399. {always, _} ->
  400. quit(Socket),
  401. erlang:throw({missing_requirement, tls});
  402. _ ->
  403. {Socket, Extensions}
  404. end.
  405. %% attempt to upgrade socket to TLS
  406. -spec do_STARTTLS(Socket :: socket:socket(), Options :: list()) -> {socket:socket(), list()} | false.
  407. do_STARTTLS(Socket, Options) ->
  408. socket:send(Socket, "STARTTLS\r\n"),
  409. case read_possible_multiline_reply(Socket) of
  410. {ok, <<"220", _Rest/binary>>} ->
  411. application:start(crypto),
  412. application:start(public_key),
  413. application:start(ssl),
  414. case socket:to_ssl_client(Socket, [], 5000) of
  415. {ok, NewSocket} ->
  416. %NewSocket;
  417. {ok, Extensions} = try_EHLO(NewSocket, Options),
  418. {NewSocket, Extensions};
  419. _Else ->
  420. %io:format("~p~n", [Else]),
  421. false
  422. end;
  423. {ok, <<"4", _Rest/binary>> = Msg} ->
  424. quit(Socket),
  425. throw({temporary_failure, Msg});
  426. {ok, Msg} ->
  427. quit(Socket),
  428. throw({permanant_failure, Msg})
  429. end.
  430. %% try connecting to a host
  431. connect(Host, Options) when is_binary(Host) ->
  432. connect(binary_to_list(Host), Options);
  433. connect(Host, Options) ->
  434. SockOpts = [binary, {packet, line}, {keepalive, true}, {active, false}],
  435. Proto = case proplists:get_value(ssl, Options) of
  436. true ->
  437. application:start(crypto),
  438. application:start(public_key),
  439. application:start(ssl),
  440. ssl;
  441. _ ->
  442. tcp
  443. end,
  444. Port = case proplists:get_value(port, Options) of
  445. undefined when Proto =:= ssl ->
  446. 465;
  447. OPort when is_integer(OPort) ->
  448. OPort;
  449. _ ->
  450. 25
  451. end,
  452. case socket:connect(Proto, Host, Port, SockOpts, 5000) of
  453. {ok, Socket} ->
  454. case read_possible_multiline_reply(Socket) of
  455. {ok, <<"220", Banner/binary>>} ->
  456. {ok, Socket, Host, Banner};
  457. {ok, <<"4", _Rest/binary>> = Msg} ->
  458. quit(Socket),
  459. throw({temporary_failure, Msg});
  460. {ok, Msg} ->
  461. quit(Socket),
  462. throw({permanant_failure, Msg})
  463. end;
  464. {error, Reason} ->
  465. throw({network_failure, {error, Reason}})
  466. end.
  467. %% read a multiline reply (eg. EHLO reply)
  468. -spec read_possible_multiline_reply(Socket :: socket:socket()) -> {ok, binary()}.
  469. read_possible_multiline_reply(Socket) ->
  470. case socket:recv(Socket, 0, ?TIMEOUT) of
  471. {ok, Packet} ->
  472. case binstr:substr(Packet, 4, 1) of
  473. <<"-">> ->
  474. Code = binstr:substr(Packet, 1, 3),
  475. read_multiline_reply(Socket, Code, [Packet]);
  476. <<" ">> ->
  477. {ok, Packet}
  478. end;
  479. Error ->
  480. throw({network_failure, Error})
  481. end.
  482. -spec read_multiline_reply(Socket :: socket:socket(), Code :: binary(), Acc :: [binary()]) -> {ok, binary()}.
  483. read_multiline_reply(Socket, Code, Acc) ->
  484. case socket:recv(Socket, 0, ?TIMEOUT) of
  485. {ok, Packet} ->
  486. case {binstr:substr(Packet, 1, 3), binstr:substr(Packet, 4, 1)} of
  487. {Code, <<" ">>} ->
  488. {ok, list_to_binary(lists:reverse([Packet | Acc]))};
  489. {Code, <<"-">>} ->
  490. read_multiline_reply(Socket, Code, [Packet | Acc]);
  491. _ ->
  492. quit(Socket),
  493. throw({unexpected_response, lists:reverse([Packet | Acc])})
  494. end;
  495. Error ->
  496. throw({network_failure, Error})
  497. end.
  498. quit(Socket) ->
  499. socket:send(Socket, "QUIT\r\n"),
  500. socket:close(Socket),
  501. ok.
  502. % TODO - more checking
  503. check_options(Options) ->
  504. case proplists:get_value(relay, Options) of
  505. undefined ->
  506. {error, no_relay};
  507. _ ->
  508. case proplists:get_value(auth, Options) of
  509. Atom when Atom =:= always ->
  510. case proplists:is_defined(username, Options) and
  511. proplists:is_defined(password, Options) of
  512. false ->
  513. {error, no_credentials};
  514. true ->
  515. ok
  516. end;
  517. _ ->
  518. ok
  519. end
  520. end.
  521. -spec parse_extensions(Reply :: binary()) -> [{binary(), binary()}].
  522. parse_extensions(Reply) ->
  523. [_ | Reply2] = re:split(Reply, "\r\n", [{return, binary}, trim]),
  524. [
  525. begin
  526. Body = binstr:substr(Entry, 5),
  527. case re:split(Body, " ", [{return, binary}, trim, {parts, 2}]) of
  528. [Verb, Parameters] ->
  529. {binstr:to_upper(Verb), Parameters};
  530. [Body] ->
  531. case binstr:strchr(Body, $=) of
  532. 0 ->
  533. {binstr:to_upper(Body), true};
  534. _ ->
  535. %io:format("discarding option ~p~n", [Body]),
  536. []
  537. end
  538. end
  539. end || Entry <- Reply2].
  540. -ifdef(TEST).
  541. session_start_test_() ->
  542. {foreach,
  543. local,
  544. fun() ->
  545. {ok, ListenSock} = socket:listen(tcp, 9876),
  546. {ListenSock}
  547. end,
  548. fun({ListenSock}) ->
  549. socket:close(ListenSock)
  550. end,
  551. [fun({ListenSock}) ->
  552. {"simple session initiation",
  553. fun() ->
  554. Options = [{relay, "localhost"}, {port, 9876}, {hostname, "testing"}],
  555. {ok, _Pid} = send({"test@foo.com", ["foo@bar.com"], "hello world"}, Options),
  556. {ok, X} = socket:accept(ListenSock, 1000),
  557. socket:send(X, "220 Some banner\r\n"),
  558. ?assertMatch({ok, "EHLO testing\r\n"}, socket:recv(X, 0, 1000)),
  559. ok
  560. end
  561. }
  562. end,
  563. fun({ListenSock}) ->
  564. {"retry on crashed EHLO twice if requested",
  565. fun() ->
  566. Options = [{relay, "localhost"}, {port, 9876}, {hostname, "testing"}, {retries, 2}],
  567. {ok, _Pid} = send({"test@foo.com", ["foo@bar.com"], "hello world"}, Options),
  568. {ok, X} = socket:accept(ListenSock, 1000),
  569. socket:send(X, "220 Some banner\r\n"),
  570. ?assertMatch({ok, "EHLO testing\r\n"}, socket:recv(X, 0, 1000)),
  571. socket:close(X),
  572. {ok, Y} = socket:accept(ListenSock, 1000),
  573. socket:send(Y, "220 Some banner\r\n"),
  574. ?assertMatch({ok, "EHLO testing\r\n"}, socket:recv(Y, 0, 1000)),
  575. socket:close(Y),
  576. {ok, Z} = socket:accept(ListenSock, 1000),
  577. socket:send(Z, "220 Some banner\r\n"),
  578. ?assertMatch({ok, "EHLO testing\r\n"}, socket:recv(Z, 0, 1000)),
  579. ok
  580. end
  581. }
  582. end,
  583. fun({ListenSock}) ->
  584. {"retry on crashed EHLO",
  585. fun() ->
  586. Options = [{relay, "localhost"}, {port, 9876}, {hostname, "testing"}],
  587. {ok, Pid} = send({"test@foo.com", ["foo@bar.com"], "hello world"}, Options),
  588. unlink(Pid),
  589. Monitor = erlang:monitor(process, Pid),
  590. {ok, X} = socket:accept(ListenSock, 1000),
  591. socket:send(X, "220 Some banner\r\n"),
  592. ?assertMatch({ok, "EHLO testing\r\n"}, socket:recv(X, 0, 1000)),
  593. socket:close(X),
  594. {ok, Y} = socket:accept(ListenSock, 1000),
  595. socket:send(Y, "220 Some banner\r\n"),
  596. ?assertMatch({ok, "EHLO testing\r\n"}, socket:recv(Y, 0, 1000)),
  597. socket:close(Y),
  598. ?assertEqual({error, timeout}, socket:accept(ListenSock, 1000)),
  599. receive {'DOWN', Monitor, _, _, Error} -> ?assertMatch({error, retries_exceeded, _}, Error) end,
  600. ok
  601. end
  602. }
  603. end,
  604. fun({ListenSock}) ->
  605. {"abort on 554 greeting",
  606. fun() ->
  607. Options = [{relay, "localhost"}, {port, 9876}, {hostname, "testing"}],
  608. {ok, Pid} = send({"test@foo.com", ["foo@bar.com"], "hello world"}, Options),
  609. unlink(Pid),
  610. Monitor = erlang:monitor(process, Pid),
  611. {ok, X} = socket:accept(ListenSock, 1000),
  612. socket:send(X, "554 get lost, kid\r\n"),
  613. ?assertMatch({ok, "QUIT\r\n"}, socket:recv(X, 0, 1000)),
  614. receive {'DOWN', Monitor, _, _, Error} -> ?assertMatch({error, no_more_hosts, _}, Error) end,
  615. ok
  616. end
  617. }
  618. end,
  619. fun({ListenSock}) ->
  620. {"retry on 421 greeting",
  621. fun() ->
  622. Options = [{relay, "localhost"}, {port, 9876}, {hostname, "testing"}],
  623. {ok, _Pid} = send({"test@foo.com", ["foo@bar.com"], "hello world"}, Options),
  624. {ok, X} = socket:accept(ListenSock, 1000),
  625. socket:send(X, "421 can't you see I'm busy?\r\n"),
  626. ?assertMatch({ok, "QUIT\r\n"}, socket:recv(X, 0, 1000)),
  627. {ok, Y} = socket:accept(ListenSock, 1000),
  628. socket:send(Y, "220 Some banner\r\n"),
  629. ?assertMatch({ok, "EHLO testing\r\n"}, socket:recv(Y, 0, 1000)),
  630. ok
  631. end
  632. }
  633. end,
  634. fun({ListenSock}) ->
  635. {"retry on messed up EHLO response",
  636. fun() ->
  637. Options = [{relay, "localhost"}, {port, 9876}, {hostname, "testing"}],
  638. {ok, Pid} = send({"test@foo.com", ["foo@bar.com"], "hello world"}, Options),
  639. unlink(Pid),
  640. Monitor = erlang:monitor(process, Pid),
  641. {ok, X} = socket:accept(ListenSock, 1000),
  642. socket:send(X, "220 Some banner\r\n"),
  643. ?assertMatch({ok, "EHLO testing\r\n"}, socket:recv(X, 0, 1000)),
  644. socket:send(X, "250-server.example.com EHLO\r\n250-AUTH LOGIN PLAIN\r\n421 too 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. socket:send(Y, "250-server.example.com EHLO\r\n250-AUTH LOGIN PLAIN\r\n421 too busy\r\n"),
  650. ?assertMatch({ok, "QUIT\r\n"}, socket:recv(Y, 0, 1000)),
  651. receive {'DOWN', Monitor, _, _, Error} -> ?assertMatch({error, retries_exceeded, _}, Error) end,
  652. ok
  653. end
  654. }
  655. end,
  656. fun({ListenSock}) ->
  657. {"a valid complete transaction without TLS advertised should succeed",
  658. fun() ->
  659. Options = [{relay, "localhost"}, {port, 9876}, {hostname, "testing"}],
  660. {ok, _Pid} = send({"test@foo.com", ["foo@bar.com"], "hello world"}, Options),
  661. {ok, X} = socket:accept(ListenSock, 1000),
  662. socket:send(X, "220 Some banner\r\n"),
  663. ?assertMatch({ok, "EHLO testing\r\n"}, socket:recv(X, 0, 1000)),
  664. socket:send(X, "250 hostname\r\n"),
  665. ?assertMatch({ok, "MAIL FROM: <test@foo.com>\r\n"}, socket:recv(X, 0, 1000)),
  666. socket:send(X, "250 ok\r\n"),
  667. ?assertMatch({ok, "RCPT TO: <foo@bar.com>\r\n"}, socket:recv(X, 0, 1000)),
  668. socket:send(X, "250 ok\r\n"),
  669. ?assertMatch({ok, "DATA\r\n"}, socket:recv(X, 0, 1000)),
  670. socket:send(X, "354 ok\r\n"),
  671. ?assertMatch({ok, "hello world\r\n"}, socket:recv(X, 0, 1000)),
  672. ?assertMatch({ok, ".\r\n"}, socket:recv(X, 0, 1000)),
  673. socket:send(X, "250 ok\r\n"),
  674. ?assertMatch({ok, "QUIT\r\n"}, socket:recv(X, 0, 1000)),
  675. ok
  676. end
  677. }
  678. end,
  679. fun({ListenSock}) ->
  680. {"a valid complete transaction with binary arguments shoyld succeed",
  681. fun() ->
  682. Options = [{relay, "localhost"}, {port, 9876}, {hostname, "testing"}],
  683. {ok, _Pid} = send({<<"test@foo.com">>, [<<"foo@bar.com">>], <<"hello world">>}, Options),
  684. {ok, X} = socket:accept(ListenSock, 1000),
  685. socket:send(X, "220 Some banner\r\n"),
  686. ?assertMatch({ok, "EHLO testing\r\n"}, socket:recv(X, 0, 1000)),
  687. socket:send(X, "250 hostname\r\n"),
  688. ?assertMatch({ok, "MAIL FROM: <test@foo.com>\r\n"}, socket:recv(X, 0, 1000)),
  689. socket:send(X, "250 ok\r\n"),
  690. ?assertMatch({ok, "RCPT TO: <foo@bar.com>\r\n"}, socket:recv(X, 0, 1000)),
  691. socket:send(X, "250 ok\r\n"),
  692. ?assertMatch({ok, "DATA\r\n"}, socket:recv(X, 0, 1000)),
  693. socket:send(X, "354 ok\r\n"),
  694. ?assertMatch({ok, "hello world\r\n"}, socket:recv(X, 0, 1000)),
  695. ?assertMatch({ok, ".\r\n"}, socket:recv(X, 0, 1000)),
  696. socket:send(X, "250 ok\r\n"),
  697. ?assertMatch({ok, "QUIT\r\n"}, socket:recv(X, 0, 1000)),
  698. ok
  699. end
  700. }
  701. end,
  702. fun({ListenSock}) ->
  703. {"a valid complete transaction with TLS advertised should succeed",
  704. fun() ->
  705. Options = [{relay, "localhost"}, {port, 9876}, {hostname, <<"testing">>}],
  706. {ok, _Pid} = send({"test@foo.com", ["foo@bar.com"], "hello world"}, Options),
  707. {ok, X} = socket:accept(ListenSock, 1000),
  708. socket:send(X, "220 Some banner\r\n"),
  709. ?assertMatch({ok, "EHLO testing\r\n"}, socket:recv(X, 0, 1000)),
  710. socket:send(X, "250-hostname\r\n250 STARTTLS\r\n"),
  711. ?assertMatch({ok, "STARTTLS\r\n"}, socket:recv(X, 0, 1000)),
  712. application:start(crypto),
  713. application:start(public_key),
  714. application:start(ssl),
  715. socket:send(X, "220 ok\r\n"),
  716. {ok, Y} = socket:to_ssl_server(X, [{certfile, "../testdata/server.crt"}, {keyfile, "../testdata/server.key"}], 5000),
  717. ?assertMatch({ok, "EHLO testing\r\n"}, socket:recv(Y, 0, 1000)),
  718. socket:send(Y, "250-hostname\r\n250 STARTTLS\r\n"),
  719. ?assertMatch({ok, "MAIL FROM: <test@foo.com>\r\n"}, socket:recv(Y, 0, 1000)),
  720. socket:send(Y, "250 ok\r\n"),
  721. ?assertMatch({ok, "RCPT TO: <foo@bar.com>\r\n"}, socket:recv(Y, 0, 1000)),
  722. socket:send(Y, "250 ok\r\n"),
  723. ?assertMatch({ok, "DATA\r\n"}, socket:recv(Y, 0, 1000)),
  724. socket:send(Y, "354 ok\r\n"),
  725. ?assertMatch({ok, "hello world\r\n"}, socket:recv(Y, 0, 1000)),
  726. ?assertMatch({ok, ".\r\n"}, socket:recv(Y, 0, 1000)),
  727. socket:send(Y, "250 ok\r\n"),
  728. ?assertMatch({ok, "QUIT\r\n"}, socket:recv(Y, 0, 1000)),
  729. ok
  730. end
  731. }
  732. end,
  733. fun({ListenSock}) ->
  734. {"a valid complete transaction with TLS advertised and binary arguments should succeed",
  735. fun() ->
  736. Options = [{relay, "localhost"}, {port, 9876}, {hostname, <<"testing">>}],
  737. {ok, _Pid} = send({<<"test@foo.com">>, [<<"foo@bar.com">>], <<"hello world">>}, Options),
  738. {ok, X} = socket:accept(ListenSock, 1000),
  739. socket:send(X, "220 Some banner\r\n"),
  740. ?assertMatch({ok, "EHLO testing\r\n"}, socket:recv(X, 0, 1000)),
  741. socket:send(X, "250-hostname\r\n250 STARTTLS\r\n"),
  742. ?assertMatch({ok, "STARTTLS\r\n"}, socket:recv(X, 0, 1000)),
  743. application:start(crypto),
  744. application:start(public_key),
  745. application:start(ssl),
  746. socket:send(X, "220 ok\r\n"),
  747. {ok, Y} = socket:to_ssl_server(X, [{certfile, "../testdata/server.crt"}, {keyfile, "../testdata/server.key"}], 5000),
  748. ?assertMatch({ok, "EHLO testing\r\n"}, socket:recv(Y, 0, 1000)),
  749. socket:send(Y, "250-hostname\r\n250 STARTTLS\r\n"),
  750. ?assertMatch({ok, "MAIL FROM: <test@foo.com>\r\n"}, socket:recv(Y, 0, 1000)),
  751. socket:send(Y, "250 ok\r\n"),
  752. ?assertMatch({ok, "RCPT TO: <foo@bar.com>\r\n"}, socket:recv(Y, 0, 1000)),
  753. socket:send(Y, "250 ok\r\n"),
  754. ?assertMatch({ok, "DATA\r\n"}, socket:recv(Y, 0, 1000)),
  755. socket:send(Y, "354 ok\r\n"),
  756. ?assertMatch({ok, "hello world\r\n"}, socket:recv(Y, 0, 1000)),
  757. ?assertMatch({ok, ".\r\n"}, socket:recv(Y, 0, 1000)),
  758. socket:send(Y, "250 ok\r\n"),
  759. ?assertMatch({ok, "QUIT\r\n"}, socket:recv(Y, 0, 1000)),
  760. ok
  761. end
  762. }
  763. end,
  764. fun({ListenSock}) ->
  765. {"AUTH PLAIN should work",
  766. fun() ->
  767. Options = [{relay, "localhost"}, {port, 9876}, {hostname, "testing"}, {username, "user"}, {password, "pass"}],
  768. {ok, _Pid} = send({"test@foo.com", ["foo@bar.com"], "hello world"}, Options),
  769. {ok, X} = socket:accept(ListenSock, 1000),
  770. socket:send(X, "220 Some banner\r\n"),
  771. ?assertMatch({ok, "EHLO testing\r\n"}, socket:recv(X, 0, 1000)),
  772. socket:send(X, "250-hostname\r\n250 AUTH PLAIN\r\n"),
  773. AuthString = binary_to_list(base64:encode("\0user\0pass")),
  774. AuthPacket = "AUTH PLAIN "++AuthString++"\r\n",
  775. ?assertEqual({ok, AuthPacket}, socket:recv(X, 0, 1000)),
  776. socket:send(X, "235 ok\r\n"),
  777. ?assertMatch({ok, "MAIL FROM: <test@foo.com>\r\n"}, socket:recv(X, 0, 1000)),
  778. ok
  779. end
  780. }
  781. end,
  782. fun({ListenSock}) ->
  783. {"AUTH LOGIN should work",
  784. fun() ->
  785. Options = [{relay, "localhost"}, {port, 9876}, {hostname, "testing"}, {username, "user"}, {password, "pass"}],
  786. {ok, _Pid} = send({"test@foo.com", ["foo@bar.com"], "hello world"}, Options),
  787. {ok, X} = socket:accept(ListenSock, 1000),
  788. socket:send(X, "220 Some banner\r\n"),
  789. ?assertMatch({ok, "EHLO testing\r\n"}, socket:recv(X, 0, 1000)),
  790. socket:send(X, "250-hostname\r\n250 AUTH LOGIN\r\n"),
  791. ?assertEqual({ok, "AUTH LOGIN\r\n"}, socket:recv(X, 0, 1000)),
  792. socket:send(X, "334 VXNlcm5hbWU6\r\n"),
  793. UserString = binary_to_list(base64:encode("user")),
  794. ?assertEqual({ok, UserString++"\r\n"}, socket:recv(X, 0, 1000)),
  795. socket:send(X, "334 UGFzc3dvcmQ6\r\n"),
  796. PassString = binary_to_list(base64:encode("pass")),
  797. ?assertEqual({ok, PassString++"\r\n"}, socket:recv(X, 0, 1000)),
  798. socket:send(X, "235 ok\r\n"),
  799. ?assertMatch({ok, "MAIL FROM: <test@foo.com>\r\n"}, socket:recv(X, 0, 1000)),
  800. ok
  801. end
  802. }
  803. end,
  804. fun({ListenSock}) ->
  805. {"AUTH CRAM-MD5 should work",
  806. fun() ->
  807. Options = [{relay, "localhost"}, {port, 9876}, {hostname, "testing"}, {username, "user"}, {password, "pass"}],
  808. {ok, _Pid} = send({"test@foo.com", ["foo@bar.com"], "hello world"}, Options),
  809. {ok, X} = socket:accept(ListenSock, 1000),
  810. socket:send(X, "220 Some banner\r\n"),
  811. ?assertMatch({ok, "EHLO testing\r\n"}, socket:recv(X, 0, 1000)),
  812. socket:send(X, "250-hostname\r\n250 AUTH CRAM-MD5\r\n"),
  813. ?assertEqual({ok, "AUTH CRAM-MD5\r\n"}, socket:recv(X, 0, 1000)),
  814. Seed = smtp_util:get_cram_string(smtp_util:guess_FQDN()),
  815. DecodedSeed = base64:decode_to_string(Seed),
  816. Digest = smtp_util:compute_cram_digest("pass", DecodedSeed),
  817. String = binary_to_list(base64:encode(list_to_binary(["user ", Digest]))),
  818. socket:send(X, "334 "++Seed++"\r\n"),
  819. {ok, Packet} = socket:recv(X, 0, 1000),
  820. CramDigest = smtp_util:trim_crlf(Packet),
  821. ?assertEqual(String, CramDigest),
  822. socket:send(X, "235 ok\r\n"),
  823. ?assertMatch({ok, "MAIL FROM: <test@foo.com>\r\n"}, socket:recv(X, 0, 1000)),
  824. ok
  825. end
  826. }
  827. end,
  828. fun({ListenSock}) ->
  829. {"AUTH CRAM-MD5 should work",
  830. fun() ->
  831. Options = [{relay, <<"localhost">>}, {port, 9876}, {hostname, <<"testing">>}, {username, <<"user">>}, {password, <<"pass">>}],
  832. {ok, _Pid} = send({<<"test@foo.com">>, [<<"foo@bar.com">>, <<"baz@bar.com">>], <<"hello world">>}, Options),
  833. {ok, X} = socket:accept(ListenSock, 1000),
  834. socket:send(X, "220 Some banner\r\n"),
  835. ?assertMatch({ok, "EHLO testing\r\n"}, socket:recv(X, 0, 1000)),
  836. socket:send(X, "250-hostname\r\n250 AUTH CRAM-MD5\r\n"),
  837. ?assertEqual({ok, "AUTH CRAM-MD5\r\n"}, socket:recv(X, 0, 1000)),
  838. Seed = smtp_util:get_cram_string(smtp_util:guess_FQDN()),
  839. DecodedSeed = base64:decode_to_string(Seed),
  840. Digest = smtp_util:compute_cram_digest("pass", DecodedSeed),
  841. String = binary_to_list(base64:encode(list_to_binary(["user ", Digest]))),
  842. socket:send(X, "334 "++Seed++"\r\n"),
  843. {ok, Packet} = socket:recv(X, 0, 1000),
  844. CramDigest = smtp_util:trim_crlf(Packet),
  845. ?assertEqual(String, CramDigest),
  846. socket:send(X, "235 ok\r\n"),
  847. ?assertMatch({ok, "MAIL FROM: <test@foo.com>\r\n"}, socket:recv(X, 0, 1000)),
  848. ok
  849. end
  850. }
  851. end,
  852. fun({ListenSock}) ->
  853. {"should bail when AUTH is required but not provided",
  854. fun() ->
  855. Options = [{relay, <<"localhost">>}, {port, 9876}, {hostname, <<"testing">>}, {auth, always}, {username, <<"user">>}, {retries, 0}, {password, <<"pass">>}],
  856. {ok, Pid} = send({<<"test@foo.com">>, [<<"foo@bar.com">>, <<"baz@bar.com">>], <<"hello world">>}, Options),
  857. unlink(Pid),
  858. Monitor = erlang:monitor(process, Pid),
  859. {ok, X} = socket:accept(ListenSock, 1000),
  860. socket:send(X, "220 Some banner\r\n"),
  861. ?assertMatch({ok, "EHLO testing\r\n"}, socket:recv(X, 0, 1000)),
  862. socket:send(X, "250-hostname\r\n250 8BITMIME\r\n"),
  863. ?assertEqual({ok, "QUIT\r\n"}, socket:recv(X, 0, 1000)),
  864. receive {'DOWN', Monitor, _, _, Error} -> ?assertMatch({error, retries_exceeded, {missing_requirement, _, auth}}, Error) end,
  865. ok
  866. end
  867. }
  868. end,
  869. fun({ListenSock}) ->
  870. {"should bail when AUTH is required but of an unsupported type",
  871. fun() ->
  872. Options = [{relay, <<"localhost">>}, {port, 9876}, {hostname, <<"testing">>}, {auth, always}, {username, <<"user">>}, {retries, 0}, {password, <<"pass">>}],
  873. {ok, Pid} = send({<<"test@foo.com">>, [<<"foo@bar.com">>, <<"baz@bar.com">>], <<"hello world">>}, Options),
  874. unlink(Pid),
  875. Monitor = erlang:monitor(process, Pid),
  876. {ok, X} = socket:accept(ListenSock, 1000),
  877. socket:send(X, "220 Some banner\r\n"),
  878. ?assertMatch({ok, "EHLO testing\r\n"}, socket:recv(X, 0, 1000)),
  879. socket:send(X, "250-hostname\r\n250-AUTH GSSAPI\r\n250 8BITMIME\r\n"),
  880. ?assertEqual({ok, "QUIT\r\n"}, socket:recv(X, 0, 1000)),
  881. receive {'DOWN', Monitor, _, _, Error} -> ?assertMatch({error, no_more_hosts, {permanant_failure, _, auth_failed}}, Error) end,
  882. ok
  883. end
  884. }
  885. end,
  886. fun({_ListenSock}) ->
  887. {"Connecting to a SSL socket directly should work",
  888. fun() ->
  889. application:start(crypto),
  890. application:start(public_key),
  891. application:start(ssl),
  892. {ok, ListenSock} = socket:listen(ssl, 9877, [{certfile, "../testdata/server.crt"}, {keyfile, "../testdata/server.key"}]),
  893. Options = [{relay, <<"localhost">>}, {port, 9877}, {hostname, <<"testing">>}, {ssl, true}],
  894. {ok, _Pid} = send({<<"test@foo.com">>, [<<"<foo@bar.com>">>, <<"baz@bar.com">>], <<"hello world">>}, Options),
  895. {ok, X} = socket:accept(ListenSock, 1000),
  896. socket:send(X, "220 Some banner\r\n"),
  897. ?assertMatch({ok, "EHLO testing\r\n"}, socket:recv(X, 0, 1000)),
  898. socket:send(X, "250-hostname\r\n250 AUTH CRAM-MD5\r\n"),
  899. ?assertEqual({ok, "MAIL FROM: <test@foo.com>\r\n"}, socket:recv(X, 0, 1000)),
  900. socket:send(X, "250 ok\r\n"),
  901. ?assertMatch({ok, "RCPT TO: <foo@bar.com>\r\n"}, socket:recv(X, 0, 1000)),
  902. socket:send(X, "250 ok\r\n"),
  903. ?assertMatch({ok, "RCPT TO: <baz@bar.com>\r\n"}, socket:recv(X, 0, 1000)),
  904. socket:send(X, "250 ok\r\n"),
  905. ?assertMatch({ok, "DATA\r\n"}, socket:recv(X, 0, 1000)),
  906. socket:send(X, "354 ok\r\n"),
  907. ?assertMatch({ok, "hello world\r\n"}, socket:recv(X, 0, 1000)),
  908. ?assertMatch({ok, ".\r\n"}, socket:recv(X, 0, 1000)),
  909. socket:send(X, "250 ok\r\n"),
  910. ?assertMatch({ok, "QUIT\r\n"}, socket:recv(X, 0, 1000)),
  911. socket:close(ListenSock),
  912. ok
  913. end
  914. }
  915. end
  916. ]
  917. }.
  918. extension_parse_test_() ->
  919. [
  920. {"parse extensions",
  921. fun() ->
  922. 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">>),
  923. ?assertEqual(true, proplists:get_value(<<"PIPELINING">>, Res)),
  924. ?assertEqual(<<"20971520">>, proplists:get_value(<<"SIZE">>, Res)),
  925. ?assertEqual(true, proplists:get_value(<<"VRFY">>, Res)),
  926. ?assertEqual(true, proplists:get_value(<<"ETRN">>, Res)),
  927. ?assertEqual(true, proplists:get_value(<<"STARTTLS">>, Res)),
  928. ?assertEqual(<<"CRAM-MD5 PLAIN DIGEST-MD5 LOGIN">>, proplists:get_value(<<"AUTH">>, Res)),
  929. ?assertEqual(true, proplists:get_value(<<"ENHANCEDSTATUSCODES">>, Res)),
  930. ?assertEqual(true, proplists:get_value(<<"8BITMIME">>, Res)),
  931. ?assertEqual(true, proplists:get_value(<<"DSN">>, Res)),
  932. ?assertEqual(10, length(Res)),
  933. ok
  934. end
  935. }
  936. ].
  937. -endif.