29
30:- module(plweb_openid,
31 [ site_user/2, 32 site_user_logged_in/1, 33 site_user_property/2, 34 grant/2, 35 revoke/2, 36 authenticate/3, 37 user_profile_link//1, 38 current_user//1, 39 current_user//0,
40 login_link//1, 41 redirect_master/1 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
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 absolute_file_name(data('openid.db'), File,
114 [ access(write) ]),
115 db_attach(File,
116 [ sync(close)
117 ]). 118
119:- http_handler(root(user/create_profile), create_profile, []). 120:- http_handler(root(user/submit_profile), submit_profile, []). 121:- http_handler(root(user/logout), logout, []). 122:- http_handler(root(user/view_profile), view_profile, []). 123:- http_handler(root(user/verify), verify_user, []). 124:- http_handler(root(user/list), list_users, []). 125:- http_handler(root(user/grant), grant_user, []). 126
127
128 131
132site_user_property(UUID, uuid(UUID)) :-
133 ( site_user(UUID, _, _, _, _)
134 -> true
135 ).
136site_user_property(UUID, openid(OpenId)) :-
137 site_user(UUID, OpenId, _, _, _).
138site_user_property(UUID, name(Name)) :-
139 site_user(UUID, _, Name, _, _).
140site_user_property(UUID, email(Email)) :-
141 site_user(UUID, _, _, Email, _).
142site_user_property(UUID, home_url(Home)) :-
143 site_user(UUID, _, _, _, Home).
144site_user_property(UUID, granted(Token)) :-
145 granted(UUID, Token).
146site_user_property(UUID, granted_list(Tokens)) :-
147 ( site_user(UUID, _, _, _, _)
148 -> findall(Token, granted(UUID, Token), Tokens)
149 ).
150
151set_user_property(UUID, Prop) :-
152 site_user_property(UUID, Prop), !.
153set_user_property(UUID, openid(OpenId)) :-
154 retract_site_user(UUID, _OldID, Name, Email, Home),
155 assert_site_user(UUID, OpenId, Name, Email, Home).
156
157
158 161
166
167grant(User, Token) :-
168 ground_user(User),
169 must_be(atom, Token),
170 granted(User, Token), !.
171grant(User, Token) :-
172 assert_granted(User, Token).
173
174revoke(User, Token) :-
175 ground_user(User),
176 must_be(atom, Token),
177 \+ granted(User, Token), !.
178revoke(User, Token) :-
179 retract_granted(User, Token).
180
181ground_user(User) :-
182 must_be(atom, User),
183 site_user(User, _, _, _, _), !.
184ground_user(User) :-
185 existence_error(user, User).
186
187
191
192grant_user(Request) :-
193 catch(( http_read_json_dict(Request, Data),
194 debug(grant, '~q', [Data]),
195 admin_granted(Request),
196 atom_string(UUID, Data.uuid),
197 atom_string(Token, Data.token),
198 ( Data.value == true
199 -> grant(UUID, Token)
200 ; revoke(UUID, Token)
201 )
202 ), E,
203 throw(http_reply(bad_request(E)))),
204 throw(http_reply(no_content)).
205
206admin_granted(_Request) :-
207 site_user_logged_in(User),
208 site_user_property(User, granted(admin)), !.
209admin_granted(Request) :-
210 memberchk(path(Path), Request),
211 throw(http_reply(forbidden(Path))).
212
217
218authenticate(Request, Token, [UUID,Name]) :-
219 site_user_logged_in(UUID),
220 ( site_user_property(UUID, granted(Token))
221 -> site_user_property(UUID, name(Name))
222 ; option(path(Path), Request),
223 permission_error(access, http_location, Path)
224 ).
225authenticate(Request, Token, Fields) :-
226 redirect_master(Request),
227 ( http_authenticate(basic(private(passwd)), Request, Fields)
228 -> true
229 ; format(atom(Msg), 'SWI-Prolog ~w authoring', [Token]),
230 throw(http_reply(authorise(basic, Msg)))
231 ).
232
233
234 237
238:- multifile recaptcha:key/2. 239
240:- setting(recaptcha:public_key, atom, '',
241 'reCAPTCHA public key'). 242:- setting(recaptcha:private_key, atom, '',
243 'reCAPTCHA private key'). 244
245recaptcha:key(public, Key) :- setting(recaptcha:public_key, Key).
246recaptcha:key(private, Key) :- setting(recaptcha:private_key, Key).
247
252
253site_user(Request, User) :-
254 openid_user(Request, OpenID, []),
255 ensure_profile(OpenID, User).
256
257ensure_profile(OpenID, User) :-
258 ( site_user_property(User, openid(OpenID))
259 -> true
260 ; http_current_request(Request),
261 option(request_uri(RequestURI), Request),
262 http_link_to_id(create_profile, [return(RequestURI)], HREF),
263 http_redirect(moved_temporary, HREF, Request)
264 ).
265
269
270site_user_logged_in(User) :-
271 openid_logged_in(OpenID),
272 site_user_property(User, openid(OpenID)).
273
274
279
280create_profile(Request) :-
281 openid_user(Request, OpenID, []),
282 http_parameters(Request,
283 [ return(Return, [])
284 ]),
285 reply_html_page(
286 user(create_profile),
287 title('Create user profile for SWI-Prolog'),
288 \create_profile(OpenID, Return)).
289
290
291create_profile(OpenID, Return) -->
292 { ( site_user_property(User, openid(OpenID))
293 -> Op = 'Update profile'
294 ; uuid(User), 295 Op = 'Create profile'
296 )
297 },
298 html(h1(class(wiki), Op)),
299 { http_link_to_id(submit_profile, [], Action),
300 user_init_property(User, name(Name), ''),
301 user_init_property(User, email(Email), ''),
302 user_init_property(User, home_url(HomeURL), '')
303 },
304 html(form([ class(create_profile), method('POST'), action(Action) ],
305 [ input([type(hidden), name(return), value(Return)]),
306 input([type(hidden), name(uuid), value(User)]),
307 table([ tr([th('OpenID'), td(input([ name(openid),
308 value(OpenID),
309 disabled(disabled)
310 ]))]),
311 tr([th('Name'), td(input([ name(name),
312 value(Name),
313 placeholder('Displayed name')
314 ]))]),
315 tr([th('Email'), td(input([ name(email),
316 value(Email),
317 placeholder('Your E-mail address')
318 ]))]),
319 tr([th('Home URL'), td(input([ name(home_url),
320 value(HomeURL),
321 placeholder('http://')
322 ]))]),
323 \description(User),
324 tr(td(colspan(2), \recaptcha([]))),
325 tr(td([colspan(2), align(right)],
326 input([type(submit), value(Op)])))
327 ])
328 ])),
329 expain_create_profile.
330
331user_init_property(User, P, Default) :-
332 ( site_user_property(User, P)
333 -> true
334 ; http_session_data(ax(AX)),
335 ax(P, AX)
336 -> true
337 ; arg(1, P, Default)
338 ).
339
340ax(email(AX.get(email)), AX).
341ax(name(AX.get(name)), AX) :- !.
342ax(name(Name), AX) :-
343 atomic_list_concat([AX.get(firstname), AX.get(lastname)], ' ', Name), !.
344ax(name(AX.get(nickname)), AX).
345
346expain_create_profile -->
347 html({|html||
348 <div class="smallprint">
349 On this page, we ask you to proof you are human and
350 create a minimal profile. Your name is displayed along with comments
351 that you create. Your E-mail and home URL are used to detect authorship of
352 packs. Your E-mail and home URL will not be displayed,
353 nor be used for spamming and not be handed to third parties.
354 The editor can be used to add a short description about yourself.
355 This description is shown on your profile page that collects
356 your packages and ratings and reviews you performed.
357 </div>
358 |}).
359
363
364description(UUID) -->
365 { ( user_description(UUID, Description)
366 -> Extra = [value(Description)]
367 ; Extra = []
368 )
369 },
370 html(tr(td(colspan(2),
371 \markitup([ id(description),
372 markup(pldoc),
373 cold(60),
374 rows(10)
375 | Extra
376 ])))).
377
381
382submit_profile(Request) :-
383 openid_user(Request, OpenID, []),
384 recaptcha_parameters(ReCAPTCHA),
385 http_parameters(Request,
386 [ uuid(User, []),
387 name(Name0, [optional(true), default(anonymous)]),
388 email(Email0, [optional(true), default('')]),
389 home_url(Home0, [optional(true), default('')]),
390 description(Descr, [optional(true), default('')]),
391 return(Return, [])
392 | ReCAPTCHA
393 ]),
394 ( catch(recaptcha_verify(Request, ReCAPTCHA), E, true)
395 -> ( var(E)
396 -> retractall_site_user(User, OpenID, _, _, _),
397 normalize_space(atom(Name), Name0),
398 normalize_space(atom(Email), Email0),
399 normalize_space(atom(Home), Home0),
400 assert_site_user(User, OpenID, Name, Email, Home),
401 update_description(User, Descr),
402 http_redirect(moved_temporary, Return, Request)
403 ; E = error(domain_error(recaptcha_response, _), _)
404 -> retry_captcha('CAPTCHA required', '')
405 ; message_to_string(E, Msg)
406 -> retry_captcha('CAPTCHA processing error', Msg)
407 )
408 ; retry_captcha('CAPTCHA verification failed', '')
409 ).
410
411retry_captcha(Why, Warning) :-
412 reply_html_page(
413 plain,
414 title('CAPTCHA failed'),
415 [ h1(class(wiki), Why),
416 p(class(error), Warning),
417 p([ 'Please use the back button of your browser and ',
418 'try again'
419 ])
420 ]).
421
422
423update_description(UUID, '') :- !,
424 retractall_user_description(UUID, _).
425update_description(UUID, Description) :- !,
426 retractall_user_description(UUID, _),
427 assert_user_description(UUID, Description).
428
437
438view_profile(Request) :-
439 http_parameters(Request,
440 [ user(UUID, [ optional(true) ])
441 ]),
442 ( site_user_logged_in(User)
443 -> ( User = UUID
444 -> ( site_user_property(User, granted(admin))
445 -> Options = [view(admin), edit_link(true)]
446 ; Options = [view(private), edit_link(true)]
447 )
448 ; site_user_property(User, granted(admin))
449 -> Options = [view(admin)]
450 ; Options = [view(public)]
451 )
452 ; ( var(UUID)
453 -> existence_error(http_parameter, user)
454 ; Options = [view(public)]
455 )
456 ),
457 site_user_property(UUID, name(Name)),
458 reply_html_page(
459 user(view_profile(UUID)),
460 title('User ~w'-[Name]),
461 [ \edit_link(UUID, Options),
462 \view_profile(UUID, Options)
463 ]).
464
465view_profile(UUID, Options) -->
466 private_profile(UUID, Options),
467 user_description(UUID, Options),
468 user_tags(UUID, []),
469 user_posts(UUID, annotation),
470 user_posts(UUID, news),
471 user_packs(UUID),
472 profile_reviews(UUID).
473
479
480private_profile(UUID, Options) -->
481 { option(view(private), Options)
482 ; option(view(admin), Options)
483 }, !,
484 html([ div(class('private-profile'),
485 [ h2(class(wiki),
486 [ 'Private profile data',
487 \link_list_users
488 ]),
489 table([ \profile_data(UUID, 'Name', name),
490 \profile_data(UUID, 'OpenID', openid),
491 \profile_data(UUID, 'E-Mail', email),
492 \profile_data(UUID, 'Home page', home_url)
493 | \admin_profile(UUID, Options)
494 ])
495 ]),
496 div(class(smallprint),
497 'The above private information is shown only to the owner.')
498 ]).
499private_profile(_, _) --> [].
500
501admin_profile(UUID, Options) -->
502 { option(view(admin), Options) }, !,
503 html([ \profile_data(UUID, 'UUID', uuid),
504 \profile_data(UUID, 'Granted', granted_list)
505 ]).
506admin_profile(_, _) --> [].
507
508link_list_users -->
509 { http_link_to_id(list_users, [], HREF)
510 },
511 html(a([ class('list-other-users'),
512 style('float:right;'),
513 href(HREF)
514 ], 'other users')).
515
516create_profile_link(HREF) :-
517 http_current_request(Request),
518 option(request_uri(Here), Request),
519 http_link_to_id(create_profile, [return(Here)], HREF).
520
521profile_data(UUID, Label, Field) -->
522 { Term =.. [Field,Value],
523 site_user_property(UUID, Term),
524 ( value_dom(Field, UUID, Value, DOM)
525 -> true
526 )
527 },
528 html(tr([ th([Label,:]),
529 td(DOM)
530 ])).
531
532value_dom(name, _, Name, Name).
533value_dom(uuid, _, UUID, UUID).
534value_dom(email, _, Email, a(href('mailto:'+Email), Email)).
535value_dom(granted_list, UUID, Tokens, \token_list(UUID, Tokens, [edit(true)])).
536value_dom(_, _, URL, a(href(URL), URL)).
537
541
542user_description(UUID, _Options) -->
543 { user_description(UUID, Description),
544 Description \== '', !,
545 atom_codes(Description, Codes),
546 wiki_file_codes_to_dom(Codes, /, DOM0),
547 clean_dom(DOM0, DOM)
548 },
549 html(DOM).
550user_description(_UUID, Options) -->
551 { option(edit_link(true), Options),
552 create_profile_link(Edit)
553 },
554 html([ i('No description.'),
555 ' Click ', a(href(Edit), here), ' to create one'
556 ]).
557user_description(_, _) --> [].
558
559clean_dom([p(X)], X) :- !.
560clean_dom(X, X).
561
562edit_link(_UUID, Options) -->
563 { option(edit_link(true), Options), !,
564 create_profile_link(Edit)
565 },
566 html(div(class('edit-profile'),
567 [ a(href(Edit), 'Edit'), ' profile'])).
568edit_link(_, _) --> [].
569
570
575
576user_packs(UUID) -->
577 { setof(Pack, current_pack([author(UUID)], Pack), Packs), !,
578 sort_packs(rating, Packs, Sorted),
579 site_user_property(UUID, name(Name))
580 },
581 html([ h2(class(wiki), 'Packages by ~w'-[Name])
582 ]),
583 pack_table(Sorted, []),
584 html([ div(class(smallprint),
585 [ 'This list contains packages whose author name, e-mail ',
586 'or homepage url matches the profile information.'
587 ])
588 ]).
589user_packs(_) -->
590 [].
591
592
596
597list_users(_Request) :-
598 site_user_logged_in(User), !,
599 ( site_user_property(User, granted(admin))
600 -> ShowAdmin = true
601 ; ShowAdmin = false
602 ),
603 findall(Kudos-Details,
604 site_kudos(_UUID, Details, Kudos),
605 Pairs),
606 keysort(Pairs, Sorted),
607 pairs_values(Sorted, Users),
608 reverse(Users, BestFirst),
609 reply_html_page(
610 user(list),
611 title('SWI-Prolog site users'),
612 [ \explain_user_listing,
613 \html_requires(css('stats.css')),
614 table(class(block),
615 [ \user_table_header(ShowAdmin)
616 | \user_rows(BestFirst, ShowAdmin)
617 ])
618 ]).
619list_users(_Request) :-
620 reply_html_page(
621 user(list),
622 title('Permission denied'),
623 [ \explain_user_listing_not_logged_on
624 ]).
625
626site_kudos(UUID, Details, Kudos) :-
627 Details = _{ user:UUID,
628 news:NewsArticles,
629 annotations:Annotations,
630 reviews:Reviews,
631 tags:Tags,
632 votes:Up-Down
633 },
634 site_user(UUID, _, _, _, _),
635 user_post_count(UUID, news, NewsArticles),
636 user_post_count(UUID, annotation, Annotations),
637 user_review_count(UUID, Reviews),
638 user_tag_count(UUID, Tags),
639 user_vote_count(UUID, Up, Down),
640 Kudos is ( NewsArticles*20 +
641 Reviews*10 +
642 Annotations*10 +
643 Tags*2 +
644 Up+Down
645 ).
646
647explain_user_listing -->
648 html({|html||
649 <p>Below is a listing of all registered users with some
650 basic properties. This is list only visible to other
651 registered users.
652 |}).
653
654explain_user_listing_not_logged_on -->
655 html({|html||
656 <h1 class="wiki">Permission denied</h1>
657
658 <p class="warning">A listing of all registered users is only
659 available to users who are logged in.
660 |}).
661
662user_rows([], _) --> [].
663user_rows([H|T], ShowAdmin) --> user_row(H, ShowAdmin), user_rows(T, ShowAdmin).
664
(ShowAdmin) -->
666 html(tr([th('User'),
667 th('#Comments'),
668 th('#Reviews'),
669 th('#Votes'),
670 th('#Tags'),
671 \admin_header(ShowAdmin)
672 ])).
673
(true) --> !,
675 html([ th('Granted'),
676 th('E-mail')
677 ]).
678admin_header(_) --> [].
679
680user_row(Details, ShowAdmin) -->
681 { Up-Down = Details.votes },
682 html(tr([td(\user_profile_link(Details.user)),
683 td(Details.annotations),
684 td(Details.reviews),
685 td('+~d-~d'-[Up,Down]),
686 td(Details.tags),
687 \admin_columns(Details.user, ShowAdmin)
688 ])).
689
690admin_columns(UUID, true) --> !,
691 { site_user_property(UUID, granted_list(Tokens)),
692 site_user_property(UUID, email(Email))
693 },
694 html([ td(\token_list(UUID, Tokens, [])),
695 td(\email(Email))
696 ]).
697admin_columns(_, _) --> [].
698
699token_list(UUID, Tokens, Options) -->
700 { option(edit(true), Options), !,
701 http_link_to_id(grant_user, [], Action)
702 },
703 html([ \token(wiki, UUID, Tokens),
704 \token(news, UUID, Tokens),
705 \token(admin, UUID, Tokens)
706 ]),
707 html_post(script, \granted_script(Action)).
708token_list(_, Tokens, _Options) -->
709 token_list(Tokens).
710
711token_list([]) --> [].
712token_list([H|T]) -->
713 html(H),
714 ( {T==[]}
715 -> []
716 ; html([', ']),
717 token_list(T)
718 ).
719
720token(Token, UUID, Active) -->
721 { memberchk(Token, Active)
722 -> Extra = [checked(checked)]
723 ; Extra = []
724 },
725 html([ input([ type(checkbox),
726 class(grant),
727 name(Token),
728 value(UUID)
729 | Extra
730 ]),
731 Token
732 ]).
733
734granted_script(Action) -->
735 js_script({|javascript(Action)||
736$(document).ready(function() {
737 $("input.grant").click(function(e)
738 { e.preventDefault();
739 var checkbox = $(this);
740 var checked = checkbox.prop("checked");
741 var token = checkbox.prop("name");
742 var UUID = checkbox.prop("value");
743 $.ajax(Action,
744 { "contentType": "application/json; charset=utf-8",
745 "dataType": "json",
746 "data": JSON.stringify({ uuid: UUID,
747 value: checked,
748 token: token
749 }),
750 "success": function() {
751 checkbox.prop("checked", checked);
752 },
753 "type": "POST"
754 });
755 });
756});
757 |}).
758
759
760email(Mail) -->
761 html(a(href('mailto:'+Mail), Mail)).
762
763
764 767
771
772user_profile_link(UUID) -->
773 { site_user_property(UUID, name(Name)),
774 http_link_to_id(view_profile, [user(UUID)], HREF)
775 }, !,
776 html(a([class(user), href(HREF)], Name)).
777
778
779 782
783stay_login_cookie(swipl_login).
784
785http_openid:openid_hook(trusted(OpenId, Server)) :-
786 openid_user_server(OpenId, Server), !.
787http_openid:openid_hook(trusted(OpenId, Server)) :-
788 assert_openid_user_server(OpenId, Server), !.
789http_openid:openid_hook(stay_signed_in(OpenId)) :-
790 assertion(in_header_state),
791 http_session_cookie(Cookie),
792 get_time(NowF),
793 Now is round(NowF),
794 http_current_request(Request),
795 http_peer(Request, Peer),
796 Expires is Now+31*24*60*60, 797 assert_stay_signed_in(OpenId, Cookie, Peer, Now, Expires),
798 http_session_option(path(Path)),
799 debug(openid(stay_signed_in),
800 'Created stay-signed-in for ~q', [OpenId]),
801 http_timestamp(Expires, RFC1123),
802 stay_login_cookie(CookieName),
803 format('Set-Cookie: ~w=~w; Expires=~w; path=~w\r\n',
804 [CookieName, Cookie, RFC1123, Path]).
805http_openid:openid_hook(logout(OpenId)) :-
806 nonvar(OpenId),
807 assertion(in_header_state),
808 retractall_stay_signed_in(OpenId, _, _, _, _),
809 http_session_option(path(Path)),
810 stay_login_cookie(CookieName),
811 format('Set-Cookie: ~w=; \c
812 expires=Tue, 01-Jan-1970 00:00:00 GMT; \c
813 path=~w\r\n',
814 [CookieName, Path]),
815 fail.
816http_openid:openid_hook(logged_in(OpenId)) :-
817 ( debugging(openid_fake(User)),
818 atom(User)
819 -> debug(openid_fake(User), 'Fake login for ~q.', [User]),
820 OpenId = User
821 ; http_in_session(_),
822 http_session_data(openid(OpenId))
823 -> true
824 ; http_current_request(Request),
825 memberchk(cookie(Cookies), Request),
826 memberchk(swipl_login=Cookie, Cookies),
827 stay_signed_in(OpenId, Cookie, _Peer, _Time, _Expires)
828 -> http_open_session(_, []),
829 http_session_assert(openid(OpenId)),
830 debug(openid(stay_signed_in),
831 'Granted stay-signed-in for ~q', [OpenId])
832 ).
834http_openid:openid_hook(x_parameter('https://www.google.com/accounts/o8/ud',
835 openid_shutdown_ack,
836 '2015-04-20')).
837
838
848
849:- multifile
850 yadis:xrds_specified_location/2. 851
852yadis:xrds_specified_location('http://google.com/',
853 'https://www.google.com/accounts/o8/id').
854yadis:xrds_specified_location(StackOverFlow, -) :-
855 sub_atom(StackOverFlow, 0, _, A, 'https://openid.stackexchange.com/'),
856 A > 0.
857
858
:-
860 current_output(CGI),
861 cgi_property(CGI, state(header)), !.
862
863:- http_handler(openid(login), plweb_login_page, [id(swipl_login)]). 864
869
870plweb_login_page(Request) :-
871 redirect_master(Request),
872 memberchk(host(localhost), Request),
873 \+ ( debugging(openid_fake(User)),
874 atom(User)
875 ),
876 \+ http_public_host(Request, localhost, _, []),
877 openid_current_url(Request, URL), !,
878 throw(http_reply(see_other(URL))).
879plweb_login_page(Request) :-
880 http_open_session(_, []),
881 http_parameters(Request,
882 [ 'openid.return_to'(ReturnTo, [])
883 ]),
884 http_link_to_id(verify_user, [], Action),
885 quick_buttons(Buttons),
886 reply_html_page(user(login),
887 [ title('SWI-Prolog login')
888 ],
889 [ \openid_login_form(
890 ReturnTo,
891 [ show_stay(true),
892 action(Action),
893 buttons(Buttons)
894 ]),
895 \explain
896 ]).
897
898explain -->
899 html([ div(class(smallprint),
900 [ p([ 'Actions such as rating, commenting and tagging ',
901 'requires you to be signed in. ',
902 'We use ', a(href('http://openid.net/'), 'OpenID'), '. ',
903 'Currently, we accept any OpenID provider. ',
904 'Tested with ', \openid_ok
905 ]),
906 p([ 'After logging in for the first time, we will ask for ',
907 'some additional information. All information is ',
908 'optional.'
909 ])
910 ])
911 ]).
912
913
917
918quick_buttons(Buttons) :-
919 findall(Img, quick_button(Img), Buttons).
920
921quick_button(img([ src(Icon),
922 href(Provider),
923 alt(Name),
924 title('Sign in with '+Name)
925 ])) :-
926 openid_provider(2, Provider, Name, ImgName),
927 http_absolute_location(icons(ImgName), Icon, []).
928
929openid_provider(2, LoginWithGoogle, 'Google', 'social_google_box.png') :-
930 http_link_to_id(login_with_google, [], LoginWithGoogle).
931openid_provider(2, 'http://me.yahoo.com', 'Yahoo', 'social_yahoo_box_lilac.png').
932openid_provider(1, 'https://openid.stackexchange.com/%user%', 'StackExchange', -).
933
934openid_ok -->
935 { Term = openid_provider(_Version, _URL, _Name, _Icon),
936 findall(Term, Term, Terms)
937 },
938 openid_ok(Terms).
939
940openid_ok([]) --> [].
941openid_ok([H|T]) -->
942 openid_ok1(H),
943 ( {T == []}
944 -> []
945 ; html(', '),
946 openid_ok(T)
947 ).
948
949openid_ok1(openid_provider(2, URL, Name, _Icon)) --> !,
950 html(a(href(URL), Name)).
951openid_ok1(openid_provider(1, URL, Name, _Icon)) --> !,
952 html([ Name, ' using the url ',
953 span(class('openid-url-pattern'), URL)
954 ]).
955
956
961
962verify_user(Request) :-
963 openid_verify([ ax([ email(_, [required]),
964 nickname(_),
965 fullname(_),
966 firstname(_),
967 lastname(_)
968 ])
969 ], Request).
970
971
972 975
976:- if(current_predicate(oauth_authenticate/3)). 977
978:- http_handler(root(user/login_with_google), login_with_google, []). 979
980:- setting(google:client_id, atom, '',
981 'Google project ClientID code'). 982:- setting(google:client_secret, atom, '',
983 'Google project ClientSecret code'). 984
988
989login_with_google(Request) :-
990 http_parameters(Request,
991 [ 'openid.return_to'(ReturnTo, [default(/)]),
992 stay(Stay, [default(false)])
993 ]),
994 oauth_authenticate(Request, 'google.com',
995 [client_data(_{return_to:ReturnTo, stay:Stay})]).
996
997:- multifile
998 google_client:key/2,
999 google_client:login_existing_user/1,
1000 google_client:create_user/1. 1001
1002google_client:key(client_id, ClientID) :-
1003 setting(google:client_id, ClientID).
1004google_client:key(client_secret, ClientSecret) :-
1005 setting(google:client_secret, ClientSecret).
1006
1011
1012google_client:login_existing_user(Claim) :-
1013 google_fake_open_id(Claim, GoogleID),
1014 site_user_property(_User, openid(GoogleID)), !,
1015 google_login(Claim).
1016google_client:login_existing_user(Claim) :-
1017 downcase_atom(Claim.get(email), ClaimedEmail),
1018 site_user_property(UUID, email(Email)),
1019 downcase_atom(Email, ClaimedEmail), !,
1020 debug(google, 'Found ~p with ~p', [UUID, Claim.email]),
1021 google_fake_open_id(Claim, GoogleID),
1022 set_user_property(UUID, openid(GoogleID)),
1023 google_login(Claim).
1024
1028
1029google_client:create_user(Profile) :-
1030 http_session_assert(ax(Profile)),
1031 google_login(Profile).
1032
1033google_login(Claim) :-
1034 http_open_session(_, []),
1035 google_fake_open_id(Claim, GoogleID),
1036 http_session_retractall(openid(_)),
1037 http_session_assert(openid(GoogleID)),
1038 http_current_request(Request),
1039 ( true(Claim.client_data.stay)
1040 -> debug(google, 'Stay signed in: ~p', [GoogleID]),
1041 http_openid:openid_hook(stay_signed_in(GoogleID))
1042 ; true
1043 ),
1044 http_redirect(moved_temporary, Claim.client_data.return_to, Request).
1045
1046google_fake_open_id(Claim, GoogleID) :-
1047 atomic_list_concat(['http://google.com/fake_open_id/', Claim.sub],
1048 GoogleID).
1049
1050true(true).
1051true(yes).
1052
1053:- endif. 1054
1055
1056 1059
1064
1065logout(Request) :-
1066 openid_logged_in(OpenId), !,
1067 openid_logout(OpenId),
1068 reply_html_page(
1069 user(logout),
1070 title('Logged out'),
1071 [ p('Thanks for using www.swi-prolog.org'),
1072 \logout_back_link(Request)
1073 ]).
1074logout(Request) :-
1075 reply_html_page(
1076 user(logout),
1077 title('Not logged in'),
1078 [ p(class(warning), 'You are not logged in'),
1079 \logout_back_link(Request)
1080 ]).
1081
1082
1083logout_back_link(Request) -->
1084 { http_parameters(Request,
1085 [ 'openid.return_to'(Return, [optional(true)])
1086 ]),
1087 nonvar(Return)
1088 }, !,
1089 html(p(['Go ', a(href(Return), back), '.'])).
1090logout_back_link(_) -->
1091 [].
1092
1093
1095
1096current_user -->
1097 current_user(default).
1098
1099current_user(Style) -->
1100 { Style \== create_profile,
1101 openid_logged_in(OpenID), !,
1102 ensure_profile(OpenID, User),
1103 ( site_user_property(User, name(Name)),
1104 Name \== ''
1105 -> Display = Name
1106 ; Display = OpenID
1107 ),
1108 http_link_to_id(view_profile, [], Profile)
1109 },
1110 html(div(class('current-user'),
1111 [ a([href(Profile)], Display),
1112 ' (', \logout_link, ')'
1113 ])).
1114current_user(Style) -->
1115 { Style \== create_profile,
1116 http_current_request(Request), !
1117 },
1118 html(div(class('current-user'),
1119 \login_link(Request))).
1120current_user(_Style) -->
1121 [].
1122
1126
1127login_link(Request) -->
1128 { ( memberchk(request_uri(Here), Request)
1129 -> Attrs = ['openid.return_to'(Here)]
1130 ; Attrs = []
1131 ),
1132 http_link_to_id(swipl_login, Attrs, Login)
1133 },
1134 html(a([class(signin), href(Login)], login)).
1135
1139
1140logout_link -->
1141 { http_link_to_id(logout, [], Logout) },
1142 html(a([href(Logout)], 'logout')).
1143
1144
1149
1150redirect_master(Request) :-
1151 option(host(Host), Request),
1152 server(_, Host),
1153 server(master, Master),
1154 Host \== Master, !,
1155 option(request_uri(URI), Request),
1156 format(string(To), 'https://~w~w', [Master, URI]),
1157 http_redirect(see_other, To, Request)