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