1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@cs.vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (C): 2013-2015, VU University Amsterdam
    7
    8    This program is free software; you can redistribute it and/or
    9    modify it under the terms of the GNU General Public License
   10    as published by the Free Software Foundation; either version 2
   11    of the License, or (at your option) any later version.
   12
   13    This program is distributed in the hope that it will be useful,
   14    but WITHOUT ANY WARRANTY; without even the implied warranty of
   15    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   16    GNU General Public License for more details.
   17
   18    You should have received a copy of the GNU General Public
   19    License along with this library; if not, write to the Free Software
   20    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   21
   22    As a special exception, if you link this library with other files,
   23    compiled with a Free Software compiler, to produce an executable, this
   24    library does not by itself cause the resulting executable to be covered
   25    by the GNU General Public License. This exception does not however
   26    invalidate any other reasons why the executable file might be covered by
   27    the GNU General Public License.
   28*/
   29
   30:- module(plweb_openid,
   31	  [ site_user/2,		% +Request, -User
   32	    site_user_logged_in/1,	% -User
   33	    site_user_property/2,	% +User, ?Property
   34	    grant/2,			% +User, +Token
   35	    revoke/2,			% +User, +Token
   36	    authenticate/3,		% +Request, +Token, -Fields
   37	    user_profile_link//1,	% +User
   38	    current_user//1,		% +PageStyle
   39	    current_user//0,
   40	    login_link//1,		% +Request
   41	    redirect_master/1		% +Request
   42	  ]).   43:- use_module(library(http/http_dispatch)).   44:- use_module(library(http/http_parameters)).   45:- use_module(library(http/http_session)).   46:- use_module(library(http/http_wrapper)).   47:- use_module(library(http/http_openid)).   48:- use_module(library(http/http_header)).   49:- use_module(library(http/http_path)).   50:- use_module(library(http/html_write)).   51:- use_module(library(http/js_write)).   52:- use_module(library(http/http_json)).   53:- use_module(library(http/html_head)).   54:- use_module(library(http/http_authenticate)).   55:- use_module(library(http/http_host)).   56:- use_module(library(http/recaptcha)).   57:- use_module(library(http/http_stream)).   58:- use_module(library(persistency)).   59:- use_module(library(settings)).   60:- use_module(library(debug)).   61:- use_module(library(uuid)).   62:- use_module(library(option)).   63:- use_module(library(error)).   64:- use_module(library(lists)).   65:- use_module(library(pairs)).   66:- use_module(library(google_client)).   67
   68:- use_module(parms).   69:- use_module(review).   70:- use_module(pack).   71:- use_module(wiki).   72:- use_module(markitup).   73:- use_module(tagit).   74:- use_module(post).   75
   76/** <module> Handle users of the SWI-Prolog website
   77
   78This module provide the OpenID interface  for the SWI-Prolog website. If
   79you want to run this for local installations, make sure that your server
   80is accessible through the public network   and first direct your browser
   81to the public network. Logging in using   Google  should work than. Some
   82other providers have more strict requirements.
   83
   84You can fake OpenID login using the debug interface:
   85
   86    ==
   87    ?- debug(openid_fake('WouterBeek')).
   88    ==
   89*/
   90
   91:- multifile
   92	http_openid:openid_hook/1.   93
   94:- persistent
   95	openid_user_server(user:atom,
   96			   server:atom),
   97	site_user(uuid:atom,
   98		  openid:atom,
   99		  name:atom,
  100		  email:atom,
  101		  home_url:atom),
  102	user_description(uuid:atom,
  103			 description:atom),
  104	stay_signed_in(openid:atom,
  105		       cookie:atom,
  106		       peer:atom,
  107		       time:integer,
  108		       expires:integer),
  109	granted(uuid:atom,
  110		token:atom).  111
  112:- initialization
  113	db_attach('openid.db',
  114		  [ sync(close)
  115		  ]).  116
  117:- http_handler(root(user/create_profile),  create_profile, []).  118:- http_handler(root(user/submit_profile),  submit_profile, []).  119:- http_handler(root(user/logout),	    logout,         []).  120:- http_handler(root(user/view_profile),    view_profile,   []).  121:- http_handler(root(user/verify),          verify_user,    []).  122:- http_handler(root(user/list),            list_users,     []).  123:- http_handler(root(user/grant),           grant_user,     []).  124
  125
  126		 /*******************************
  127		 *	    USER ADMIN		*
  128		 *******************************/
  129
  130site_user_property(UUID, uuid(UUID)) :-
  131	(   site_user(UUID, _, _, _, _)
  132	->  true
  133	).
  134site_user_property(UUID, openid(OpenId)) :-
  135	site_user(UUID, OpenId, _, _, _).
  136site_user_property(UUID, name(Name)) :-
  137	site_user(UUID, _, Name, _, _).
  138site_user_property(UUID, email(Email)) :-
  139	site_user(UUID, _, _, Email, _).
  140site_user_property(UUID, home_url(Home)) :-
  141	site_user(UUID, _, _, _, Home).
  142site_user_property(UUID, granted(Token)) :-
  143	granted(UUID, Token).
  144site_user_property(UUID, granted_list(Tokens)) :-
  145	(   site_user(UUID, _, _, _, _)
  146	->  findall(Token, granted(UUID, Token), Tokens)
  147	).
  148
  149set_user_property(UUID, Prop) :-
  150	site_user_property(UUID, Prop), !.
  151set_user_property(UUID, openid(OpenId)) :-
  152	retract_site_user(UUID, _OldID, Name, Email, Home),
  153	assert_site_user(UUID, OpenId, Name, Email, Home).
  154
  155
  156		 /*******************************
  157		 *	      RIGHTS		*
  158		 *******************************/
  159
  160%%	grant(+User, +Token) is det.
  161%%	revoke(+User, +Token) is det.
  162%
  163%	Grant/revoke User (a UUID) the right to access Token.
  164
  165grant(User, Token) :-
  166	ground_user(User),
  167	must_be(atom, Token),
  168	granted(User, Token), !.
  169grant(User, Token) :-
  170	assert_granted(User, Token).
  171
  172revoke(User, Token) :-
  173	ground_user(User),
  174	must_be(atom, Token),
  175	\+ granted(User, Token), !.
  176revoke(User, Token) :-
  177	retract_granted(User, Token).
  178
  179ground_user(User) :-
  180	must_be(atom, User),
  181	site_user(User, _, _, _, _), !.
  182ground_user(User) :-
  183	existence_error(user, User).
  184
  185
  186%%	grant_user(+Request)
  187%
  188%	HTTP handler to grant or revoke rights for a user.
  189
  190grant_user(Request) :-
  191	catch(( http_read_json_dict(Request, Data),
  192		debug(grant, '~q', [Data]),
  193		admin_granted(Request),
  194		atom_string(UUID, Data.uuid),
  195		atom_string(Token, Data.token),
  196		(   Data.value == true
  197		->  grant(UUID, Token)
  198		;   revoke(UUID, Token)
  199		)
  200	      ), E,
  201	      throw(http_reply(bad_request(E)))),
  202	throw(http_reply(no_content)).
  203
  204admin_granted(_Request) :-
  205	site_user_logged_in(User),
  206	site_user_property(User, granted(admin)), !.
  207admin_granted(Request) :-
  208	memberchk(path(Path), Request),
  209	throw(http_reply(forbidden(Path))).
  210
  211%%	authenticate(+Request, +Token, -Fields)
  212%
  213%	Get authentication for editing wiki pages.  This now first tries
  214%	the OpenID login.
  215
  216authenticate(Request, Token, [UUID,Name]) :-
  217	site_user_logged_in(UUID),
  218	(   site_user_property(UUID, granted(Token))
  219	->  site_user_property(UUID, name(Name))
  220	;   option(path(Path), Request),
  221	    permission_error(access, http_location, Path)
  222	).
  223authenticate(Request, Token, Fields) :-
  224	redirect_master(Request),
  225	(   http_authenticate(basic(passwd), Request, Fields)
  226	->  true
  227	;   format(atom(Msg), 'SWI-Prolog ~w authoring', [Token]),
  228		   throw(http_reply(authorise(basic, Msg)))
  229	).
  230
  231
  232		 /*******************************
  233		 *	 USER INTERACTION	*
  234		 *******************************/
  235
  236:- multifile recaptcha:key/2.  237
  238:- setting(recaptcha:public_key, atom, '',
  239	   'reCAPTCHA public key').  240:- setting(recaptcha:private_key, atom, '',
  241	   'reCAPTCHA private key').  242
  243recaptcha:key(public,  Key) :- setting(recaptcha:public_key,  Key).
  244recaptcha:key(private, Key) :- setting(recaptcha:private_key, Key).
  245
  246%%	site_user(+Request, -User)
  247%
  248%	Demand the user to be logged on and, if this is the first logon,
  249%	verify the user and create a profile.
  250
  251site_user(Request, User) :-
  252	openid_user(Request, OpenID, []),
  253	ensure_profile(OpenID, User).
  254
  255ensure_profile(OpenID, User) :-
  256	(   site_user_property(User, openid(OpenID))
  257	->  true
  258	;   http_current_request(Request),
  259	    option(request_uri(RequestURI), Request),
  260	    http_link_to_id(create_profile, [return(RequestURI)], HREF),
  261	    http_redirect(moved_temporary, HREF, Request)
  262	).
  263
  264%%	site_user_logged_in(-User) is semidet.
  265%
  266%	True when User is logged on.  Does not try to logon the user.
  267
  268site_user_logged_in(User) :-
  269	openid_logged_in(OpenID),
  270	site_user_property(User, openid(OpenID)).
  271
  272
  273%%	create_profile(+Request).
  274%
  275%	Create a new user profile, and on success return to the original
  276%	location.
  277
  278create_profile(Request) :-
  279	openid_user(Request, OpenID, []),
  280	http_parameters(Request,
  281			[ return(Return, [])
  282			]),
  283	reply_html_page(
  284	    user(create_profile),
  285	    title('Create user profile for SWI-Prolog'),
  286	    \create_profile(OpenID, Return)).
  287
  288
  289create_profile(OpenID, Return) -->
  290	{ (   site_user_property(User, openid(OpenID))
  291	  ->  Op = 'Update profile'
  292	  ;   uuid(User),		% new user
  293	      Op = 'Create profile'
  294	  )
  295	},
  296	html(h1(class(wiki), Op)),
  297	{ http_link_to_id(submit_profile, [], Action),
  298	  user_init_property(User, name(Name), ''),
  299	  user_init_property(User, email(Email), ''),
  300	  user_init_property(User, home_url(HomeURL), '')
  301	},
  302	html(form([ class(create_profile), method('POST'), action(Action) ],
  303		  [ input([type(hidden), name(return), value(Return)]),
  304		    input([type(hidden), name(uuid), value(User)]),
  305		    table([ tr([th('OpenID'),   td(input([ name(openid),
  306							   value(OpenID),
  307							   disabled(disabled)
  308							 ]))]),
  309			    tr([th('Name'),     td(input([ name(name),
  310							   value(Name),
  311							   placeholder('Displayed name')
  312							 ]))]),
  313			    tr([th('Email'),    td(input([ name(email),
  314							   value(Email),
  315							   placeholder('Your E-mail address')
  316							 ]))]),
  317			    tr([th('Home URL'), td(input([ name(home_url),
  318							   value(HomeURL),
  319							   placeholder('http://')
  320							 ]))]),
  321			    \description(User),
  322			    tr(td(colspan(2), \recaptcha([]))),
  323			    tr(td([colspan(2), align(right)],
  324				  input([type(submit), value(Op)])))
  325			  ])
  326		  ])),
  327	expain_create_profile.
  328
  329user_init_property(User, P, Default) :-
  330	(   site_user_property(User, P)
  331	->  true
  332	;   http_session_data(ax(AX)),
  333	    ax(P, AX)
  334	->  true
  335	;   arg(1, P, Default)
  336	).
  337
  338ax(email(AX.get(email)), AX).
  339ax(name(AX.get(name)), AX) :- !.
  340ax(name(Name), AX) :-
  341	atomic_list_concat([AX.get(firstname), AX.get(lastname)], ' ', Name), !.
  342ax(name(AX.get(nickname)), AX).
  343
  344expain_create_profile -->
  345	html({|html||
  346	       <div class="smallprint">
  347	       On this page, we ask you to proof you are human and
  348	       create a minimal profile. Your name is displayed along with comments
  349	       that you create.  Your E-mail and home URL are used to detect authorship of
  350	       packs. Your E-mail and home URL will not be displayed,
  351	       nor be used for spamming and not be handed to third parties.
  352	       The editor can be used to add a short description about yourself.
  353	       This description is shown on your profile page that collects
  354	       your packages and ratings and reviews you performed.
  355	       </div>
  356	       |}).
  357
  358%%	description(+UUID)//
  359%
  360%	Provide field for entering a description about the user.
  361
  362description(UUID) -->
  363	{ (   user_description(UUID, Description)
  364	  ->  Extra = [value(Description)]
  365	  ;   Extra = []
  366	  )
  367	},
  368	html(tr(td(colspan(2),
  369		   \markitup([ id(description),
  370			       markup(pldoc),
  371			       cold(60),
  372			       rows(10)
  373			     | Extra
  374			     ])))).
  375
  376%%	submit_profile(+Request)
  377%
  378%	Handle submission of the user profile
  379
  380submit_profile(Request) :-
  381	openid_user(Request, OpenID, []),
  382	recaptcha_parameters(ReCAPTCHA),
  383	http_parameters(Request,
  384			[ uuid(User,         []),
  385			  name(Name0,        [optional(true), default(anonymous)]),
  386			  email(Email0,      [optional(true), default('')]),
  387			  home_url(Home0,    [optional(true), default('')]),
  388			  description(Descr, [optional(true), default('')]),
  389			  return(Return, [])
  390			| ReCAPTCHA
  391			]),
  392	(   catch(recaptcha_verify(Request, ReCAPTCHA), E, true)
  393	->  (   var(E)
  394	    ->  retractall_site_user(User, OpenID, _, _, _),
  395		normalize_space(atom(Name),  Name0),
  396		normalize_space(atom(Email), Email0),
  397		normalize_space(atom(Home),  Home0),
  398		assert_site_user(User, OpenID, Name, Email, Home),
  399		update_description(User, Descr),
  400		http_redirect(moved_temporary, Return, Request)
  401	    ;	E = error(domain_error(recaptcha_response, _), _)
  402	    ->	retry_captcha('CAPTCHA required', '')
  403	    ;	message_to_string(E, Msg)
  404	    ->	retry_captcha('CAPTCHA processing error', Msg)
  405	    )
  406	;   retry_captcha('CAPTCHA verification failed', '')
  407	).
  408
  409retry_captcha(Why, Warning) :-
  410	reply_html_page(
  411	    plain,
  412	    title('CAPTCHA failed'),
  413	    [ h1(class(wiki), Why),
  414	      p(class(error), Warning),
  415	      p([ 'Please use the back button of your browser and ',
  416		  'try again'
  417		])
  418	    ]).
  419
  420
  421update_description(UUID, '') :- !,
  422	retractall_user_description(UUID, _).
  423update_description(UUID, Description) :- !,
  424	retractall_user_description(UUID, _),
  425	assert_user_description(UUID, Description).
  426
  427%%	view_profile(+Request) is det.
  428%
  429%	HTTP handler showing the public  profile   for  a  user. Viewing
  430%	options:
  431%
  432%	  | Requested user is logged on | [view(private), edit_link(true)] |
  433%	  | Logged on is =admin=        | [view(admin)] |
  434%	  | Not logged on		| [view(public) |
  435
  436view_profile(Request) :-
  437	http_parameters(Request,
  438			[ user(UUID, [ optional(true) ])
  439			]),
  440	(   site_user_logged_in(User)
  441	->  (   User = UUID
  442	    ->  (   site_user_property(User, granted(admin))
  443		->  Options = [view(admin), edit_link(true)]
  444		;   Options = [view(private), edit_link(true)]
  445		)
  446	    ;	site_user_property(User, granted(admin))
  447	    ->	Options = [view(admin)]
  448	    ;	Options = [view(public)]
  449	    )
  450	;   (   var(UUID)
  451	    ->	existence_error(http_parameter, user)
  452	    ;	Options = [view(public)]
  453	    )
  454	),
  455	site_user_property(UUID, name(Name)),
  456	reply_html_page(
  457	    user(view_profile(UUID)),
  458	    title('User ~w'-[Name]),
  459	    [ \edit_link(UUID, Options),
  460	      \view_profile(UUID, Options)
  461	    ]).
  462
  463view_profile(UUID, Options) -->
  464	private_profile(UUID, Options),
  465	user_description(UUID, Options),
  466	user_tags(UUID, []),
  467	user_posts(UUID, annotation),
  468	user_posts(UUID, news),
  469	user_packs(UUID),
  470	profile_reviews(UUID).
  471
  472%%	private_profile(+UUID, +Options)// is det.
  473%
  474%	If the user is viewing his/her own profile or the logged on user
  475%	has =admin= rights, show a  table   holding  the private profile
  476%	information.
  477
  478private_profile(UUID, Options) -->
  479	{ option(view(private), Options)
  480	; option(view(admin), Options)
  481	}, !,
  482	html([ div(class('private-profile'),
  483		   [ h2(class(wiki),
  484			[ 'Private profile data',
  485			  \link_list_users
  486			]),
  487		     table([ \profile_data(UUID, 'Name',      name),
  488			     \profile_data(UUID, 'OpenID',    openid),
  489			     \profile_data(UUID, 'E-Mail',    email),
  490			     \profile_data(UUID, 'Home page', home_url)
  491			   | \admin_profile(UUID, Options)
  492			   ])
  493		   ]),
  494	       div(class(smallprint),
  495		   'The above private information is shown only to the owner.')
  496	     ]).
  497private_profile(_, _) --> [].
  498
  499admin_profile(UUID, Options) -->
  500	{ option(view(admin), Options) }, !,
  501	html([ \profile_data(UUID, 'UUID',    uuid),
  502	       \profile_data(UUID, 'Granted', granted_list)
  503	     ]).
  504admin_profile(_, _) --> [].
  505
  506link_list_users -->
  507	{ http_link_to_id(list_users, [], HREF)
  508	},
  509	html(a([ class('list-other-users'),
  510		 style('float:right;'),
  511		 href(HREF)
  512	       ], 'other users')).
  513
  514create_profile_link(HREF) :-
  515	http_current_request(Request),
  516	option(request_uri(Here), Request),
  517	http_link_to_id(create_profile, [return(Here)], HREF).
  518
  519profile_data(UUID, Label, Field) -->
  520	{ Term =.. [Field,Value],
  521	  site_user_property(UUID, Term),
  522	  (   value_dom(Field, UUID, Value, DOM)
  523	  ->  true
  524	  )
  525	},
  526	html(tr([ th([Label,:]),
  527		  td(DOM)
  528		])).
  529
  530value_dom(name,		_,    Name,    Name).
  531value_dom(uuid,		_,    UUID,    UUID).
  532value_dom(email,	_,    Email,   a(href('mailto:'+Email), Email)).
  533value_dom(granted_list,	UUID, Tokens, \token_list(UUID, Tokens, [edit(true)])).
  534value_dom(_,		_,    URL,     a(href(URL), URL)).
  535
  536%%	user_description(UUID, +Options)// is det.
  537%
  538%	Show user description
  539
  540user_description(UUID, _Options) -->
  541	{ user_description(UUID, Description),
  542	  Description \== '', !,
  543	  atom_codes(Description, Codes),
  544	  wiki_file_codes_to_dom(Codes, /, DOM0),
  545	  clean_dom(DOM0, DOM)
  546	},
  547	html(DOM).
  548user_description(_UUID, Options) -->
  549	{ option(edit_link(true), Options),
  550	  create_profile_link(Edit)
  551	},
  552	html([ i('No description.'),
  553	       ' Click ', a(href(Edit), here), ' to create one'
  554	     ]).
  555user_description(_, _) --> [].
  556
  557clean_dom([p(X)], X) :- !.
  558clean_dom(X, X).
  559
  560edit_link(_UUID, Options) -->
  561	{ option(edit_link(true), Options), !,
  562	  create_profile_link(Edit)
  563	},
  564	html(div(class('edit-profile'),
  565		 [ a(href(Edit), 'Edit'), ' profile'])).
  566edit_link(_, _) --> [].
  567
  568
  569%%	user_packs(UUID)// is det.
  570%
  571%	Show a filtered version of the pack table, holding the packs
  572%	created by this user.
  573
  574user_packs(UUID) -->
  575	{ setof(Pack, current_pack([author(UUID)], Pack), Packs), !,
  576	  sort_packs(rating, Packs, Sorted),
  577	  site_user_property(UUID, name(Name))
  578	},
  579	html([ h2(class(wiki), 'Packages by ~w'-[Name])
  580	     ]),
  581	pack_table(Sorted, []),
  582	html([ div(class(smallprint),
  583		   [ 'This list contains packages whose author name, e-mail ',
  584		     'or homepage url matches the profile information.'
  585		   ])
  586	     ]).
  587user_packs(_) -->
  588	[].
  589
  590
  591%%	list_users(+Request)
  592%
  593%	HTTP handler to list known users.
  594
  595list_users(_Request) :-
  596	site_user_logged_in(User), !,
  597	(   site_user_property(User, granted(admin))
  598	->  ShowAdmin = true
  599	;   ShowAdmin = false
  600	),
  601	findall(Kudos-Details,
  602		site_kudos(_UUID, Details, Kudos),
  603		Pairs),
  604	keysort(Pairs, Sorted),
  605	pairs_values(Sorted, Users),
  606	reverse(Users, BestFirst),
  607	reply_html_page(
  608	    user(list),
  609	    title('SWI-Prolog site users'),
  610	    [ \explain_user_listing,
  611	      \html_requires(css('stats.css')),
  612	      table(class(block),
  613		    [ \user_table_header(ShowAdmin)
  614		    | \user_rows(BestFirst, ShowAdmin)
  615		    ])
  616	    ]).
  617list_users(_Request) :-
  618	reply_html_page(
  619	    user(list),
  620	    title('Permission denied'),
  621	    [ \explain_user_listing_not_logged_on
  622	    ]).
  623
  624site_kudos(UUID, Details, Kudos) :-
  625	Details = _{ user:UUID,
  626		     news:NewsArticles,
  627		     annotations:Annotations,
  628		     reviews:Reviews,
  629		     tags:Tags,
  630		     votes:Up-Down
  631		   },
  632	site_user(UUID, _, _, _, _),
  633	user_post_count(UUID, news, NewsArticles),
  634	user_post_count(UUID, annotation, Annotations),
  635	user_review_count(UUID, Reviews),
  636	user_tag_count(UUID, Tags),
  637	user_vote_count(UUID, Up, Down),
  638	Kudos is ( NewsArticles*20 +
  639		   Reviews*10 +
  640		   Annotations*10 +
  641		   Tags*2 +
  642		   Up+Down
  643		 ).
  644
  645explain_user_listing -->
  646	html({|html||
  647	      <p>Below is a listing of all registered users with some
  648	      basic properties.  This is list only visible to other
  649	      registered users.
  650	     |}).
  651
  652explain_user_listing_not_logged_on -->
  653	html({|html||
  654	      <h1 class="wiki">Permission denied</h1>
  655
  656	      <p class="warning">A listing of all registered users is only
  657	      available to users who are logged in.
  658	     |}).
  659
  660user_rows([], _) --> [].
  661user_rows([H|T], ShowAdmin) --> user_row(H, ShowAdmin), user_rows(T, ShowAdmin).
  662
  663user_table_header(ShowAdmin) -->
  664	html(tr([th('User'),
  665		 th('#Comments'),
  666		 th('#Reviews'),
  667		 th('#Votes'),
  668		 th('#Tags'),
  669		 \admin_header(ShowAdmin)
  670		])).
  671
  672admin_header(true) --> !,
  673	html([ th('Granted'),
  674	       th('E-mail')
  675	     ]).
  676admin_header(_) --> [].
  677
  678user_row(Details, ShowAdmin) -->
  679	{ Up-Down = Details.votes },
  680	html(tr([td(\user_profile_link(Details.user)),
  681		 td(Details.annotations),
  682		 td(Details.reviews),
  683		 td('+~d-~d'-[Up,Down]),
  684		 td(Details.tags),
  685		 \admin_columns(Details.user, ShowAdmin)
  686		])).
  687
  688admin_columns(UUID, true) --> !,
  689	{ site_user_property(UUID, granted_list(Tokens)),
  690	  site_user_property(UUID, email(Email))
  691	},
  692	html([ td(\token_list(UUID, Tokens, [])),
  693	       td(\email(Email))
  694	     ]).
  695admin_columns(_, _) --> [].
  696
  697token_list(UUID, Tokens, Options) -->
  698	{ option(edit(true), Options), !,
  699	  http_link_to_id(grant_user, [], Action)
  700	},
  701	html([ \token(wiki,  UUID, Tokens),
  702	       \token(news,  UUID, Tokens),
  703	       \token(admin, UUID, Tokens)
  704	     ]),
  705	html_post(script, \granted_script(Action)).
  706token_list(_, Tokens, _Options) -->
  707	token_list(Tokens).
  708
  709token_list([]) --> [].
  710token_list([H|T]) -->
  711	html(H),
  712	(   {T==[]}
  713	->  []
  714	;   html([', ']),
  715	    token_list(T)
  716	).
  717
  718token(Token, UUID, Active) -->
  719	{   memberchk(Token, Active)
  720	->  Extra = [checked(checked)]
  721	;   Extra = []
  722	},
  723	html([ input([ type(checkbox),
  724		       class(grant),
  725		       name(Token),
  726		       value(UUID)
  727		     | Extra
  728		     ]),
  729	       Token
  730	     ]).
  731
  732granted_script(Action) -->
  733	js_script({|javascript(Action)||
  734$(document).ready(function() {
  735  $("input.grant").click(function(e)
  736  { e.preventDefault();
  737    var checkbox = $(this);
  738    var checked  = checkbox.prop("checked");
  739    var token    = checkbox.prop("name");
  740    var UUID     = checkbox.prop("value");
  741    $.ajax(Action,
  742	   { "contentType": "application/json; charset=utf-8",
  743	     "dataType": "json",
  744	     "data": JSON.stringify({ uuid:  UUID,
  745				      value: checked,
  746				      token: token
  747				    }),
  748	     "success": function() {
  749		checkbox.prop("checked", checked);
  750	     },
  751	     "type": "POST"
  752	   });
  753  });
  754});
  755		  |}).
  756
  757
  758email(Mail) -->
  759	html(a(href('mailto:'+Mail), Mail)).
  760
  761
  762		 /*******************************
  763		 *	     COMPONENTS		*
  764		 *******************************/
  765
  766%%	user_profile_link(+UUID)//
  767%
  768%	Create a link to the profile of a user.
  769
  770user_profile_link(UUID) -->
  771	{ site_user_property(UUID, name(Name)),
  772	  http_link_to_id(view_profile, [user(UUID)], HREF)
  773	}, !,
  774	html(a([class(user), href(HREF)], Name)).
  775
  776
  777		 /*******************************
  778		 *     OPENID CUSTOMIZATION	*
  779		 *******************************/
  780
  781stay_login_cookie(swipl_login).
  782
  783http_openid:openid_hook(trusted(OpenId, Server)) :-
  784	openid_user_server(OpenId, Server), !.
  785http_openid:openid_hook(trusted(OpenId, Server)) :-
  786	assert_openid_user_server(OpenId, Server), !.
  787http_openid:openid_hook(stay_signed_in(OpenId)) :-
  788	assertion(in_header_state),
  789	http_session_cookie(Cookie),
  790	get_time(NowF),
  791	Now is round(NowF),
  792	http_current_request(Request),
  793	http_peer(Request, Peer),
  794	Expires is Now+31*24*60*60,	% 31 days from now
  795	assert_stay_signed_in(OpenId, Cookie, Peer, Now, Expires),
  796	http_session_option(path(Path)),
  797	debug(openid(stay_signed_in),
  798	      'Created stay-signed-in for ~q', [OpenId]),
  799	http_timestamp(Expires, RFC1123),
  800	stay_login_cookie(CookieName),
  801	format('Set-Cookie: ~w=~w; Expires=~w; path=~w\r\n',
  802	       [CookieName, Cookie, RFC1123, Path]).
  803http_openid:openid_hook(logout(OpenId)) :-
  804	nonvar(OpenId),
  805	assertion(in_header_state),
  806	retractall_stay_signed_in(OpenId, _, _, _, _),
  807	http_session_option(path(Path)),
  808	stay_login_cookie(CookieName),
  809	format('Set-Cookie: ~w=; \c
  810	        expires=Tue, 01-Jan-1970 00:00:00 GMT; \c
  811		path=~w\r\n',
  812	       [CookieName, Path]),
  813	fail.
  814http_openid:openid_hook(logged_in(OpenId)) :-
  815	(   debugging(openid_fake(User)),
  816	    atom(User)
  817	->  debug(openid_fake(User), 'Fake login for ~q.', [User]),
  818	    OpenId = User
  819	;   http_in_session(_),
  820	    http_session_data(openid(OpenId))
  821	->  true
  822	;   http_current_request(Request),
  823	    memberchk(cookie(Cookies), Request),
  824	    memberchk(swipl_login=Cookie, Cookies),
  825	    stay_signed_in(OpenId, Cookie, _Peer, _Time, _Expires)
  826	->  http_open_session(_, []),
  827	    http_session_assert(openid(OpenId)),
  828	    debug(openid(stay_signed_in),
  829		  'Granted stay-signed-in for ~q', [OpenId])
  830	).
  831% see https://developers.google.com/accounts/docs/OpenID#shutdown-timetable
  832http_openid:openid_hook(x_parameter('https://www.google.com/accounts/o8/ud',
  833				    openid_shutdown_ack,
  834				    '2015-04-20')).
  835
  836
  837%%	yadis:xrds_specified_location(+Server, -XRDSLocation)
  838%
  839%	Hacks to deal with broken Yadis support.
  840%
  841%	  - Google does not support Yadis discovery, but does have an
  842%	    XRSD document, so we fake its location.
  843%	  - stackexchange.com serves an _OP Identifier Element_ instead
  844%	    of an _Claimed Identifier Element_ when doing Yadis
  845%	    discovery on the real OpenID.
  846
  847:- multifile
  848	yadis:xrds_specified_location/2.  849
  850yadis:xrds_specified_location('http://google.com/',
  851			      'https://www.google.com/accounts/o8/id').
  852yadis:xrds_specified_location(StackOverFlow, -) :-
  853	sub_atom(StackOverFlow, 0, _, A, 'https://openid.stackexchange.com/'),
  854	A > 0.
  855
  856
  857in_header_state :-
  858	current_output(CGI),
  859	cgi_property(CGI, state(header)), !.
  860
  861:- http_handler(openid(login),  plweb_login_page, [id(swipl_login)]).  862
  863%%	plweb_login_page(+Request)
  864%
  865%	HTTP handler that  overrules  the   location  openid(login)  for
  866%	customizating the -very basic- login page.
  867
  868plweb_login_page(Request) :-
  869	redirect_master(Request),
  870	memberchk(host(localhost), Request),
  871	\+ ( debugging(openid_fake(User)),
  872	     atom(User)
  873	   ),
  874	\+ http_public_host(Request, localhost, _, []),
  875	openid_current_url(Request, URL), !,
  876	throw(http_reply(see_other(URL))).
  877plweb_login_page(Request) :-
  878	http_open_session(_, []),
  879	http_parameters(Request,
  880			[ 'openid.return_to'(ReturnTo, [])
  881			]),
  882	http_link_to_id(verify_user, [], Action),
  883	quick_buttons(Buttons),
  884	reply_html_page(user(login),
  885			[ title('SWI-Prolog login')
  886			],
  887			[ \openid_login_form(
  888			       ReturnTo,
  889			       [ show_stay(true),
  890				 action(Action),
  891				 buttons(Buttons)
  892			       ]),
  893			  \explain
  894			]).
  895
  896explain -->
  897	html([ div(class(smallprint),
  898		   [ p([ 'Actions such as rating, commenting and tagging ',
  899			 'requires you to be signed in. ',
  900			 'We use ', a(href('http://openid.net/'), 'OpenID'), '. ',
  901			 'Currently, we accept any OpenID provider. ',
  902			 'Tested with ', \openid_ok
  903		       ]),
  904		     p([ 'After logging in for the first time, we will ask for ',
  905			 'some additional information.  All information is ',
  906			 'optional.'
  907		       ])
  908		   ])
  909	     ]).
  910
  911
  912%%	quick_buttons(-Buttons) is det.
  913%
  914%	Create a list of img(Attributes) terms for quick login.
  915
  916quick_buttons(Buttons) :-
  917	findall(Img, quick_button(Img), Buttons).
  918
  919quick_button(img([ src(Icon),
  920		   href(Provider),
  921		   alt(Name),
  922		   title('Sign in with '+Name)
  923		 ])) :-
  924	openid_provider(2, Provider, Name, ImgName),
  925	http_absolute_location(icons(ImgName), Icon, []).
  926
  927openid_provider(2, LoginWithGoogle, 'Google', 'social_google_box.png') :-
  928	http_link_to_id(login_with_google, [], LoginWithGoogle).
  929openid_provider(2, 'http://me.yahoo.com',  'Yahoo', 'social_yahoo_box_lilac.png').
  930openid_provider(1, 'https://openid.stackexchange.com/%user%', 'StackExchange', -).
  931
  932openid_ok -->
  933	{ Term = openid_provider(_Version, _URL, _Name, _Icon),
  934	  findall(Term, Term, Terms)
  935	},
  936	openid_ok(Terms).
  937
  938openid_ok([]) --> [].
  939openid_ok([H|T]) -->
  940	openid_ok1(H),
  941	(   {T == []}
  942	->  []
  943	;   html(', '),
  944	    openid_ok(T)
  945	).
  946
  947openid_ok1(openid_provider(2, URL, Name, _Icon)) --> !,
  948	html(a(href(URL), Name)).
  949openid_ok1(openid_provider(1, URL, Name, _Icon)) --> !,
  950	html([ Name, ' using the url ',
  951	       span(class('openid-url-pattern'), URL)
  952	     ]).
  953
  954
  955%%	verify_user(+Request)
  956%
  957%	HTTP handler for SWI-Prolog  site   login.  Calls openid_verify,
  958%	asking for additional attribute exchange.
  959
  960verify_user(Request) :-
  961	openid_verify([ ax([ email(_, [required]),
  962			     nickname(_),
  963			     fullname(_),
  964			     firstname(_),
  965			     lastname(_)
  966			   ])
  967		      ], Request).
  968
  969
  970		 /*******************************
  971		 *	   GOOGLE LOGIN		*
  972		 *******************************/
  973
  974:- if(current_predicate(oauth_authenticate/3)).  975
  976:- http_handler(root(user/login_with_google), login_with_google, []).  977
  978:- setting(google:client_id, atom, '',
  979	   'Google project ClientID code').  980:- setting(google:client_secret, atom, '',
  981	   'Google project ClientSecret code').  982
  983%%	login_with_google(+Request)
  984%
  985%	HTTP handler to login with Google.
  986
  987login_with_google(Request) :-
  988	http_parameters(Request,
  989			[ 'openid.return_to'(ReturnTo, [default(/)]),
  990			  stay(Stay, [default(false)])
  991			]),
  992	oauth_authenticate(Request, 'google.com',
  993			   [client_data(_{return_to:ReturnTo, stay:Stay})]).
  994
  995:- multifile
  996	google_client:key/2,
  997	google_client:login_existing_user/1,
  998	google_client:create_user/1.  999
 1000google_client:key(client_id, ClientID) :-
 1001	setting(google:client_id, ClientID).
 1002google_client:key(client_secret, ClientSecret) :-
 1003	setting(google:client_secret, ClientSecret).
 1004
 1005%%	google_client:login_existing_user(+Claim) is semidet.
 1006%
 1007%	True if the user is know to us and thus we can perform the login
 1008%	without further interaction.
 1009
 1010google_client:login_existing_user(Claim) :-
 1011	google_fake_open_id(Claim, GoogleID),
 1012	site_user_property(_User, openid(GoogleID)), !,
 1013	google_login(Claim).
 1014google_client:login_existing_user(Claim) :-
 1015	downcase_atom(Claim.get(email), ClaimedEmail),
 1016	site_user_property(UUID, email(Email)),
 1017	downcase_atom(Email, ClaimedEmail), !,
 1018	debug(google, 'Found ~p with ~p', [UUID, Claim.email]),
 1019	google_fake_open_id(Claim, GoogleID),
 1020	set_user_property(UUID, openid(GoogleID)),
 1021	google_login(Claim).
 1022
 1023%%	google_client:create_user(+Profile) is det.
 1024%
 1025%	Create a new user for the given Google Profile.
 1026
 1027google_client:create_user(Profile) :-
 1028	http_session_assert(ax(Profile)),
 1029	google_login(Profile).
 1030
 1031google_login(Claim) :-
 1032	http_open_session(_, []),
 1033	google_fake_open_id(Claim, GoogleID),
 1034	http_session_retractall(openid(_)),
 1035	http_session_assert(openid(GoogleID)),
 1036	http_current_request(Request),
 1037	(   true(Claim.client_data.stay)
 1038	->  debug(google, 'Stay signed in: ~p', [GoogleID]),
 1039	    http_openid:openid_hook(stay_signed_in(GoogleID))
 1040	;   true
 1041	),
 1042	http_redirect(moved_temporary, Claim.client_data.return_to, Request).
 1043
 1044google_fake_open_id(Claim, GoogleID) :-
 1045	atomic_list_concat(['http://google.com/fake_open_id/', Claim.sub],
 1046			   GoogleID).
 1047
 1048true(true).
 1049true(yes).
 1050
 1051:- endif. 1052
 1053
 1054		 /*******************************
 1055		 *	      LOGOUT		*
 1056		 *******************************/
 1057
 1058%%	logout(+Request)
 1059%
 1060%	Logout  the  current  user.  If  openid.return_to  is  provided,
 1061%	provide a back-link
 1062
 1063logout(Request) :-
 1064	openid_logged_in(OpenId), !,
 1065	openid_logout(OpenId),
 1066	reply_html_page(
 1067	    user(logout),
 1068	    title('Logged out'),
 1069	    [ p('Thanks for using www.swi-prolog.org'),
 1070	      \logout_back_link(Request)
 1071	    ]).
 1072logout(Request) :-
 1073	reply_html_page(
 1074	    user(logout),
 1075	    title('Not logged in'),
 1076	    [ p(class(warning), 'You are not logged in'),
 1077	      \logout_back_link(Request)
 1078	    ]).
 1079
 1080
 1081logout_back_link(Request) -->
 1082	{ http_parameters(Request,
 1083			  [ 'openid.return_to'(Return, [optional(true)])
 1084			  ]),
 1085	  nonvar(Return)
 1086	}, !,
 1087	html(p(['Go ', a(href(Return), back), '.'])).
 1088logout_back_link(_) -->
 1089	[].
 1090
 1091
 1092%%	current_user//
 1093
 1094current_user -->
 1095	current_user(default).
 1096
 1097current_user(Style) -->
 1098	{ Style \== create_profile,
 1099	  openid_logged_in(OpenID), !,
 1100	  ensure_profile(OpenID, User),
 1101	  (   site_user_property(User, name(Name)),
 1102	      Name \== ''
 1103	  ->  Display = Name
 1104	  ;   Display = OpenID
 1105	  ),
 1106	  http_link_to_id(view_profile, [], Profile)
 1107	},
 1108	html(div(class('current-user'),
 1109		 [ a([href(Profile)], Display),
 1110		   ' (', \logout_link, ')'
 1111		 ])).
 1112current_user(Style) -->
 1113	{ Style \== create_profile,
 1114	  http_current_request(Request), !
 1115	},
 1116	html(div(class('current-user'),
 1117		 \login_link(Request))).
 1118current_user(_Style) -->
 1119	[].
 1120
 1121%%	login_link(+Request)//
 1122%
 1123%	Create a link to login, which returns to the current page.
 1124
 1125login_link(Request) -->
 1126	{ (   memberchk(request_uri(Here), Request)
 1127	  ->  Attrs = ['openid.return_to'(Here)]
 1128	  ;   Attrs = []
 1129	  ),
 1130	  http_link_to_id(swipl_login, Attrs, Login)
 1131	},
 1132	html(a([class(signin), href(Login)], login)).
 1133
 1134%%	logout_link//
 1135%
 1136%	Create a link to logout
 1137
 1138logout_link -->
 1139	{ http_link_to_id(logout, [], Logout) },
 1140	html(a([href(Logout)], 'logout')).
 1141
 1142
 1143%%	redirect_master(+Request)
 1144%
 1145%	Redirect a request to the master server,   so  we do not have to
 1146%	deal with multiple versions of the database files.
 1147
 1148redirect_master(Request) :-
 1149	option(host(Host), Request),
 1150	server(_, Host),
 1151	server(master, Master),
 1152	Host \== Master, !,
 1153	option(request_uri(URI), Request),
 1154	format(string(To), 'https://~w~w', [Master, URI]),
 1155	http_redirect(see_other, To, Request)