1/* Author: Jan Wielemaker 2 E-mail: J.Wielemaker@vu.nl 3 WWW: http://www.swi-prolog.org 4 Copyright (C): 2012-2017, VU University Amsterdam 5 CWI Amsterdam 6 All rights reserved. 7 8 Redistribution and use in source and binary forms, with or without 9 modification, are permitted provided that the following conditions 10 are met: 11 12 1. Redistributions of source code must retain the above copyright 13 notice, this list of conditions and the following disclaimer. 14 15 2. Redistributions in binary form must reproduce the above copyright 16 notice, this list of conditions and the following disclaimer in 17 the documentation and/or other materials provided with the 18 distribution. 19 20 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 23 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 24 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 25 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 26 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 27 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 28 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 29 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 30 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 31 POSSIBILITY OF SUCH DAMAGE. 32*/ 33 34:- module(smtp, 35 [ smtp_send_mail/3 % +To, :Goal, +Options 36 ]). 37:- use_module(library(socket)). 38:- use_module(library(ssl)). 39:- use_module(library(readutil)). 40:- use_module(library(settings)). 41:- use_module(library(option)). 42:- use_module(library(lists)). 43:- use_module(library(debug)). 44:- use_module(library(error)). 45:- use_module(library(dcg/basics)). 46 47:- meta_predicate 48 smtp_send_mail(, , ).
79:- setting(host, atom, localhost, 80 'Name of the SMTP host for relaying the mail'). 81:- setting(port, integer, 0, 82 'Port on which the SMTP host listens (0: default)'). 83:- setting(security, oneof([none,ssl,tls,starttls]), none, 84 'Security system to use'). 85:- setting(from, atom, '', 86 'Default from-address'). 87:- setting(user, atom, '', 88 'Default user to authenticate'). 89:- setting(password, atom, '', 90 'Default password for smtp:user'). 91:- setting(auth_method, oneof([plain,login,default]), default, 92 'Default authorization to use'). 93:- setting(hostname, atom, '', 94 'Default hostname'). 95 96:- meta_predicate 97 setup_call_error_cleanup(,,).
smtp(+Host)
the name or ip address for smtp host, eg. swi-prolog.orgfrom(+FromAddress)
atomic identifies sender address. Provides the default
for header(from(From)).date(+Date)
Set the date header. Default is to use the current time.subject(+Subject)
atomic: text for 'Subject:' email headerauth(User-Password)
authentication credentials, as atoms or strings.auth_method(+PlainOrLoginOrNone)
type of authentication. Default is default, alternatives
are plain and loginsecurity(Security)
one of: none, ssl, tls, starttlscontent_type(+ContentType)
sets Content-Type headermailed_by(By)
add X-Mailer: SWI-Prolog <version>, pack(smtp) to header
iff By == trueheader(from('My name,
me@server.org')) adds header "From: My name, my@server.org"
and header('FOO'(bar)) adds "FOO: bar"Defaults are provided by settings associated to this module.
Listens to debug(smtp) which for instance reports failure to
connect, (computation fails as per non-debug execution).
141smtp_send_mail(To, Goal, Options) :- 142 setting(security, DefSecurity), 143 setting(host, DefHost), 144 setting(port, DefPort0), 145 option(security(Security), Options, DefSecurity), 146 default_port(Security, DefPort0, DefPort), 147 option(smtp(Host), Options, DefHost), 148 option(port(Port), Options, DefPort), 149 hostname(HostName, Options), 150 DefOptions0 = [ security(Security), 151 port(Port), 152 host(Host), 153 hostname(HostName) 154 ], 155 add_auth_method(DefOptions0, DefOptions1), 156 add_from(DefOptions1, DefOptions), 157 merge_options(DefOptions, Options, Options1), 158 debug( smtp, 'Starting smtp with options: ~w', [Options] ), 159 setup_call_cleanup( 160 smtp_open(Host:Port, In, Out, Options1), 161 do_send_mail(In, Out, To, Goal, Options1), 162 smtp_close(In, Out)). 163 164add_auth_method(Options0, Options) :- 165 ( setting(auth_method, AuthMethod), 166 AuthMethod \== default 167 -> Options = [auth_method(AuthMethod)|Options0] 168 ; Options = Options0 169 ). 170 171add_from(Options0, Options) :- 172 ( setting(from, From), 173 From \== '' 174 -> Options = [from(From)|Options0] 175 ; Options = Options0 176 ).
182hostname(HostName, Options) :- 183 option(hostname(HostName), Options), 184 !. 185hostname(HostName, _) :- 186 setting(hostname, HostName), HostName \== '', 187 !. 188hostname(HostName, _) :- 189 gethostname(HostName). 190 191default_port(_, DefPort, DefPort) :- 192 DefPort > 0, 193 !. 194default_port(none, _, 25). 195default_port(ssl, _, 465). 196default_port(tls, _, 465). 197default_port(starttls, _, 587). 198 199smtp_open(Address, In, Out, Options) :- 200 setup_call_error_cleanup( 201 tcp_socket(Socket), 202 tcp_connect(Socket, Address), 203 tcp_close_socket(Socket)), 204 setup_call_error_cleanup( 205 tcp_open_socket(Socket, In0, Out0), 206 setup_ssl(Address, In0, Out0, In, Out, Options), 207 smtp_close(In0, Out0)), 208 !. 209smtp_open(Address, _In, _Out, Options) :- 210 debug(smtp, 'Failed to open connection at address: ~w, \c 211 with options: ~w', [Address,Options] ), 212 fail. 213 214setup_ssl(Address, In0, Out0, In, Out, Options) :- 215 option(security(Security), Options), 216 ssl_security(Security), 217 !, 218 Address = Host:_Port, 219 ssl_context(client, SSL, 220 [ host(Host), 221 cert_verify_hook(cert_accept_any), 222 close_parent(true) 223 ]), 224 ssl_negotiate(SSL, In0, Out0, In, Out). 225setup_ssl(_, In, Out, In, Out, _Options). 226 227ssl_security(ssl). 228ssl_security(tls). 229 230smtp_close(In, Out) :- 231 call_cleanup(close(Out), close(In)). 232 233setup_call_error_cleanup(Setup, Goal, Cleanup) :- 234 setup_call_catcher_cleanup( 235 Setup, Goal, Catcher, error_cleanup(Catcher, Cleanup)). 236 237error_cleanup(exit, _) :- !. 238error_cleanup(!, _) :- !. 239error_cleanup(_, Cleanup) :- 240 call(Cleanup).
Note that HELO is the old SMTP greeting. Modern systems greet using EHLO, telling the other side they want to speak RFC 1870 rather than the old RFC 821.
254do_send_mail(In, Out, To, Goal, Options) :- 255 read_ok(In, 220), 256 option(hostname(Me), Options), 257 sock_send(Out, 'EHLO ~w\r\n', [Me]), 258 read_ok(In, 250, Lines), 259 setup_call_cleanup( 260 starttls(In, Out, In1, Out1, Lines, Lines1, Options), 261 do_send_mail_cont(In1, Out1, To, Goal, Lines1, Options), 262 close_tls(In, Out, In1, Out1)). 263 264close_tls(In, Out, In, Out) :- !. 265close_tls(_, _, In, Out) :- 266 smtp_close(In, Out). 267 268do_send_mail_cont(In, Out, To, Goal, Lines, Options) :- 269 ( option(from(From), Options) 270 -> true 271 ; existence_error(smtp_option, from) 272 ), 273 auth(In, Out, From, Lines, Options), 274 sock_send(Out, 'MAIL FROM:<~w>\r\n', [From]), 275 read_ok(In, 250), 276 sock_send(Out, 'RCPT TO:<~w>\r\n', [To]), 277 read_ok(In, 250), 278 sock_send(Out, 'DATA\r\n', []), 279 read_ok(In, 354), 280 format(Out, 'To: ~w\r\n', [To]), 281 header_options(Out, Options), 282 sock_send(Out, '\r\n', []), 283 call(Goal, Out), 284 sock_send(Out, '\r\n.\r\n', []), 285 read_ok(In, 250), 286 !. 287do_send_mail_cont(_In, _Out, To, _Goal, _Lines, Options ) :- 288 debug(smtp, 'Failed to sent email To: ~w, with options: ~w', 289 [To,Options]), 290 fail.
296starttls(In0, Out0, In, Out, _Lines, Lines, Options) :- 297 option(security(starttls), Options), 298 !, 299 option(host(Host), Options), 300 option(port(Port), Options), 301 sock_send(Out0, 'STARTTLS\r\n', []), 302 read_ok(In0, 220), 303 ssl_context(client, SSL, 304 [ host(Host), 305 port(Port), 306 cert_verify_hook(cert_accept_any) 307 ]), 308 ssl_negotiate(SSL, In0, Out0, In, Out), 309 option(hostname(Me), Options), 310 sock_send(Out, 'EHLO ~w\r\n', [Me]), 311 read_ok(In, 250, Lines). 312starttls(In, Out, In, Out, Lines, Lines, _).
plain and login authentication methods. Authorization is
sent if the option auth is given or the settings user and
password are not the empty atom ('').
325auth(In, Out, From, Lines, Options) :- 326 ( option(auth(Auth), Options) 327 ; setting(user, User), User \== '', 328 setting(password, Password), Password \== '', 329 Auth = User-Password 330 ), 331 !, 332 auth_supported(Lines, Supported), 333 debug( smtp, 'Authentications supported: ~w, with options: ~w', [Supported,Options] ), 334 auth_p(In, Out, From, Auth, Supported, Options). 335auth(_, _, _, _, _). 336 337auth_p(In, Out, From, User-Password, Protocols, Options) :- 338 memberchk(plain, Protocols), 339 \+ option(auth_method(login), Options), 340 !, 341 atom_codes(From, FromCodes), 342 atom_codes(User, UserCodes), 343 atom_codes(Password, PwdCodes), 344 append([FromCodes, [0], UserCodes, [0], PwdCodes], Plain), 345 phrase(base64(Plain), Encoded), 346 sock_send(Out, 'AUTH PLAIN ~s\r\n', [Encoded]), 347 read_ok(In, 235). 348auth_p(In, Out, _From, User-Password, Protocols, _Options) :- 349 memberchk(login, Protocols), 350 !, 351 sock_send(Out, 'AUTH LOGIN\r\n', []), 352 read_ok(In, 334), 353 base64(User, User64), 354 sock_send(Out, '~w\r\n', [User64]), 355 read_ok(In, 334), 356 base64(Password, Password64), 357 sock_send(Out, '~w\r\n', [Password64]), 358 read_ok(In, 235). 359auth_p(_In, _Out, _From, _Auth, _Protocols, _Options) :- 360 representation_error(smtp_auth).
367auth_supported(Lines, Supported) :- 368 member(Line, Lines), 369 downcase_atom(Line, Lower), 370 atom_codes(Lower, Codes), 371 phrase(auth(Supported), Codes), 372 !. 373 374auth(Supported) --> 375 "auth", white, whites, 376 !, 377 auth_list(Supported). 378 379auth_list([H|T]) --> 380 nonblanks(Protocol), {Protocol \== []}, 381 !, 382 whites, 383 { atom_codes(H, Protocol) 384 }, 385 auth_list(T). 386auth_list([]) --> 387 whites.
format(Format, Args) to Stream and flush the
stream.
394sock_send(Stream, Fmt, Args) :-
395 format(Stream, Fmt, Args),
396 flush_output(Stream).header(from(From)) it uses the from(From)
from Options.date(Spec) it adds date(Date).407header_options(Out, Options) :- 408 add_default_header(Options, Options1), 409 emit_header(Options1, Out). 410 411add_default_header(Options0, Options) :- 412 add_date_header(Options0, Options1), 413 add_from_header(Options1, Options2), 414 add_content_type_header(Options2, Options). 415 416add_from_header(Options0, Options) :- 417 ( option(header(from(_)), Options0) 418 -> Options = Options0 419 ; option(from(From), Options0) 420 -> Options = [header(from(From))|Options0] 421 ; Options = Options0 422 ). 423 424add_date_header(Options0, Options) :- 425 ( option(date(_), Options0) 426 -> Options = Options0 427 ; Options = [date(now)|Options0] 428 ). 429 430add_content_type_header(Options0, Options) :- 431 ( option(content_type(_), Options0) 432 -> Options = Options0 433 ; Options = [content_type(text/plain)|Options0] 434 ). 435 436 437emit_header([], _). 438emit_header([H|T], Out) :- 439 header_option(H, Out), 440 emit_header(T, Out). 441 442header_option(H, Out) :- 443 H =.. [Name, Value], 444 header(Name, Label), 445 !, 446 format(Out, '~w: ~w\r\n', [Label, Value]). 447header_option(mailed_by(true), Out) :- 448 current_prolog_flag( version_data, swi(Maj,Min,Pat,_) ), 449 atomic_list_concat( [Maj,Min,Pat], '.', Vers ), 450 !, 451 format(Out, 'X-Mailer: SWI-Prolog ~a, pack(smtp)\r\n', [Vers]). 452header_option(date(Date), Out) :- 453 ( Date == now 454 -> get_time(Time) 455 ; Time = Date 456 ), 457 format_time(string(String), '%a, %d %b %Y %T %z', Time), 458 format(Out, 'Date: ~w\r\n', [String]). 459header_option(header(Hdr), Out) :- 460 Hdr =.. [HdrName, Value], 461 header_key_upcase(HdrName, HdrAtom), 462 !, 463 format(Out, '~w: ~w\r\n', [HdrAtom, Value]). 464header_option(_, _). 465 466header(subject, 'Subject'). 467header(content_type, 'Content-Type'). 468 469header_key_upcase(Name, Atom) :- 470 sub_atom( Name, 0, 1, _, FirstOfName), 471 upcase_atom(FirstOfName, FirstOfAtom), 472 FirstOfAtom \== FirstOfName, 473 !, 474 sub_atom(Name, 1, _, 0, Unchanged), 475 atom_concat(FirstOfAtom, Unchanged, Atom). 476header_key_upcase(Name, Name).
486read_ok(Stream, Code) :- 487 read_ok(Stream, Code, _Reply). 488 489read_ok(Stream, Code, [Line|Rest]) :- 490 read_line_to_codes(Stream, Codes), 491 parse_line(Codes, Code, Line, Cont), 492 ( Cont == true 493 -> read_reply_cont(Stream, Code, Rest) 494 ; Rest = [] 495 ). 496 497read_reply_cont(Stream, Code, [Line|Rest]) :- 498 read_line_to_codes(Stream, Codes), 499 parse_line(Codes, Code1, Line, Cont), 500 assertion(Code == Code1), 501 ( Cont == true 502 -> read_reply_cont(Stream, Code, Rest) 503 ; Rest = [] 504 ). 505 506parse_line(Codes, Code, Line, Cont) :- 507 phrase(reply_line(Code,Line,Cont), Codes), 508 !. 509parse_line(Codes, _, _, _) :- 510 atom_codes(Atom, Codes), 511 throw(error(smtp_error(unexpected_reply(Atom)), _)). 512 513reply_line(Code, Line, Cont) --> 514 integer(Code), 515 ( "-" 516 -> {Cont = true} 517 ; " " 518 -> {Cont = false} 519 ), 520 remainder(LineCodes), 521 { atom_codes(Line, LineCodes) }
Send E-mail through SMTP
This module provides a simple means to send E-mail from a Prolog application. Here is a simple example:
send_message(Out) :- format(Out, 'Hi Alice,\n\n', []), format(Out, 'Want to go out tonight?\n\n', []), format(Out, '\tCheers, Bob\n', []). ?- smtp_send_mail('alice@wonderland.com', send_message, [ subject('Tonight'), from('bob@wonderland.com') ]). This library currently supports good old SMTP, encrypted and authorized ESMTP. Both SSL/TLS and STARTTLS encryption is supported. Authorization is supported using =PLAIN= and =LOGIN= methods. Data is currently being sent using the =DATA= keyword. @tbd Support more advanced data transport extensions such as sending MIME messages.*/