/* Part of SWI-Prolog Author: Jan Wielemaker E-mail: J.Wielemaker@vu.nl WWW: http://www.swi-prolog.org Copyright (C): 2013-2018, VU University Amsterdam CWI, Amsterdam This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this library; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA As a special exception, if you link this library with other files, compiled with a Free Software compiler, to produce an executable, this library does not by itself cause the resulting executable to be covered by the GNU General Public License. This exception does not however invalidate any other reasons why the executable file might be covered by the GNU General Public License. */ :- module(mail_notify, [ notify/2, % +Object, +Term msg_user//1 % +UUID ]). :- use_module(library(smtp)). :- use_module(library(debug)). :- use_module(library(error)). :- use_module(library(http/http_host)). :- use_module(library(http/http_dispatch)). :- use_module(library(http/http_wrapper)). :- use_module(library(pldoc/doc_html), [object_href/2]). :- use_module(object_support). :- use_module(openid). :- multifile event_subject//1, % +Event event_message//1. % +Event /** Send notications by E-mail This module sends E-mail notifications to _watchers_ for events that take place on watched objects. The messages themselves are generated similar to print_message/2 using the grammars - mail_notify:event_subject//1 Define the subject of the message - mail_notify:event_message//1 Define the body of the message @tbd Eventually, this should also be used to provide an RSS feed from the side. */ %% notify(+Object, +Term) % % Notify watching users by mail of the event on Object, described % by Term. notify(Object, Term) :- server(_), % check cache from calling thread notification_user(User), catch(thread_send_message( mail_notifier, notification(Object, User, Term)), error(existence_error(message_queue, _),_), start_notifier(Object, User, Term)). %% notification_user(-User) is det. % % Find the origin of the event, which is either the UUID of the % logged on user that triggered the event, the peer IP address of % this user or `''`. notification_user(User) :- site_user_logged_in(User), !. notification_user(Peer) :- http_current_request(Request), http_peer(Request, Peer), !. notification_user(''). %% start_notifier(+Object, +User, +Term) isa det. % % Start the notification thread of this is not already running. start_notifier(Object, User, Term) :- thread_create(mail_notifier, _, [ alias(mail_notifier), detached(true) ]), thread_send_message( mail_notifier, notification(Object, User, Term)). mail_notifier :- set_output(user_output), repeat, thread_get_message(Msg), catch(handle_message(Msg), E, print_message(error, E)), fail. handle_message(notification(Object, User, Term)) :- !, do_notify(Object, User, Term). handle_message(Message) :- domain_error(notification, Message). do_notify(Object, EventUser, Term) :- ( watcher(Object, Watcher), ( site_user_property(Watcher, email(Email)) -> User = Watcher ; site_user_property(User, email(Watcher)) -> Email = Watcher ; Email = Watcher, User = unknown ), catch(notify(User, Email, Object, EventUser, Term), E, print_message(error, E)), fail ; true ). notify(User, Email, Object, EventUser, Term) :- phrase(make_subject(Object, Term), SubjectList), phrase(make_message(User, Object, EventUser, Term), Message), with_output_to(atom(Subject), send_message(SubjectList, current_output)), debug(notify, 'Sending mail to ~w about ~w', [Email, Object]), smtp_send_mail(Email, send_message(Message), [ subject(Subject), from('noreply@swi-prolog.org') ]), !. %% send_message(+Parts, +Output) is det. % % Write message fragments to Output. This is similar to % print_message/2. send_message([], _) :- !. send_message([H|T], Out) :- !, send_one(H, Out), send_message(T, Out). send_one(Fmt-Args, Out) :- !, format(Out, Fmt, Args). send_one(nl, Out) :- !, format(Out, '~n', []). send_one(X, _Out) :- !, domain_error(mail_message_fragment, X). %% make_subject(+Object, +Event)// % % Generate the fragments that describe the subject for Event on % Object. make_subject(Object, Event) --> { object_label(Object, Label) }, [ '[SWIPL] ~w: '-[Label] ], ( event_subject(Event) -> [] ; [''-[]] ). %% make_message(+UUID, +Object, +User, +Event)// % % Generate the fragments that describe the message body for Event % on Object. make_message(UUID, Object, User, Event) --> opening(UUID), on_object(Object), by_user(User), [nl], ( event_message(Event) -> [] ; ['Unknown notication event: ~q'-[Event] ] ), closing(UUID, Object). opening(UUID) --> { site_user_property(UUID, name(Name)) }, !, [ 'Dear ~w,'-[Name], nl, nl ]. opening(_) --> [ 'Hi'-[], nl, nl ]. on_object(Object) --> { object_label(Object, Label), object_href(Object, HREF), server(Server) }, [ 'This is a change notification for ~w'-[Label], nl, 'URL: ~w~w'-[Server, HREF], nl ]. by_user(UUID) --> [ 'Event generated by '-[] ], msg_user(UUID), !, [nl]. by_user(_) --> []. closing(UUID, _Object) --> { site_user_property(UUID, _) }, !, [ nl, nl, 'You received this message because you have indicated to '-[], nl, 'watch this page on the SWI-Prolog website.'-[], nl, 'User details: '-[] ], msg_user(UUID). closing(_, _) --> []. %% server(-Server) is det. % % Provide a URL for the server. Note that the mail server runs in % a different thread and thus the HTTP thread should call this % before launching the mail thread. :- dynamic server_cache/1. server(Server) :- server_cache(Server), !. server(Server) :- ignore(http_current_request(Request)), http_current_host(Request, Host, Port, [global(true)]), ( Port == 80 -> format(atom(Server), 'http://~w', [Host]) ; Port == 443 -> format(atom(Server), 'https://~w', [Host]) ; format(atom(Server), 'http://~w:~w', [Host, Port]) ). %% msg_user(+UUID)// is det. % % Plain-text reference to a user with hyperlink. msg_user(UUID) --> { site_user_property(UUID, name(Name)), http_link_to_id(view_profile, [user(UUID)], HREF), server(Server) }, [ '~w <~w~w>'-[Name, Server, HREF] ]. /******************************* * WATCH LIST * *******************************/ %% watcher(+Object, -MailOrUser) is nondet. % % True when Object is being watched by MailOrUser. Note that users % are described by their UUID, and thus never conflict with a % valid mail address. % % @tbd: Allow users to set watches watcher(_, 'jan@swi-prolog.org').