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 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
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).
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))).
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).
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 ).
270site_user_logged_in(User) :-
271 openid_logged_in(OpenID),
272 site_user_property(User, openid(OpenID)).
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 |}).
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 ])))).
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).
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).
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)).
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(_, _) --> [].
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 [].
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
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')).
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)]).
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 ]).
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 ]).
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').
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).
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).
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
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 [].
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 [].
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)).
1140logout_link -->
1141 { http_link_to_id(logout, [], Logout) },
1142 html(a([href(Logout)], 'logout')).
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)
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')).*/