1/*  Part of ClioPatria SeRQL and SPARQL server
    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                              VU University Amsterdam
    8    All rights reserved.
    9
   10    Redistribution and use in source and binary forms, with or without
   11    modification, are permitted provided that the following conditions
   12    are met:
   13
   14    1. Redistributions of source code must retain the above copyright
   15       notice, this list of conditions and the following disclaimer.
   16
   17    2. Redistributions in binary form must reproduce the above copyright
   18       notice, this list of conditions and the following disclaimer in
   19       the documentation and/or other materials provided with the
   20       distribution.
   21
   22    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   23    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   24    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   25    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   26    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   27    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   28    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   29    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   30    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   31    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   32    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   33    POSSIBILITY OF SUCH DAMAGE.
   34*/
   35
   36:- module(cpa_admin,
   37          [ change_password_form//1
   38          ]).   39:- use_module(user(user_db)).   40:- use_module(library(http/http_parameters)).   41:- use_module(library(http/http_session)).   42:- use_module(library(http/html_write)).   43:- use_module(library(http/html_head)).   44:- use_module(library(http/mimetype)).   45:- use_module(library(http/http_dispatch)).   46:- use_module(library(url)).   47:- use_module(library(debug)).   48:- use_module(library(lists)).   49:- use_module(library(option)).   50:- use_module(library(http_settings)).   51
   52/** <module> ClioPatria administrative interface
   53
   54This module provides HTTP services to perform administrative actions.
   55
   56@tbd    Ideally, this module should be split into an api-part, a
   57        component-part and the actual pages.  This also implies that
   58        the current `action'-operations must (optionally) return
   59        machine-friendly results.
   60*/
   61
   62
   63:- http_handler(cliopatria('admin/listUsers'),             list_users,              []).   64:- http_handler(cliopatria('admin/form/createAdmin'),      create_admin,            []).   65:- http_handler(cliopatria('admin/form/addUser'),          add_user_form,           []).   66:- http_handler(cliopatria('admin/form/addOpenIDServer'),  add_openid_server_form,  []).   67:- http_handler(cliopatria('admin/addUser'),               add_user,                []).   68:- http_handler(cliopatria('admin/selfRegister'),          self_register,           []).   69:- http_handler(cliopatria('admin/addOpenIDServer'),       add_openid_server,       []).   70:- http_handler(cliopatria('admin/form/editUser'),         edit_user_form,          []).   71:- http_handler(cliopatria('admin/editUser'),              edit_user,               []).   72:- http_handler(cliopatria('admin/delUser'),               del_user,                []).   73:- http_handler(cliopatria('admin/form/editOpenIDServer'), edit_openid_server_form, []).   74:- http_handler(cliopatria('admin/editOpenIDServer'),      edit_openid_server,      []).   75:- http_handler(cliopatria('admin/delOpenIDServer'),       del_openid_server,       []).   76:- http_handler(cliopatria('admin/form/changePassword'),   change_password_form,    []).   77:- http_handler(cliopatria('admin/changePassword'),        change_password,         []).   78:- http_handler(cliopatria('user/form/login'),             login_form,              []).   79:- http_handler(cliopatria('user/login'),                  user_login,              []).   80:- http_handler(cliopatria('user/logout'),                 user_logout,             []).   81:- http_handler(cliopatria('admin/settings'),              settings,                []).   82:- http_handler(cliopatria('admin/save_settings'),         save_settings,           []).   83
   84%!  list_users(+Request)
   85%
   86%   HTTP Handler listing registered users.
   87
   88list_users(_Request) :-
   89    authorized(admin(list_users)),
   90    if_allowed(admin(user(edit)),   [edit(true)], UserOptions),
   91    if_allowed(admin(openid(edit)), [edit(true)], OpenIDOptions),
   92    reply_html_page(cliopatria(default),
   93                    title('Users'),
   94                    [ h1('Users'),
   95                      \user_table(UserOptions),
   96                      p(\action(location_by_id(add_user_form), 'Add user')),
   97                      h1('OpenID servers'),
   98                      \openid_server_table(OpenIDOptions),
   99                      p(\action(location_by_id(add_openid_server_form), 'Add OpenID server'))
  100                    ]).
  101
  102if_allowed(Token, Options, Options) :-
  103    logged_on(User, anonymous),
  104    catch(check_permission(User, Token), _, fail),
  105    !.
  106if_allowed(_, _, []).
  107
  108%!  user_table(+Options)//
  109%
  110%   HTML component generating a table of registered users.
  111
  112user_table(Options) -->
  113    { setof(U, current_user(U), Users)
  114    },
  115    html([ table([ class(block)
  116                 ],
  117                 [ tr([ th('UserID'),
  118                        th('RealName'),
  119                        th('On since'),
  120                        th('Idle')
  121                      ])
  122                 | \list_users(Users, Options)
  123                 ])
  124         ]).
  125
  126list_users([], _) -->
  127    [].
  128list_users([User|T], Options) -->
  129    { user_property(User, realname(Name)),
  130      findall(Idle-Login,
  131              user_property(User, connection(Login, Idle)),
  132              Pairs0),
  133      keysort(Pairs0, Pairs),
  134      (   Pairs == []
  135      ->  OnLine = (-)
  136      ;   length(Pairs, N),
  137          Pairs = [Idle-Login|_],
  138          OnLine = online(Login, Idle, N)
  139      )
  140    },
  141    html(tr([ td(User),
  142              td(Name),
  143              td(\on_since(OnLine)),
  144              td(\idle(OnLine)),
  145              \edit_user_button(User, Options)
  146            ])),
  147    list_users(T, Options).
  148
  149edit_user_button(User, Options) -->
  150    { option(edit(true), Options) },
  151    !,
  152    html(td(a(href(location_by_id(edit_user_form)+'?user='+encode(User)), 'Edit'))).
  153edit_user_button(_, _) -->
  154    [].
  155
  156on_since(online(Login, _Idle, _Connections)) -->
  157    !,
  158    { format_time(string(Date), '%+', Login)
  159    },
  160    html(Date).
  161on_since(_) -->
  162    html(-).
  163
  164idle(online(_Login, Idle, _Connections)) -->
  165    { mmss_duration(Idle, String)
  166    },
  167    html(String).
  168idle(_) -->
  169    html(-).
  170
  171
  172mmss_duration(Time, String) :-          % Time in seconds
  173    Secs is round(Time),
  174    Hour is Secs // 3600,
  175    Min  is (Secs // 60) mod 60,
  176    Sec  is Secs mod 60,
  177    format(string(String), '~`0t~d~2|:~`0t~d~5|:~`0t~d~8|', [Hour, Min, Sec]).
  178
  179
  180
  181                 /*******************************
  182                 *            ADD USERS         *
  183                 *******************************/
  184
  185%!  create_admin(+Request)
  186%
  187%   Create the administrator login.
  188
  189create_admin(_Request) :-
  190    (   current_user(_)
  191    ->  throw(error(permission_error(create, user, admin),
  192                    context(_, 'Already initialized')))
  193    ;   true
  194    ),
  195    reply_html_page(cliopatria(default),
  196                    title('Create administrator'),
  197                    [ h1(align(center), 'Create administrator'),
  198
  199                      p('No accounts are available on this server. \c
  200                          This form allows for creation of an administrative \c
  201                          account that can subsequently be used to create \c
  202                          new users.'),
  203
  204                      \new_user_form([ user(admin),
  205                                       real_name('Administrator')
  206                                     ])
  207                    ]).
  208
  209
  210%!  add_user_form(+Request)
  211%
  212%   Form to register a user.
  213
  214add_user_form(_Request) :-
  215    authorized(admin(add_user)),
  216    reply_html_page(cliopatria(default),
  217                    title('Add new user'),
  218                    [ \new_user_form([])
  219                    ]).
  220
  221new_user_form(Options) -->
  222    { (   option(user(User), Options)
  223      ->  UserOptions = [value(User)],
  224          PermUser = User
  225      ;   UserOptions = [],
  226          PermUser = (-)
  227      )
  228    },
  229    html([ h1('Add new user'),
  230           form([ action(location_by_id(add_user)),
  231                  method('POST')
  232                ],
  233                table([ class((form))
  234                      ],
  235                      [ \realname(Options),
  236                        \input(user,     'Login',
  237                               UserOptions),
  238                        \input(pwd1,     'Password',
  239                               [type(password)]),
  240                        \input(pwd2,     'Retype',
  241                               [type(password)]),
  242                        \permissions(PermUser),
  243                        tr(class(buttons),
  244                           td([ colspan(2),
  245                                align(right)
  246                              ],
  247                              input([ type(submit),
  248                                      value('Create')
  249                                    ])))
  250                      ]))
  251         ]).
  252
  253
  254input(Name, Label, Options) -->
  255    html(tr([ th(align(right), Label),
  256              td(input([name(Name),size(40)|Options]))
  257            ])).
  258
  259%       Only provide a realname field if this is not already given. This
  260%       is because firefox determines the login user from the text field
  261%       immediately above the password entry. Other   browsers may do it
  262%       different, so only having one text-field  is probably the savest
  263%       solution.
  264
  265realname(Options) -->
  266    { option(real_name(RealName), Options) },
  267    !,
  268    hidden(realname, RealName).
  269realname(_Options) -->
  270    input(realname, 'Realname', []).
  271
  272
  273%!  add_user(+Request)
  274%
  275%   API  to  register  a  new  user.  The  current  user  must  have
  276%   administrative rights or the user-database must be empty.
  277
  278add_user(Request) :-
  279    (   \+ current_user(_)
  280    ->  FirstUser = true
  281    ;   authorized(admin(add_user))
  282    ),
  283    http_parameters(Request,
  284                    [ user(User),
  285                      realname(RealName),
  286                      pwd1(Password),
  287                      pwd2(Retype),
  288                      read(Read),
  289                      write(Write),
  290                      admin(Admin)
  291                    ],
  292                    [ attribute_declarations(attribute_decl)
  293                    ]),
  294    (   current_user(User)
  295    ->  throw(error(permission_error(create, user, User),
  296                    context(_, 'Already present')))
  297    ;   true
  298    ),
  299    (   Password == Retype
  300    ->  true
  301    ;   throw(password_mismatch)
  302    ),
  303    password_hash(Password, Hash),
  304    phrase(allow(Read, Write, Admin), Allow),
  305    user_add(User,
  306             [ realname(RealName),
  307               password(Hash),
  308               allow(Allow)
  309             ]),
  310    (   FirstUser == true
  311    ->  user_add(anonymous,
  312                 [ realname('Define rights for not-logged in users'),
  313                   allow([read(_,_)])
  314                 ]),
  315        reply_login([user(User), password(Password)])
  316    ;   list_users(Request)
  317    ).
  318
  319%!  self_register(Request)
  320%
  321%   Self-register and login a new user if
  322%   cliopatria:enable_self_register is set to true.
  323%   Users are registered with full read
  324%   and limited (annotate-only) write access.
  325%
  326%   Returns a HTTP 403 forbidden error if:
  327%   - cliopatria:enable_self_register is set to false
  328%   - the user already exists
  329
  330self_register(Request) :-
  331    http_location_by_id(self_register, MyUrl),
  332    (   \+ setting(cliopatria:enable_self_register, true)
  333    ->  throw(http_reply(forbidden(MyUrl)))
  334    ;   true
  335    ),
  336    http_parameters(Request,
  337                    [ user(User),
  338                      realname(RealName),
  339                      password(Password)
  340                    ],
  341                    [ attribute_declarations(attribute_decl)
  342                    ]),
  343    (   current_user(User)
  344    ->  throw(http_reply(forbidden(MyUrl)))
  345    ;   true
  346    ),
  347    password_hash(Password, Hash),
  348    Allow = [ read(_,_), write(_,annotate) ],
  349    user_add(User, [realname(RealName), password(Hash), allow(Allow)]),
  350    reply_login([user(User), password(Password)]).
  351
  352
  353%!  edit_user_form(+Request)
  354%
  355%   Form to edit user properties
  356
  357edit_user_form(Request) :-
  358    authorized(admin(user(edit))),
  359    http_parameters(Request,
  360                    [ user(User)
  361                    ],
  362                    [ attribute_declarations(attribute_decl)
  363                    ]),
  364
  365    reply_html_page(cliopatria(default),
  366                    title('Edit user'),
  367                    \edit_user_form(User)).
  368
  369%!  edit_user_form(+User)//
  370%
  371%   HTML component to edit the properties of User.
  372
  373edit_user_form(User) -->
  374    { user_property(User, realname(RealName))
  375    },
  376    html([ h1(['Edit user ', User, ' (', RealName, ')']),
  377
  378           form([ action(location_by_id(edit_user)),
  379                  method('POST')
  380                ],
  381                [ \hidden(user, User),
  382                  table([ class((form))
  383                        ],
  384                        [ \user_property(User, realname, 'Real name', []),
  385                          \permissions(User),
  386                          tr(class(buttons),
  387                             td([ colspan(2),
  388                                  align(right)
  389                                ],
  390                                input([ type(submit),
  391                                        value('Modify')
  392                                      ])))
  393                        ])
  394                ]),
  395
  396           p(\action(location_by_id(del_user)+'?user='+encode(User),
  397                     [ 'Delete user ', b(User), ' (', i(RealName), ')' ]))
  398         ]).
  399
  400user_property(User, Name, Label, Options) -->
  401    {  Term =.. [Name, Value],
  402       user_property(User, Term)
  403    -> O2 = [value(Value)|Options]
  404    ;  O2 = Options
  405    },
  406    html(tr([ th(class(p_name), Label),
  407              td(input([name(Name),size(40)|O2]))
  408            ])).
  409
  410permissions(User) -->
  411    html(tr([ th(class(p_name), 'Permissions'),
  412              td([ \permission_checkbox(User, read,  'Read'),
  413                   \permission_checkbox(User, write, 'Write'),
  414                   \permission_checkbox(User, admin, 'Admin')
  415                 ])
  416            ])).
  417
  418permission_checkbox(User, Name, Label) -->
  419    { (   User \== (-),
  420          (   user_property(User, allow(Actions))
  421          ->  true
  422          ;   openid_server_property(User, allow(Actions))
  423          ),
  424          pterm(Name, Action),
  425          memberchk(Action, Actions)
  426      ->  Opts = [checked]
  427      ;   def_user_permissions(User, DefPermissions),
  428          memberchk(Name, DefPermissions)
  429      ->  Opts = [checked]
  430      ;   Opts = []
  431      )
  432    },
  433    html([ input([ type(checkbox),
  434                   name(Name)
  435                 | Opts
  436                 ]),
  437           Label
  438         ]).
  439
  440def_user_permissions(-, [read]).
  441def_user_permissions(admin, [read, write, admin]).
  442
  443
  444%!  edit_user(Request)
  445%
  446%   Handle reply from edit user form.
  447
  448edit_user(Request) :-
  449    authorized(admin(user(edit))),
  450    http_parameters(Request,
  451                    [ user(User),
  452                      realname(RealName,
  453                               [ optional(true),
  454                                 length > 2,
  455                                 description('Comment on user identifier-name')
  456                               ]),
  457                      read(Read),
  458                      write(Write),
  459                      admin(Admin)
  460                    ],
  461                    [ attribute_declarations(attribute_decl)
  462                    ]),
  463    modify_user(User, realname(RealName)),
  464    modify_permissions(User, Read, Write, Admin),
  465    list_users(Request).
  466
  467
  468modify_user(User, Property) :-
  469    Property =.. [_Name|Value],
  470    (   (   var(Value)
  471        ;   Value == ''
  472        )
  473    ->  true
  474    ;   set_user_property(User, Property)
  475    ).
  476
  477modify_permissions(User, Read, Write, Admin) :-
  478    phrase(allow(Read, Write, Admin), Allow),
  479    set_user_property(User, allow(Allow)).
  480
  481allow(Read, Write, Admin) -->
  482    allow(read, Read),
  483    allow(write, Write),
  484    allow(admin, Admin).
  485
  486allow(Access, on) -->
  487    { pterm(Access, Allow)
  488    },
  489    !,
  490    [ Allow
  491    ].
  492allow(_Access, off) -->
  493    !,
  494    [].
  495
  496pterm(read,  read(_Repositiory, _Action)).
  497pterm(write, write(_Repositiory, _Action)).
  498pterm(admin, admin(_Action)).
  499
  500
  501%!  del_user(+Request)
  502%
  503%   Delete a user
  504
  505del_user(Request) :-
  506    !,
  507    authorized(admin(del_user)),
  508    http_parameters(Request,
  509                    [ user(User)
  510                    ],
  511                    [ attribute_declarations(attribute_decl)
  512                    ]),
  513    (   User == admin
  514    ->  throw(error(permission_error(delete, user, User), _))
  515    ;   true
  516    ),
  517    user_del(User),
  518    list_users(Request).
  519
  520
  521%!  change_password_form(+Request)
  522%
  523%   Allow user to change the password
  524
  525change_password_form(_Request) :-
  526    logged_on(User),
  527    !,
  528    user_property(User, realname(RealName)),
  529    reply_html_page(cliopatria(default),
  530                    title('Change password'),
  531                    [ h1(['Change password for ', User, ' (', RealName, ')']),
  532
  533                      \change_password_form(User)
  534                    ]).
  535change_password_form(_Request) :-
  536    throw(error(context_error(not_logged_in), _)).
  537
  538
  539%!  change_password_form(+UserID)//
  540%
  541%   HTML component that shows a form   for changing the password for
  542%   UserID.
  543
  544change_password_form(User) -->
  545    html(form([ action(location_by_id(change_password)),
  546                method('POST')
  547              ],
  548              [ table([ id('change-password-form'),
  549                        class(form)
  550                      ],
  551                      [ \user_or_old(User),
  552                        \input(pwd1,     'New Password',
  553                               [type(password)]),
  554                        \input(pwd2,     'Retype',
  555                               [type(password)]),
  556                        tr(class(buttons),
  557                           td([ align(right),
  558                                colspan(2)
  559                              ],
  560                              input([ type(submit),
  561                                      value('Change password')
  562                                    ])))
  563                      ])
  564              ])).
  565
  566user_or_old(admin) -->
  567    !,
  568    input(user, 'User', []).
  569user_or_old(_) -->
  570    input(pwd0, 'Old password', [type(password)]).
  571
  572
  573%!  change_password(+Request)
  574%
  575%   HTTP handler to change the password. The user must be logged on.
  576
  577change_password(Request) :-
  578    logged_on(Login),
  579    !,
  580    http_parameters(Request,
  581                    [ user(User,     [ optional(true),
  582                                       description('User identifier-name')
  583                                     ]),
  584                      pwd0(Password, [ optional(true),
  585                                       description('Current password')
  586                                     ]),
  587                      pwd1(New),
  588                      pwd2(Retype)
  589                    ],
  590                    [ attribute_declarations(attribute_decl)
  591                    ]),
  592    (   Login == admin
  593    ->  (   current_user(User)
  594        ->  true
  595        ;   throw(error(existence_error(user, User), _))
  596        )
  597    ;   Login = User,
  598        validate_password(User, Password)
  599    ),
  600    (   New == Retype
  601    ->  true
  602    ;   throw(password_mismatch)
  603    ),
  604    password_hash(New, Hash),
  605    set_user_property(User, password(Hash)),
  606    reply_html_page(cliopatria(default),
  607                    'Password changed',
  608                    [ h1(align(center), 'Password changed'),
  609                      p([ 'Your password has been changed successfully' ])
  610                    ]).
  611change_password(_Request) :-
  612    throw(error(context_error(not_logged_in), _)).
  613
  614
  615
  616                 /*******************************
  617                 *             LOGIN            *
  618                 *******************************/
  619
  620%!  login_form(+Request)
  621%
  622%   HTTP handler that presents a form to login.
  623
  624login_form(_Request) :-
  625    reply_html_page(cliopatria(default),
  626                    'Login',
  627                    [ h1(align(center), 'Login'),
  628                      form([ action(location_by_id(user_login)),
  629                             method('POST')
  630                           ],
  631                           table([ tr([ th(align(right), 'User:'),
  632                                        td(input([ name(user),
  633                                                   size(40)
  634                                                 ]))
  635                                      ]),
  636                                   tr([ th(align(right), 'Password:'),
  637                                        td(input([ type(password),
  638                                                   name(password),
  639                                                   size(40)
  640                                                 ]))
  641                                      ]),
  642                                   tr([ td([ align(right), colspan(2) ],
  643                                           input([ type(submit),
  644                                                   value('Login')
  645                                                 ]))
  646                                      ])
  647                                 ])
  648                          )
  649                        ]).
  650
  651%!  user_login(+Request)
  652%
  653%   Handle  =user=  and  =password=.  If    there   is  a  parameter
  654%   =return_to= or =|openid.return_to|=, reply using   a redirect to
  655%   the given URL. Otherwise display a welcome page.
  656
  657user_login(Request) :-
  658    !,
  659    http_parameters(Request,
  660                    [ user(User),
  661                      password(Password),
  662                      'openid.return_to'(ReturnTo, [optional(true)]),
  663                      'return_to'(ReturnTo, [optional(true)])
  664                    ],
  665                    [ attribute_declarations(attribute_decl)
  666                    ]),
  667    (   var(ReturnTo)
  668    ->  Extra = []
  669    ;   uri_normalized(/, ReturnTo, PublicHost),
  670        Extra = [ return_to(ReturnTo),
  671                  public_host(PublicHost)
  672                ]
  673    ),
  674    reply_login([ user(User),
  675                  password(Password)
  676                | Extra
  677                ]).
  678
  679
  680reply_login(Options) :-
  681    option(user(User), Options),
  682    option(password(Password), Options),
  683    validate_password(User, Password),
  684    !,
  685    login(User, Options),
  686    (   option(return_to(ReturnTo), Options)
  687    ->  throw(http_reply(moved_temporary(ReturnTo)))
  688    ;   reply_html_page(cliopatria(default),
  689                        title('Login ok'),
  690                        h1(align(center), ['Welcome ', User]))
  691    ).
  692reply_login(_) :-
  693    reply_html_page(cliopatria(default),
  694                    title('Login failed'),
  695                    [ h1('Login failed'),
  696                      p(['Password incorrect'])
  697                    ]).
  698
  699%!  user_logout(+Request)
  700%
  701%   Logout the current user
  702
  703user_logout(_Request) :-
  704    logged_on(User),
  705    !,
  706    logout(User),
  707    reply_html_page(cliopatria(default),
  708                    title('Logout'),
  709                    h1(align(center), ['Logged out ', User])).
  710user_logout(_Request) :-
  711    reply_html_page(cliopatria(default),
  712                    title('Logout'),
  713                    [ h1(align(center), ['Not logged on']),
  714                      p(['Possibly you are logged out because the session ',
  715                         'has timed out.'])
  716                    ]).
  717
  718%!  attribute_decl(+Param, -DeclObtions) is semidet.
  719%
  720%   Provide   reusable   parameter   declarations   for   calls   to
  721%   http_parameters/3.
  722
  723attribute_decl(user,
  724               [ description('User identifier-name'),
  725                 length > 1
  726               ]).
  727attribute_decl(realname,
  728               [ description('Comment on user identifier-name')
  729               ]).
  730attribute_decl(description,
  731               [ optional(true),
  732                 description('Descriptive text')
  733               ]).
  734attribute_decl(password,
  735               [ description('Password')
  736               ]).
  737attribute_decl(pwd1,
  738               [ length > 5,
  739                 description('Password')
  740               ]).
  741attribute_decl(pwd2,
  742               [ length > 5,
  743                 description('Re-typed password')
  744               ]).
  745attribute_decl(openid_server,
  746               [ description('URL of an OpenID server')
  747               ]).
  748attribute_decl(read,
  749               [ description('Provide read-only access to the RDF store')
  750               | Options])   :- bool(off, Options).
  751attribute_decl(write,
  752               [ description('Provide write access to the RDF store')
  753               | Options])   :- bool(off, Options).
  754attribute_decl(admin,
  755               [ description('Provide administrative rights')
  756               | Options])   :- bool(off, Options).
  757
  758bool(Def,
  759     [ default(Def),
  760       oneof([on, off])
  761     ]).
  762
  763
  764                 /*******************************
  765                 *          OPENID ADMIN        *
  766                 *******************************/
  767
  768%!  add_openid_server_form(+Request)
  769%
  770%   Return an HTML page to add a new OpenID server.
  771
  772add_openid_server_form(_Request) :-
  773    authorized(admin(add_openid_server)),
  774    reply_html_page(cliopatria(default),
  775                    title('Add OpenID server'),
  776                    [ \new_openid_form
  777                    ]).
  778
  779
  780%!  new_openid_form// is det.
  781%
  782%   Present form to add a new OpenID provider.
  783
  784new_openid_form -->
  785    html([ h1('Add new OpenID server'),
  786           form([ action(location_by_id(add_openid_server)),
  787                  method('GET')
  788                ],
  789                table([ id('add-openid-server'),
  790                        class(form)
  791                      ],
  792                      [ \input(openid_server, 'Server homepage', []),
  793                        \input(openid_description, 'Server description',
  794                               []),
  795                        \permissions(-),
  796                        tr(class(buttons),
  797                           td([ colspan(2),
  798                                align(right)
  799                              ],
  800                              input([ type(submit),
  801                                      value('Create')
  802                                    ])))
  803                      ])),
  804           p([ 'Use this form to define access rights for users of an ',
  805               a(href('http://www.openid.net'), 'OpenID'), ' server. ',
  806               'The special server ', code(*), ' specifies access for all OpenID servers. ',
  807               'Here are some examples of servers:'
  808             ]),
  809           ul([ li(code('http://myopenid.com'))
  810              ])
  811         ]).
  812
  813
  814%!  add_openid_server(+Request)
  815%
  816%   Allow access from an OpenID server
  817
  818add_openid_server(Request) :-
  819    authorized(admin(add_openid_server)),
  820    http_parameters(Request,
  821                    [ openid_server(Server0,
  822                                    [ description('URL of the server to allow')]),
  823                      openid_description(Description,
  824                                         [ optional(true),
  825                                           description('Description of the server')
  826                                         ]),
  827                      read(Read),
  828                      write(Write)
  829                    ],
  830                    [ attribute_declarations(attribute_decl)
  831                    ]),
  832    phrase(allow(Read, Write, off), Allow),
  833    canonical_url(Server0, Server),
  834    Options = [ description(Description),
  835                allow(Allow)
  836              ],
  837    remove_optional(Options, Properties),
  838    openid_add_server(Server, Properties),
  839    list_users(Request).
  840
  841remove_optional([], []).
  842remove_optional([H|T0], [H|T]) :-
  843    arg(1, H, A),
  844    nonvar(A),
  845    !,
  846    remove_optional(T0, T).
  847remove_optional([_|T0], T) :-
  848    remove_optional(T0, T).
  849
  850
  851canonical_url(Var, Var) :-
  852    var(Var),
  853    !.
  854canonical_url(*, *) :- !.
  855canonical_url(URL0, URL) :-
  856    parse_url(URL0, Parts),
  857    parse_url(URL, Parts).
  858
  859
  860%!  edit_openid_server_form(+Request)
  861%
  862%   Form to edit user properties
  863
  864edit_openid_server_form(Request) :-
  865    authorized(admin(openid(edit))),
  866    http_parameters(Request,
  867                    [ openid_server(Server)
  868                    ],
  869                    [ attribute_declarations(attribute_decl)
  870                    ]),
  871
  872    reply_html_page(cliopatria(default),
  873                    title('Edit OpenID server'),
  874                    \edit_openid_server_form(Server)).
  875
  876edit_openid_server_form(Server) -->
  877    html([ h1(['Edit OpenID server ', Server]),
  878
  879           form([ action(location_by_id(edit_openid_server)),
  880                  method('GET')
  881                ],
  882                [ \hidden(openid_server, Server),
  883                  table([ class(form)
  884                        ],
  885                        [ \openid_property(Server, description, 'Description', []),
  886                          \permissions(Server),
  887                          tr(class(buttons),
  888                             td([ colspan(2),
  889                                  align(right)
  890                                ],
  891                                input([ type(submit),
  892                                        value('Modify')
  893                                      ])))
  894                        ])
  895                ]),
  896
  897           p(\action(location_by_id(del_openid_server) +
  898                     '?openid_server=' + encode(Server),
  899                     [ 'Delete ', b(Server) ]))
  900         ]).
  901
  902
  903openid_property(Server, Name, Label, Options) -->
  904    {  Term =.. [Name, Value],
  905       openid_server_property(Server, Term)
  906    -> O2 = [value(Value)|Options]
  907    ;  O2 = Options
  908    },
  909    html(tr([ th(align(right), Label),
  910              td(input([name(Name),size(40)|O2]))
  911            ])).
  912
  913
  914%!  openid_server_table(+Options)//
  915%
  916%   List registered openid servers
  917
  918openid_server_table(Options) -->
  919    { setof(S, openid_current_server(S), Servers), !
  920    },
  921    html([ table([ class(block)
  922                 ],
  923                 [ tr([ th('Server'),
  924                        th('Description')
  925                      ])
  926                 | \openid_list_servers(Servers, Options)
  927                 ])
  928         ]).
  929openid_server_table(_) -->
  930    [].
  931
  932openid_list_servers([], _) -->
  933    [].
  934openid_list_servers([H|T], Options) -->
  935    openid_list_server(H, Options),
  936    openid_list_servers(T, Options).
  937
  938openid_list_server(Server, Options) -->
  939    html(tr([td(\openid_server(Server)),
  940             td(\openid_field(Server, description)),
  941             \edit_openid_button(Server, Options)
  942            ])).
  943
  944edit_openid_button(Server, Options) -->
  945    { option(edit(true), Options) },
  946    !,
  947    html(td(a(href(location_by_id(edit_openid_server_form) +
  948                   '?openid_server='+encode(Server)
  949                  ), 'Edit'))).
  950edit_openid_button(_, _) --> [].
  951
  952
  953
  954openid_server(*) -->
  955    !,
  956    html(*).
  957openid_server(Server) -->
  958    html(a(href(Server), Server)).
  959
  960openid_field(Server, Field) -->
  961    { Term =.. [Field, Value],
  962      openid_server_property(Server, Term)
  963    },
  964    !,
  965    html(Value).
  966openid_field(_, _) -->
  967    [].
  968
  969
  970%!  edit_openid_server(Request)
  971%
  972%   Handle reply from OpenID server form.
  973
  974edit_openid_server(Request) :-
  975    authorized(admin(openid(edit))),
  976    http_parameters(Request,
  977                    [ openid_server(Server),
  978                      description(Description),
  979                      read(Read),
  980                      write(Write),
  981                      admin(Admin)
  982                    ],
  983                    [ attribute_declarations(attribute_decl)
  984                    ]),
  985    modify_openid(Server, description(Description)),
  986    openid_modify_permissions(Server, Read, Write, Admin),
  987    list_users(Request).
  988
  989
  990modify_openid(User, Property) :-
  991    Property =.. [_Name|Value],
  992    (   (   var(Value)
  993        ;   Value == ''
  994        )
  995    ->  true
  996    ;   openid_set_property(User, Property)
  997    ).
  998
  999
 1000openid_modify_permissions(Server, Read, Write, Admin) :-
 1001    phrase(allow(Read, Write, Admin), Allow),
 1002    openid_set_property(Server, allow(Allow)).
 1003
 1004
 1005%!  del_openid_server(+Request)
 1006%
 1007%   Delete an OpenID Server
 1008
 1009del_openid_server(Request) :-
 1010    !,
 1011    authorized(admin(openid(delete))),
 1012    http_parameters(Request,
 1013                    [ openid_server(Server)
 1014                    ],
 1015                    [ attribute_declarations(attribute_decl)
 1016                    ]),
 1017    openid_del_server(Server),
 1018    list_users(Request).
 1019
 1020
 1021                 /*******************************
 1022                 *             SETTINGS         *
 1023                 *******************************/
 1024
 1025%!  settings(+Request)
 1026%
 1027%   Show current settings. If user  has administrative rights, allow
 1028%   editing the settings.
 1029
 1030settings(_Request) :-
 1031    (   catch(authorized(admin(edit_settings)), _, fail)
 1032    ->  Edit = true
 1033    ;   authorized(admin(read_settings)),
 1034        Edit = false
 1035    ),
 1036    reply_html_page(cliopatria(default),
 1037                    title('Settings'),
 1038                    [ h1('Application settings'),
 1039                      \http_show_settings([ edit(Edit),
 1040                                            hide_module(false),
 1041                                            action('save_settings')
 1042                                          ]),
 1043                      \warn_no_edit(Edit)
 1044                    ]).
 1045
 1046warn_no_edit(true) --> !.
 1047warn_no_edit(_) -->
 1048    html(p(id(settings_no_edit),
 1049           [ a(href(location_by_id(login_form)), 'Login'),
 1050             ' as ', code(admin), ' to edit the settings.' ])).
 1051
 1052%!  save_settings(+Request)
 1053%
 1054%   Save modified settings.
 1055
 1056save_settings(Request) :-
 1057    authorized(admin(edit_settings)),
 1058    reply_html_page(cliopatria(default),
 1059                    title('Save settings'),
 1060                    \http_apply_settings(Request, [save(true)])).
 1061
 1062
 1063                 /*******************************
 1064                 *              EMIT            *
 1065                 *******************************/
 1066
 1067%!  hidden(+Name, +Value)
 1068%
 1069%   Create a hidden input field with given name and value
 1070
 1071hidden(Name, Value) -->
 1072    html(input([ type(hidden),
 1073                 name(Name),
 1074                 value(Value)
 1075               ])).
 1076
 1077action(URL, Label) -->
 1078    html([a([href(URL)], Label), br([])])