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).
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 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
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).
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))).
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 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).
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 ).
268site_user_logged_in(User) :-
269 openid_logged_in(OpenID),
270 site_user_property(User, openid(OpenID)).
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), 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 |}).
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 ])))).
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).
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).
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)).
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(_, _) --> [].
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 [].
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
(ShowAdmin) -->
664 html(tr([th('User'),
665 th('#Comments'),
666 th('#Reviews'),
667 th('#Votes'),
668 th('#Tags'),
669 \admin_header(ShowAdmin)
670 ])).
671
(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
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 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, 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 ).
832http_openid:openid_hook(x_parameter('https://www.google.com/accounts/o8/ud',
833 openid_shutdown_ack,
834 '2015-04-20')).
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
:-
858 current_output(CGI),
859 cgi_property(CGI, state(header)), !.
860
861:- http_handler(openid(login), plweb_login_page, [id(swipl_login)]).
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 ]).
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 ]).
960verify_user(Request) :-
961 openid_verify([ ax([ email(_, [required]),
962 nickname(_),
963 fullname(_),
964 firstname(_),
965 lastname(_)
966 ])
967 ], Request).
968
969
970 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').
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).
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).
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
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 [].
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 [].
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)).
1138logout_link -->
1139 { http_link_to_id(logout, [], Logout) },
1140 html(a([href(Logout)], 'logout')).
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)
Handle users of the SWI-Prolog website
This module provide the OpenID interface for the SWI-Prolog website. If you want to run this for local installations, make sure that your server is accessible through the public network and first direct your browser to the public network. Logging in using Google should work than. Some other providers have more strict requirements.
You can fake OpenID login using the debug interface:
?- debug(openid_fake('WouterBeek')).*/