1/*  Part of SWISH
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@cs.vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (C): 2017-2020, VU University Amsterdam
    7			      CWI Amsterdam
    8                              SWI-Prolog Solutions b.v.
    9    All rights reserved.
   10
   11    Redistribution and use in source and binary forms, with or without
   12    modification, are permitted provided that the following conditions
   13    are met:
   14
   15    1. Redistributions of source code must retain the above copyright
   16       notice, this list of conditions and the following disclaimer.
   17
   18    2. Redistributions in binary form must reproduce the above copyright
   19       notice, this list of conditions and the following disclaimer in
   20       the documentation and/or other materials provided with the
   21       distribution.
   22
   23    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   24    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   25    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   26    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   27    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   28    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   29    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   30    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   31    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   32    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   33    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   34    POSSIBILITY OF SUCH DAMAGE.
   35*/
   36
   37:- module(swish_email,
   38          [ smtp_send_mail/3,           % +To, :Goal, +Options
   39            smtp_send_html/3,           % +To, :Content, +Options
   40
   41            dear//1,                    % +ProfileID
   42            signature//0,
   43            profile_name//1,            % +ProfileID
   44            email_action_link//4,	% :Label, :Reply, :Action, +Options
   45
   46            email_style//0,             % Inline style sheet
   47
   48            email_cleanup_db/0,
   49
   50            public_url/4                % +To, +Query, -URL, +Options
   51          ]).   52:- use_module(library(smtp)).           % from pack smtp
   53:- use_module(library(option)).   54:- use_module(library(settings)).   55:- use_module(library(base64)).   56:- use_module(library(http/http_dispatch)).   57:- use_module(library(http/http_host)).   58:- use_module(library(http/html_write)).   59:- use_module(library(apply)).   60:- use_module(library(random)).   61:- use_module(library(persistency)).   62:- use_module(library(broadcast)).   63:- use_module(library(user_profile)).   64
   65:- use_module('../config').   66
   67/** <module> Email plugin for SWISH
   68
   69This module deals with sending  email  from   SWISH.  Email  is sent for
   70confirmation (of the email address) as well as for notifications.
   71*/
   72
   73:- html_meta
   74    smtp_send_html(+, html, +),
   75    email_action_link(html, 1, 0, +, ?, ?).   76
   77:- setting(timeout, integer, 24*3600*7,
   78           "Timeout for handling email reply").   79:- setting(database, callable, data('confirm.db'),
   80           "File specification for E-mail confirmations").   81:- setting(subject_prefix, atom, '[SWISH] ',
   82           "Prefix for the subject of emails sent").   83
   84:- http_handler(swish('mail/action/'), on_mail_link,
   85                [prefix, id(on_mail_link)]).   86
   87
   88		 /*******************************
   89		 *            DATABASE		*
   90		 *******************************/
   91
   92%!  redis_db(+Id, -Server, -Key) is semidet.
   93%
   94%   Get the Redis server and for a specific request.
   95
   96redis_key(Id, Server, Key) :-
   97    swish_config(redis, Server),
   98    swish_config(redis_prefix, Prefix),
   99    atomic_list_concat([Prefix, confirm, Id], :, Key).
  100
  101use_redis :-
  102    swish_config(redis, _).
  103
  104:- persistent
  105        request(key:string,
  106                deadline:integer,
  107                action:callable,
  108                reply:callable).  109
  110email_open_db :-
  111    use_redis,
  112    !.
  113email_open_db :-
  114    db_attached(_),
  115    !.
  116email_open_db :-
  117    setting(database, Spec),
  118    absolute_file_name(Spec, Path, [access(write)]),
  119    db_attach(Path, [sync(close)]).
  120
  121%!  email_cleanup_db
  122%
  123%   Strip the email confirmation queue from outdated messages.
  124
  125email_cleanup_db :-
  126    use_redis,
  127    !.
  128email_cleanup_db :-
  129    with_mutex(swish_email, email_cleanup_db_sync).
  130
  131email_cleanup_db_sync :-
  132    get_time(Now),
  133    forall(( request(Key, Deadline, _, _),
  134             Now > Deadline
  135           ),
  136           retract_request(Key, Deadline, _, _)),
  137    db_sync(gc).
  138
  139add_request(Id, Deadline, Action, Reply) :-
  140    redis_key(Id, Server, Key),
  141    !,
  142    get_time(Now),
  143    TTL is integer(Deadline-Now),
  144    redis(Server, set(Key, request(Action, Reply) as prolog, ex, TTL)).
  145add_request(Id, Deadline, Action, Reply) :-
  146    with_mutex(swish_email,
  147               assert_request(Id, Deadline, Action, Reply)).
  148
  149get_and_del_request(Id, Deadline, Action, Reply) :-
  150    redis_key(Id, Server, Key),
  151    !,
  152    redis(Server,
  153          [ ttl(Key) -> TTL,
  154            get(Key) -> request(Action, Reply),
  155            del(Key)
  156          ]),
  157    get_time(Now),
  158    Deadline is Now+TTL.
  159get_and_del_request(Id, Deadline, Action, Reply) :-
  160    with_mutex(swish_email,
  161               retract_request(Id, Deadline, Action, Reply)).
  162
  163
  164
  165		 /*******************************
  166		 *           EMAIL		*
  167		 *******************************/
  168
  169%!  smtp_send_html(+To, :Content, +Options)
  170%
  171%   Send an HTML mail to To  using   HTML  content  Content. Options are
  172%   passed  to  smtp_send_mail/3,  passing    as   default  content-type
  173%   `text/html`.
  174
  175smtp_send_html(To, Content, Options) :-
  176    select_option(subject(Subject), Options, Options1, "<no subject>"),
  177    setting(subject_prefix, Prefix),
  178    string_concat(Prefix, Subject, Subject1),
  179    merge_options(Options1,
  180                  [ header('MIME-Version'('1.0')),
  181                    content_type(text/html)
  182                  ], Options2),
  183    smtp_send_mail(To, html_body(Content),
  184                   [ subject(Subject1)
  185                   | Options2
  186                   ]).
  187
  188html_body(Content, Out) :-
  189    phrase(html(html([ head([]),
  190                       body(Content)
  191                     ])), Tokens),
  192    print_html(Out, Tokens).
  193
  194%!  generate_key(-Key) is det.
  195%
  196%   Generate a random confirmation key
  197
  198generate_key(Key) :-
  199    length(Codes, 16),
  200    maplist(random_between(0,255), Codes),
  201    phrase(base64url(Codes), Encoded),
  202    string_codes(Key, Encoded).
  203
  204
  205		 /*******************************
  206		 *            STYLE		*
  207		 *******************************/
  208
  209email_style -->
  210    html({|html||
  211<style>
  212address { width: 80%; text-align: right;
  213          margin-left: 18%; margin-top: 2em; border-top: 1px solid #888;}
  214</style>
  215         |}).
  216
  217
  218
  219		 /*******************************
  220		 *         PAGE ELEMENTS	*
  221		 *******************************/
  222
  223%!  dear(+Profile)//
  224%
  225%   Address user with the given ProfileID.
  226
  227dear(Profile) -->
  228    html(p(['Dear ', \profile_name(Profile), ','])).
  229
  230%!  signature//
  231%
  232%   Emit footer
  233
  234signature -->
  235    { host_url(HostURL, []) },
  236    !,
  237    html(address(['SWISH at ', a(href(HostURL), HostURL)])).
  238signature -->
  239    html(address(['SWISH'])).
  240
  241%!  profile_name(+Profile)//
  242%
  243%   Emit the name associated with Profile as unstyled HTML.
  244
  245profile_name(User) -->
  246    { user_field(Field),
  247      Term =.. [Field, Name],
  248      profile_property(User, Term)
  249    },
  250    html(Name).
  251
  252user_field(name).
  253user_field(given_name).
  254user_field(nick_name).
  255user_field(family_name).
  256
  257%!  mailto(+Address)//
  258%
  259%   Insert an email link, displaying the address itself.
  260
  261mailto(Address) -->
  262    html(a(href('mailto:'+Address), Address)).
  263
  264
  265		 /*******************************
  266		 *         ACTIVE LINKS		*
  267		 *******************************/
  268
  269%!  email_action_link(:Label, :Reply, :Action, +Options)//
  270%
  271%   Generate a link in an HTML mail   page  that, when clicked, executes
  272%   Action and if successful replies to the request using Reply.
  273
  274email_action_link(Label, Reply, Action, Options) -->
  275    { email_open_db,
  276      generate_key(Key),
  277      public_url(on_mail_link, path_postfix(Key), HREF, Options),
  278      setting(timeout, TMODef),
  279      option(timeout(TMO), Options, TMODef),
  280      get_time(Now),
  281      Deadline is round(Now+TMO),
  282      add_request(Key, Deadline, Action, Reply)
  283    },
  284    html(a(href(HREF), Label)).
  285
  286%!  on_mail_link(Request)
  287%
  288%   React on a clicked link generated by email_action_link//4.
  289
  290on_mail_link(Request) :-
  291    email_open_db,
  292    option(path_info(Path), Request),
  293    atom_string(Path, Key),
  294    get_and_del_request(Key, Deadline, Action, Reply),
  295    !,
  296    (   get_time(Now),
  297        Now =< Deadline
  298    ->  call(Action),
  299        call(Reply, Request)
  300    ;   reply_expired(Request)
  301    ).
  302on_mail_link(Request) :-
  303    email_open_db,
  304    option(path_info(Path), Request),
  305    atom_string(Path, Key),
  306    reply_html_page(
  307        email_confirmation,
  308        title('Unknown request'),
  309        [ \email_style,
  310          p([ 'Cannot find request ~w.'-[Key], ' This typically means the \c
  311               request has already been executed, is expired or the link \c
  312               is invalid.'
  313            ]),
  314          \signature
  315        ]).
  316on_mail_link(_Request) :-
  317    throw(http_reply(bad_request(missing_key))).
  318
  319reply_expired(_Request) :-
  320    reply_html_page(
  321        email_confirmation,
  322        title('Request expired'),
  323        [ \email_style,
  324          p([ 'Your request has expired.'
  325            ]),
  326          \signature
  327        ]).
  328
  329
  330%!  public_url(+To, +Query, -URL, +Options) is det.
  331%
  332%   True when URL is a link to handler To with Query
  333
  334public_url(To, Query, URL, Options) :-
  335    http_link_to_id(To, Query, RequestURI),
  336    host_url(HostURL, Options),
  337    atom_concat(HostURL, RequestURI, URL).
  338
  339host_url(HostURL, Options) :-
  340    option(host_url(HostURL), Options),
  341    !.
  342host_url(HostURL, _Options) :-
  343    http_public_host_url(_Request, HostURL).
  344
  345
  346		 /*******************************
  347		 *             EVENTS		*
  348		 *******************************/
  349
  350:- listen(user_profile(modified(User, email, Old, New)),
  351          email_verify(User, Old, New)).  352
  353email_verify(_User, _Old, "") :-
  354    !.
  355email_verify(User, Old, Email) :-
  356    smtp_send_html(Email, \email_verify(User, Old, Email),
  357                   [ subject("Please verify email")
  358                   ]).
  359
  360
  361email_verify(User, "", New) -->
  362    html([ \email_style,
  363           \dear(User),
  364           p(['We have received a request to set the email account \c
  365               for SWISH to ', \mailto(New), '.' ]),
  366           ul([ li(\confirm_link(User, New))
  367              ]),
  368           \signature
  369         ]).
  370email_verify(User, Old, New) -->
  371    html([ \email_style,
  372           \dear(User),
  373           p(['We have received a request to change the email account \c
  374               for SWISH from ', \mailto(Old), ' to ', \mailto(New), '.' ]),
  375           ul([ li(\confirm_link(User, New))
  376              ]),
  377           \signature
  378         ]).
  379
  380confirm_link(User, New) -->
  381    email_action_link(["Verify email as ", New], verified_email(User, New),
  382                      verify_email(User), []).
  383
  384verify_email(User) :-
  385    set_profile(User, email_verified(true)).
  386
  387verified_email(User, NewEmail, _Request) :-
  388    reply_html_page(
  389        email_confirmation,
  390        title('SWISH -- Email verified'),
  391        [ \email_style,
  392          \dear(User),
  393          p(['Your email address ', \mailto(NewEmail), ' has been verified.']),
  394          \signature
  395        ])