Chris@0: /*  $Id$
Chris@0: 
Chris@0:     Part of SWI-Prolog
Chris@0: 
Chris@0:     Author:        Jan Wielemaker
Chris@0:     E-mail:        wielemak@science.uva.nl
Chris@0:     WWW:           http://www.swi-prolog.org
Chris@0:     Copyright (C): 2007, University of Amsterdam
Chris@0: 
Chris@0:     This program is free software; you can redistribute it and/or
Chris@0:     modify it under the terms of the GNU General Public License
Chris@0:     as published by the Free Software Foundation; either version 2
Chris@0:     of the License, or (at your option) any later version.
Chris@0: 
Chris@0:     This program is distributed in the hope that it will be useful,
Chris@0:     but WITHOUT ANY WARRANTY; without even the implied warranty of
Chris@0:     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
Chris@0:     GNU General Public License for more details.
Chris@0: 
Chris@0:     You should have received a copy of the GNU Lesser General Public
Chris@0:     License along with this library; if not, write to the Free Software
Chris@0:     Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
Chris@0: 
Chris@0:     As a special exception, if you link this library with other files,
Chris@0:     compiled with a Free Software compiler, to produce an executable, this
Chris@0:     library does not by itself cause the resulting executable to be covered
Chris@0:     by the GNU General Public License. This exception does not however
Chris@0:     invalidate any other reasons why the executable file might be covered by
Chris@0:     the GNU General Public License.
Chris@0: */
Chris@0: 
Chris@0: :- module(rdfql_openid,
Chris@0: 	  [ openid_for_local_user/2
Chris@0: 	  ]).
Chris@0: :- use_module(library('http/http_dispatch')).
Chris@0: :- use_module(library('http/http_wrapper')).
Chris@0: :- use_module(library('http/http_openid')).
Chris@0: :- use_module(library('http/http_parameters')).
Chris@0: :- use_module(library('http/http_session')).
Chris@0: :- use_module(library('http/html_write')).
Chris@0: :- use_module(library(lists)).
Chris@0: :- use_module(library(error)).
Chris@0: :- use_module(library(option)).
Chris@0: :- use_module(library(url)).
Chris@0: :- use_module(library(socket)).
Chris@0: :- use_module(library(debug)).
Chris@0: :- use_module(library(settings)).
Chris@0: :- use_module(http_admin).
Chris@0: :- use_module(user_db).
Chris@0: 
Chris@0: 
Chris@0: /** <module> OpenID server and client access
Chris@0: 
Chris@0: @author	Jan Wielemaker
Chris@0: */
Chris@0: 
Chris@0: 		 /*******************************
Chris@0: 		 *	CUSTOMISE OPENID	*
Chris@0: 		 *******************************/
Chris@0: 
Chris@0: :- http_handler(prefix('/openid/grant'),  openid_grant, []).
Chris@0: :- http_handler(prefix('/openid/file'),   openid_file, []).
Chris@0: 
Chris@0: :- multifile
Chris@0: 	http_openid:openid_hook/2.
Chris@0: 
Chris@0: http_openid:openid_hook(login(OpenID)) :-
Chris@0: 	login(OpenID).
Chris@0: http_openid:openid_hook(logout(OpenID)) :-
Chris@0: 	logout(OpenID).
Chris@0: http_openid:openid_hook(logged_in(OpenID)) :-
Chris@0: 	http_session_id(Session),
Chris@0: 	user_property(OpenID, session(Session)).
Chris@0: http_openid:openid_hook(trusted(OpenID, Server)) :-
Chris@0: 	(   openid_server_properties(Server, _)
Chris@0: 	->  true
Chris@0: 	;   format(string(Msg), 'OpenID server ~w is not trusted', [Server]),
Chris@0: 	    throw(error(permission_error(login, openid, OpenID),
Chris@0: 			context(_, Msg)))
Chris@0: 	).
Chris@0: 
Chris@0: 
Chris@0: :- http_handler('/openid/login', login_page, [priority(10)]).
Chris@0: 
Chris@0: login_page(Request) :-
Chris@0: 	http_parameters(Request,
Chris@0: 			[ 'openid.return_to'(ReturnTo, [])
Chris@0: 			]),
Chris@0: 	reply_html_page([ title('Login'),
Chris@0: 			  \openid_css,
Chris@0: 			  link([ rel(stylesheet),
Chris@0: 				 type('text/css'),
Chris@0: 				 href('../rdfql.css')
Chris@0: 			       ])
Chris@0: 			],
Chris@0: 			[ \explain_login(ReturnTo),
Chris@0: 			  \openid_login_form(ReturnTo, []),
Chris@0: 			  \local_login(ReturnTo)
Chris@0: 			]).
Chris@0: 			
Chris@0: explain_login(ReturnTo) -->
Chris@0: 	{ parse_url(ReturnTo, Parts),
Chris@0: 	  memberchk(path(Path), Parts)
Chris@0: 	},
Chris@0: 	html(div(class('rdfql-login'),
Chris@0: 		 [ p([ 'You are trying to access a page (~w) that requires authorization.'-[Path],
Chris@0: 		       'You can either login using an ', a(href('http://www.openid.net'), 'OpenID'),
Chris@0: 		       \explain_trusted_openid
Chris@0: 		     ])
Chris@0: 		 ])).
Chris@0: 
Chris@0: explain_trusted_openid -->
Chris@0: 	{ openid_current_server(*) }, !,
Chris@0: 	html(' or a local login.').
Chris@0: explain_trusted_openid -->
Chris@0: 	html([' from one of our ', a(href(list_trusted_servers), 'trusted providers'), ' or a local login']).
Chris@0: 
Chris@0: local_login(ReturnTo) -->
Chris@0: 	html(div(class('local-login'),
Chris@0: 		 [ div(class('local-message'),
Chris@0: 		       'Login with your local username and password'),
Chris@0: 		   form([ action('../user/login'),
Chris@0: 			  method('GET')
Chris@0: 			],
Chris@0: 			[ \hidden('openid.return_to', ReturnTo),
Chris@0: 			  div(input([name(user), size(20)])),
Chris@0: 			  div([ input([name(password), size(20), type(password)]),
Chris@0: 				input([type(submit), value('login')])
Chris@0: 			      ])
Chris@0: 			])
Chris@0: 		 ])).
Chris@0: 
Chris@0: hidden(Name, Value) -->
Chris@0: 	html(input([type(hidden), name(Name), value(Value)])).
Chris@0: 
Chris@0: 
Chris@0: :- http_handler('/openid/list_trusted_servers', trusted_openid_servers, []).
Chris@0: 
Chris@0: %%	trusted_openid_servers(+Request)
Chris@0: %
Chris@0: %	HTTP handler to emit a list of OpenID servers we trust.
Chris@0: 
Chris@0: trusted_openid_servers(_Request) :-
Chris@0: 	findall(S, openid_current_server(S), Servers),
Chris@0: 	reply_html_page(title('Trusted OpenID servers'),
Chris@0: 			[ h4('Trusted OpenID servers'),
Chris@0: 			  p([ 'We accept OpenID logins from the following OpenID providers. ',
Chris@0: 			      'Please register with one of them.'
Chris@0: 			    ]),
Chris@0: 			  ul(\trusted_openid_servers(Servers))
Chris@0: 			]).
Chris@0: 
Chris@0: trusted_openid_servers([]) -->
Chris@0: 	[].
Chris@0: trusted_openid_servers([H|T]) -->
Chris@0: 	trusted_openid_server(H),
Chris@0: 	trusted_openid_servers(T).
Chris@0: 
Chris@0: trusted_openid_server(*) --> !.
Chris@0: trusted_openid_server(URL) -->
Chris@0: 	html(li(a(href(URL), URL))).
Chris@0: 
Chris@0: 
Chris@0: 		 /*******************************
Chris@0: 		 *	   OPENID SERVER	*
Chris@0: 		 *******************************/
Chris@0: 
Chris@0: :- http_handler(prefix('/user/'), openid_userpage, []).
Chris@0: :- http_handler(prefix('/openid/server'), openid_server([]), []).
Chris@0: 
Chris@0: http_openid:openid_hook(grant(Request, Options)) :-
Chris@0: 	(   option(identity(Identity), Options),
Chris@0: 	    option(password(Password), Options),
Chris@0: 	    file_base_name(Identity, User),
Chris@0: 	    validate_password(User, Password)
Chris@0: 	->  option(trustroot(TrustRoot), Options),
Chris@0: 	    debug(openid, 'Granted access for ~w to ~w', [Identity, TrustRoot])
Chris@0: 	;   memberchk(path(Path), Request),
Chris@0: 	    throw(error(permission_error(http_location, access, Path),
Chris@0: 			context(_, 'Wrong password')))
Chris@0: 	).
Chris@0: 
Chris@0: 
Chris@0: %%	openid_userpage(+Request)
Chris@0: %
Chris@0: %	Server user page for a registered user
Chris@0: 
Chris@0: openid_userpage(Request) :-
Chris@0: 	memberchk(path(Path), Request),
Chris@0: 	concat_atom(Parts, /, Path),
Chris@0: 	append(_, [user, User], Parts), !,
Chris@0: 	file_base_name(Path, User),
Chris@0: 	(   current_user(User)
Chris@0: 	->  http_global_url('../openid/server', Me),
Chris@0: 	    findall(P, user_property(User, P), Props),
Chris@0: 	    reply_html_page([ link([ rel('openid.server'),
Chris@0: 				     href(Me)
Chris@0: 				   ]),
Chris@0: 			      title('OpenID page for user ~w'-[User])
Chris@0: 			    ],
Chris@0: 			    [ h1('OpenID page for user ~w'-[User]),
Chris@0: 			      \user_properties(Props)
Chris@0: 			    ])
Chris@0: 	;   existence_error(http_location, Path)
Chris@0: 	).
Chris@0: 
Chris@0: 
Chris@0: user_properties([]) -->
Chris@0: 	[].
Chris@0: user_properties([H|T]) -->
Chris@0: 	user_property(H),
Chris@0: 	user_properties(T).
Chris@0: 
Chris@0: user_property(realname(Name)) --> !,
Chris@0: 	html(div(['Real name: ', Name])).
Chris@0: user_property(connection(Login, IdleF)) --> !,
Chris@0: 	{ format_time(string(S), '%+', Login),
Chris@0: 	  Idle is round(IdleF),
Chris@0: 	  Hours is Idle // 3600,
Chris@0: 	  Min is Idle mod 3600 // 60,
Chris@0: 	  Sec is Idle mod 60
Chris@0: 	},
Chris@0: 	html(div(['Logged in since ~s, idle for ~d:~d:~d'-
Chris@0: 		  [S, Hours,Min,Sec]])).
Chris@0: user_property(_) -->
Chris@0: 	[].
Chris@0: 
Chris@0: 
Chris@0: %%	openid_for_local_user(+User, -URL) is semidet.
Chris@0: %
Chris@0: %	URL is the OpenID for the local user User.
Chris@0: 
Chris@0: openid_for_local_user(User, URL) :-
Chris@0: 	http_current_request(Request),
Chris@0: 	openid_current_host(Request, Host, Port),
Chris@0: 	(   catch(setting(http:prefix, Prefix), _, fail)
Chris@0: 	->  true
Chris@0: 	;   Prefix = '/'
Chris@0: 	),
Chris@0: 	(   Port == 80
Chris@0: 	->  format(atom(URL), 'http://~w~w/user/~w',
Chris@0: 		   [ Host, Prefix, User ])
Chris@0: 	;   format(atom(URL), 'http://~w:~w/~w/user/~w',
Chris@0: 		   [ Host, Port, Prefix, User ])
Chris@0: 	).
Chris@0: 
Chris@0: 
Chris@0: 
Chris@0: 		 /*******************************
Chris@0: 		 *	       UTIL		*
Chris@0: 		 *******************************/
Chris@0: 
Chris@0: %%	http_global_url(+Relative, -URL) is det.
Chris@0: %
Chris@0: %	URL is a fully qualified URL relative to the current request.
Chris@0: 
Chris@0: http_global_url(Local, URL) :-
Chris@0: 	http_current_request(Request),
Chris@0: 	openid_current_host(Request, Host, Port),
Chris@0: 	option(path(Path), Request, '/'),
Chris@0: 	option(protocol(Protocol), Request, http),
Chris@0: 	Base = [ protocol(Protocol),
Chris@0: 		 host(Host),
Chris@0: 		 port(Port),
Chris@0: 		 path(Path)
Chris@0: 	       ],
Chris@0: 	global_url(Local, Base, URL).
Chris@0: 
Chris@0: 
Chris@0: 		 /*******************************
Chris@0: 		 *	       TEST		*
Chris@0: 		 *******************************/
Chris@0: 
Chris@0: :- http_handler('/user/form/login', login_handler, [priority(10)]).
Chris@0: 
Chris@0: login_handler(_Request) :-
Chris@0: 	ensure_logged_on(User),
Chris@0: 	user_property(User, url(URL)),
Chris@0: 	reload_attr(sidebar, OnLoad),
Chris@0: 	reply_html_page(title('Login ok'),
Chris@0: 			body(OnLoad,
Chris@0: 			     [ h1('Login ok'),
Chris@0: 			       p(['You''re logged on with OpenID ',
Chris@0: 				  a(href(URL), URL)])
Chris@0: 			     ])).