View source with formatted 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)  2010-2018, University of Amsterdam
    7    All rights reserved.
    8
    9    Redistribution and use in source and binary forms, with or without
   10    modification, are permitted provided that the following conditions
   11    are met:
   12
   13    1. Redistributions of source code must retain the above copyright
   14       notice, this list of conditions and the following disclaimer.
   15
   16    2. Redistributions in binary form must reproduce the above copyright
   17       notice, this list of conditions and the following disclaimer in
   18       the documentation and/or other materials provided with the
   19       distribution.
   20
   21    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   22    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   23    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   24    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   25    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   26    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   27    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   28    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   29    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   30    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   31    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   32    POSSIBILITY OF SUCH DAMAGE.
   33*/
   34
   35:- module(cliopatria_openid,
   36          [ openid_for_local_user/2,            % +User, -URL
   37            openid_for_local_user/3             % +User, -URL, +Options
   38          ]).   39:- use_module(library(http/http_dispatch)).   40:- use_module(library(http/http_wrapper)).   41:- use_module(library(http/http_openid)).   42:- use_module(library(http/http_parameters)).   43:- use_module(library(http/http_session)).   44:- use_module(library(http/html_write)).   45:- use_module(library(http/html_head)).   46:- use_module(library(http/http_hook)).   47:- use_module(library(lists)).   48:- use_module(library(error)).   49:- use_module(library(option)).   50:- use_module(library(uri)).   51:- use_module(library(socket)).   52:- use_module(library(debug)).   53:- use_module(library(settings)).   54:- use_module(user_db).   55
   56
   57/** <module> OpenID server and client access
   58
   59This module customizes login and OpenID handling for ClioPatria.
   60
   61@author Jan Wielemaker
   62*/
   63
   64http:location(openid, root(openid), []).
   65
   66                 /*******************************
   67                 *      CUSTOMISE OPENID        *
   68                 *******************************/
   69
   70:- http_handler(openid(grant),  openid_grant, [prefix]).   71
   72:- multifile
   73    http_openid:openid_hook/1.   74
   75http_openid:openid_hook(login(OpenID)) :-
   76    login(OpenID).
   77http_openid:openid_hook(logout(OpenID)) :-
   78    logout(OpenID).
   79http_openid:openid_hook(logged_in(OpenID)) :-
   80    logged_on(OpenID).
   81http_openid:openid_hook(trusted(OpenID, Server)) :-
   82    (   openid_server_properties(Server, _)
   83    ->  true
   84    ;   format(string(Msg), 'OpenID server ~w is not trusted', [Server]),
   85        throw(error(permission_error(login, openid, OpenID),
   86                    context(_, Msg)))
   87    ).
   88
   89
   90:- http_handler(openid(login), login_page, [priority(10)]).   91
   92%!  login_page(+Request)
   93%
   94%   HTTP Handler that shows both OpenID   login and local login-page
   95%   to the user. This handler overrules the default OpenID handler.
   96
   97login_page(Request) :-
   98    http_open_session(_, []),               % we need sessions to login
   99    http_parameters(Request,
  100                    [ 'openid.return_to'(ReturnTo,
  101                                         [ description('Page to visit after login')
  102                                         ])
  103                    ]),
  104    reply_html_page(cliopatria(default),
  105                    title('Login'),
  106                    [ \explain_login(ReturnTo),
  107                      \cond_openid_login_form(ReturnTo),
  108                      \local_login(ReturnTo)
  109                    ]).
  110
  111explain_login(ReturnTo) -->
  112    { uri_components(ReturnTo, Components),
  113      uri_data(path, Components, Path)
  114    },
  115    html(div(class('rdfql-login'),
  116             [ p([ 'You are trying to access a page (~w) that requires authorization. '-[Path],
  117                   \explain_open_id_login
  118                 ])
  119             ])).
  120
  121explain_open_id_login -->
  122    { \+ openid_current_server(_) },
  123    !.
  124explain_open_id_login -->
  125    html([ 'You can login either as a local user',
  126           ' or with your ', a(href('http://www.openid.net'), 'OpenID'), '.']),
  127    (   { openid_current_server(*) }
  128    ->  []
  129    ;   { http_link_to_id(trusted_openid_servers, [], HREF) },
  130        html([ ' from one of our ', a(href(HREF), 'trusted providers')])
  131    ).
  132
  133cond_openid_login_form(_) -->
  134    { \+ openid_current_server(_) },
  135    !.
  136cond_openid_login_form(ReturnTo) -->
  137    openid_login_form(ReturnTo, []).
  138
  139
  140local_login(ReturnTo) -->
  141    html(div(class('local-login'),
  142             [ div(class('local-message'),
  143                   'Login with your local username and password'),
  144               form([ action(location_by_id(user_login)),
  145                      method('GET')
  146                    ],
  147                    [ \hidden('openid.return_to', ReturnTo),
  148                      div(input([name(user), size(20)])),
  149                      div([ input([name(password), size(20), type(password)]),
  150                            input([type(submit), value('login')])
  151                          ])
  152                    ])
  153             ])).
  154
  155hidden(Name, Value) -->
  156    html(input([type(hidden), name(Name), value(Value)])).
  157
  158
  159:- http_handler(openid(list_trusted_servers), trusted_openid_servers, []).  160
  161%!  trusted_openid_servers(+Request)
  162%
  163%   HTTP handler to emit a list of OpenID servers we trust.
  164
  165trusted_openid_servers(_Request) :-
  166    findall(S, openid_current_server(S), Servers),
  167    reply_html_page(cliopatria(default),
  168                    title('Trusted OpenID servers'),
  169                    [ h4('Trusted OpenID servers'),
  170                      p([ 'We accept OpenID logins from the following OpenID providers. ',
  171                          'Please register with one of them.'
  172                        ]),
  173                      ul(\trusted_openid_servers(Servers))
  174                    ]).
  175
  176trusted_openid_servers([]) -->
  177    [].
  178trusted_openid_servers([H|T]) -->
  179    trusted_openid_server(H),
  180    trusted_openid_servers(T).
  181
  182trusted_openid_server(*) --> !.
  183trusted_openid_server(URL) -->
  184    html(li(a(href(URL), URL))).
  185
  186
  187                 /*******************************
  188                 *         OPENID SERVER        *
  189                 *******************************/
  190
  191:- http_handler(root(user), openid_userpage, [prefix]).  192:- http_handler(openid(server), openid_server([]), [prefix]).  193
  194http_openid:openid_hook(grant(Request, Options)) :-
  195    (   option(identity(Identity), Options),
  196        option(password(Password), Options),
  197        file_base_name(Identity, User),
  198        validate_password(User, Password)
  199    ->  option(trustroot(TrustRoot), Options),
  200        debug(openid, 'Granted access for ~w to ~w', [Identity, TrustRoot])
  201    ;   memberchk(path(Path), Request),
  202        throw(error(permission_error(http_location, access, Path),
  203                    context(_, 'Wrong password')))
  204    ).
  205
  206
  207%!  openid_userpage(+Request)
  208%
  209%   Server user page for a registered user
  210
  211openid_userpage(Request) :-
  212    memberchk(path(Path), Request),
  213    atomic_list_concat(Parts, /, Path),
  214    append(_, [user, User], Parts),
  215    !,
  216    file_base_name(Path, User),
  217    (   current_user(User)
  218    ->  findall(P, user_property(User, P), Props),
  219        reply_html_page(cliopatria(default),
  220                        [ link([ rel('openid.server'),
  221                                 href(location_by_id(openid_server))
  222                               ]),
  223                          title('OpenID page for user ~w'-[User])
  224                        ],
  225                        [ h1('OpenID page for user ~w'-[User]),
  226                          \user_properties(Props)
  227                        ])
  228    ;   existence_error(http_location, Path)
  229    ).
  230
  231
  232user_properties([]) -->
  233    [].
  234user_properties([H|T]) -->
  235    user_property(H),
  236    user_properties(T).
  237
  238user_property(realname(Name)) -->
  239    !,
  240    html(div(['Real name: ', Name])).
  241user_property(connection(Login, IdleF)) -->
  242    !,
  243    { format_time(string(S), '%+', Login),
  244      Idle is round(IdleF),
  245      Hours is Idle // 3600,
  246      Min is Idle mod 3600 // 60,
  247      Sec is Idle mod 60
  248    },
  249    html(div(['Logged in since ~s, idle for ~d:~d:~d'-
  250              [S, Hours,Min,Sec]])).
  251user_property(_) -->
  252    [].
  253
  254
  255%!  openid_for_local_user(+User, -URL) is semidet.
  256%
  257%   URL is the OpenID for the local user User.
  258
  259openid_for_local_user(User, URL) :-
  260    openid_for_local_user(User, URL, []).
  261
  262openid_for_local_user(User, URL, Options) :-
  263    option(public_host(Host), Options),
  264    !,
  265    http_location_by_id(openid_userpage, UserPages),
  266    atom_concat(/, BelowRoot, UserPages),
  267    format(atom(URL), '~w~w/~w',
  268               [ Host, BelowRoot, User ]).
  269openid_for_local_user(User, URL, _Options) :-
  270    http_current_request(Request),
  271    openid_current_host(Request, Host, Port),
  272    http_location_by_id(openid_userpage, UserPages),
  273    (   Port == 80
  274    ->  format(atom(URL), 'http://~w~w/~w',
  275               [ Host, UserPages, User ])
  276    ;   format(atom(URL), 'http://~w:~w~w/~w',
  277               [ Host, Port, UserPages, User ])
  278    ).
  279
  280
  281
  282                 /*******************************
  283                 *             TEST             *
  284                 *******************************/
  285
  286:- http_handler(cliopatria('user/form/login'), login_handler, [priority(10)]).  287
  288login_handler(_Request) :-
  289    ensure_logged_on(User),
  290    user_property(User, url(URL)),
  291    reply_html_page(cliopatria(default),
  292                    title('Login ok'),
  293                    [ h1('Login ok'),
  294                      p(['You''re logged on with OpenID ',
  295                         a(href(URL), URL)])
  296                    ])