View source with raw comments or as raw
    1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (C): 2013-2018, VU University Amsterdam
    7			      CWI, Amsterdam
    8
    9    This program is free software; you can redistribute it and/or
   10    modify it under the terms of the GNU General Public License
   11    as published by the Free Software Foundation; either version 2
   12    of the License, or (at your option) any later version.
   13
   14    This program is distributed in the hope that it will be useful,
   15    but WITHOUT ANY WARRANTY; without even the implied warranty of
   16    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   17    GNU General Public License for more details.
   18
   19    You should have received a copy of the GNU General Public
   20    License along with this library; if not, write to the Free Software
   21    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   22
   23    As a special exception, if you link this library with other files,
   24    compiled with a Free Software compiler, to produce an executable, this
   25    library does not by itself cause the resulting executable to be covered
   26    by the GNU General Public License. This exception does not however
   27    invalidate any other reasons why the executable file might be covered by
   28    the GNU General Public License.
   29*/
   30
   31:- module(mail_notify,
   32	  [ notify/2,			% +Object, +Term
   33	    msg_user//1			% +UUID
   34	  ]).   35:- use_module(library(smtp)).   36:- use_module(library(debug)).   37:- use_module(library(error)).   38:- use_module(library(http/http_host)).   39:- use_module(library(http/http_dispatch)).   40:- use_module(library(http/http_wrapper)).   41:- use_module(library(pldoc/doc_html), [object_href/2]).   42:- use_module(object_support).   43:- use_module(openid).   44
   45:- multifile
   46	event_subject//1,			% +Event
   47	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
To be done
- 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.
   69notify(Object, Term) :-
   70	server(_),			% check cache from calling thread
   71	notification_user(User),
   72	catch(thread_send_message(
   73		  mail_notifier,
   74		  notification(Object, User, Term)),
   75	      error(existence_error(message_queue, _),_),
   76	      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 '<not from http>'.
   84notification_user(User) :-
   85	site_user_logged_in(User), !.
   86notification_user(Peer) :-
   87	http_current_request(Request),
   88	http_peer(Request, Peer), !.
   89notification_user('<not from http>').
Start the notification thread of this is not already running.
   95start_notifier(Object, User, Term) :-
   96	thread_create(mail_notifier, _,
   97		      [ alias(mail_notifier),
   98			detached(true)
   99		      ]),
  100	thread_send_message(
  101	    mail_notifier,
  102	    notification(Object, User, Term)).
  103
  104mail_notifier :-
  105	set_output(user_output),
  106	repeat,
  107	thread_get_message(Msg),
  108	catch(handle_message(Msg), E,
  109	      print_message(error, E)),
  110	fail.
  111
  112handle_message(notification(Object, User, Term)) :- !,
  113	do_notify(Object, User, Term).
  114handle_message(Message) :-
  115	domain_error(notification, Message).
  116
  117do_notify(Object, EventUser, Term) :-
  118	(   watcher(Object, Watcher),
  119	    (	site_user_property(Watcher, email(Email))
  120	    ->	User = Watcher
  121	    ;	site_user_property(User, email(Watcher))
  122	    ->	Email = Watcher
  123	    ;	Email = Watcher,
  124		User = unknown
  125	    ),
  126	    catch(notify(User, Email, Object, EventUser, Term),
  127		  E,
  128		  print_message(error, E)),
  129	    fail
  130	;   true
  131	).
  132
  133notify(User, Email, Object, EventUser, Term) :-
  134	phrase(make_subject(Object, Term), SubjectList),
  135	phrase(make_message(User, Object, EventUser, Term), Message),
  136	with_output_to(atom(Subject),
  137		       send_message(SubjectList, current_output)),
  138	debug(notify, 'Sending mail to ~w about ~w', [Email, Object]),
  139	smtp_send_mail(Email,
  140		       send_message(Message),
  141		       [ subject(Subject),
  142			 from('noreply@swi-prolog.org')
  143		       ]), !.
 send_message(+Parts, +Output) is det
Write message fragments to Output. This is similar to print_message/2.
  150send_message([], _) :- !.
  151send_message([H|T], Out) :- !,
  152	send_one(H, Out),
  153	send_message(T, Out).
  154
  155send_one(Fmt-Args, Out) :- !,
  156	format(Out, Fmt, Args).
  157send_one(nl, Out) :- !,
  158	format(Out, '~n', []).
  159send_one(X, _Out) :- !,
  160	domain_error(mail_message_fragment, X).
 make_subject(+Object, +Event)//
Generate the fragments that describe the subject for Event on Object.
  167make_subject(Object, Event) -->
  168	{ object_label(Object, Label) },
  169	[ '[SWIPL] ~w: '-[Label] ],
  170	(   event_subject(Event)
  171	->  []
  172	;   ['<unknown event>'-[]]
  173	).
 make_message(+UUID, +Object, +User, +Event)//
Generate the fragments that describe the message body for Event on Object.
  180make_message(UUID, Object, User, Event) -->
  181	opening(UUID),
  182	on_object(Object),
  183	by_user(User),
  184	[nl],
  185	(   event_message(Event)
  186	->  []
  187	;   ['Unknown notication event: ~q'-[Event] ]
  188	),
  189	closing(UUID, Object).
  190
  191opening(UUID) -->
  192	{ site_user_property(UUID, name(Name)) }, !,
  193	[ 'Dear ~w,'-[Name], nl, nl ].
  194opening(_) -->
  195	[ 'Hi'-[], nl, nl ].
  196
  197on_object(Object) -->
  198	{ object_label(Object, Label),
  199	  object_href(Object, HREF),
  200	  server(Server)
  201	},
  202	[ 'This is a change notification for ~w'-[Label], nl,
  203	  'URL: ~w~w'-[Server, HREF], nl
  204	].
  205
  206by_user(UUID) -->
  207	[ 'Event generated by '-[] ],
  208	msg_user(UUID), !,
  209	[nl].
  210by_user(_) -->
  211	[].
  212
  213closing(UUID, _Object) -->
  214	{ site_user_property(UUID, _) }, !,
  215	[ nl, nl,
  216	  'You received this message because you have indicated to '-[], nl,
  217	  'watch this page on the SWI-Prolog website.'-[], nl,
  218	  'User details: '-[]
  219	],
  220	msg_user(UUID).
  221closing(_, _) --> [].
 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.
  230:- dynamic
  231	server_cache/1.  232
  233server(Server) :-
  234	server_cache(Server), !.
  235server(Server) :-
  236	ignore(http_current_request(Request)),
  237	http_current_host(Request, Host, Port, [global(true)]),
  238	(   Port == 80
  239	->  format(atom(Server), 'http://~w', [Host])
  240	;   Port == 443
  241	->  format(atom(Server), 'https://~w', [Host])
  242	;   format(atom(Server), 'http://~w:~w', [Host, Port])
  243	).
 msg_user(+UUID)// is det
Plain-text reference to a user with hyperlink.
  250msg_user(UUID) -->
  251	{ site_user_property(UUID, name(Name)),
  252	  http_link_to_id(view_profile, [user(UUID)], HREF),
  253	  server(Server)
  254	},
  255	[ '~w <~w~w>'-[Name, Server, HREF] ].
  256
  257
  258		 /*******************************
  259		 *	    WATCH LIST		*
  260		 *******************************/
 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.
To be done
- : Allow users to set watches
  270watcher(_, 'jan@swi-prolog.org')