daniel@53: /*  Part of SWI-Prolog
daniel@53: 
daniel@53:     Author:        Jan Wielemaker
daniel@53:     E-mail:        J.Wielemaker@cs.vu.nl
daniel@53:     WWW:           http://www.swi-prolog.org
daniel@53:     Copyright (C): 2007-2013, University of Amsterdam,
daniel@53: 			      VU University Amsterdam
daniel@53: 
daniel@53:     This program is free software; you can redistribute it and/or
daniel@53:     modify it under the terms of the GNU General Public License
daniel@53:     as published by the Free Software Foundation; either version 2
daniel@53:     of the License, or (at your option) any later version.
daniel@53: 
daniel@53:     This program is distributed in the hope that it will be useful,
daniel@53:     but WITHOUT ANY WARRANTY; without even the implied warranty of
daniel@53:     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
daniel@53:     GNU General Public License for more details.
daniel@53: 
daniel@53:     You should have received a copy of the GNU Lesser General Public
daniel@53:     License along with this library; if not, write to the Free Software
daniel@53:     Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
daniel@53: 
daniel@53:     As a special exception, if you link this library with other files,
daniel@53:     compiled with a Free Software compiler, to produce an executable, this
daniel@53:     library does not by itself cause the resulting executable to be covered
daniel@53:     by the GNU General Public License. This exception does not however
daniel@53:     invalidate any other reasons why the executable file might be covered by
daniel@53:     the GNU General Public License.
daniel@53: */
daniel@53: 
daniel@53: :- module(http_openid,
daniel@53: 	  [ openid_login/1,		% +OpenID
daniel@53: 	    openid_logout/1,		% +OpenID
daniel@53: 	    openid_logged_in/1,		% -OpenID
daniel@53: 
daniel@53: 					% transparent login
daniel@53: 	    openid_user/3,		% +Request, -User, +Options
daniel@53: 
daniel@53: 					% low-level primitives
daniel@53: 	    openid_verify/2,		% +Options, +Request
daniel@53: 	    openid_authenticate/4,	% +Request, -Server, -Identity, -ReturnTo
daniel@53: 	    openid_associate/3,		% +OpenIDServer, -Handle, -Association
daniel@53: 	    openid_associate/4,		% +OpenIDServer, -Handle, -Association,
daniel@53: 					% +Options
daniel@53: 	    openid_server/2,		% +Options, +Request
daniel@53: 	    openid_server/3,		% ?OpenIDLogin, ?OpenID, ?Server
daniel@53: 	    openid_grant/1,		% +Request
daniel@53: 
daniel@53: 	    openid_login_form//2,	% +ReturnTo, +Options, //
daniel@53: 
daniel@53: 	    openid_current_url/2,	% +Request, -URL
daniel@53: 	    openid_current_host/3	% +Request, -Host, -Port
daniel@53: 	  ]).
daniel@53: :- use_module(library(http/http_open)).
daniel@53: :- use_module(library(http/html_write)).
daniel@53: :- use_module(library(http/http_parameters)).
daniel@53: :- use_module(library(http/http_dispatch)).
daniel@53: :- use_module(library(http/http_session)).
daniel@53: :- use_module(library(http/http_host)).
daniel@53: :- use_module(library(http/http_path)).
daniel@53: :- use_module(library(http/html_head)).
daniel@53: :- use_module(library(http/http_server_files), []).
daniel@53: :- use_module(library(http/yadis)).
daniel@53: :- use_module(library(http/ax)).
daniel@53: :- use_module(library(utf8)).
daniel@53: :- use_module(library(error)).
daniel@53: :- use_module(library(xpath)).
daniel@53: :- use_module(library(sgml)).
daniel@53: :- use_module(library(uri)).
daniel@53: :- use_module(library(occurs)).
daniel@53: :- use_module(library(base64)).
daniel@53: :- use_module(library(debug)).
daniel@53: :- use_module(library(record)).
daniel@53: :- use_module(library(option)).
daniel@53: :- use_module(library(sha)).
daniel@53: :- use_module(library(lists)).
daniel@53: :- use_module(library(settings)).
daniel@53: 
daniel@53: :- predicate_options(openid_login_form/4, 2,
daniel@53: 		     [ action(atom),
daniel@53: 		       buttons(list),
daniel@53: 		       show_stay(boolean)
daniel@53: 		     ]).
daniel@53: :- predicate_options(openid_server/2, 1,
daniel@53: 		     [ expires_in(any)
daniel@53: 		     ]).
daniel@53: :- predicate_options(openid_user/3, 3,
daniel@53: 		     [ login_url(atom)
daniel@53: 		     ]).
daniel@53: :- predicate_options(openid_verify/2, 1,
daniel@53: 		     [ return_to(atom),
daniel@53: 		       trust_root(atom),
daniel@53: 		       realm(atom),
daniel@53: 		       ax(any)
daniel@53: 		     ]).
daniel@53: 
daniel@53: /** <module> OpenID consumer and server library
daniel@53: 
daniel@53: This library implements the OpenID protocol (http://openid.net/). OpenID
daniel@53: is a protocol to share identities on   the  network. The protocol itself
daniel@53: uses simple basic  HTTP,  adding   reliability  using  digitally  signed
daniel@53: messages.
daniel@53: 
daniel@53: Steps, as seen from the _consumer_ (or _|relying partner|_).
daniel@53: 
daniel@53: 	1. Show login form, asking for =openid_identifier=
daniel@53: 	2. Get HTML page from =openid_identifier= and lookup
daniel@53: 	   =|<link rel="openid.server" href="server">|=
daniel@53: 	3. Associate to _server_
daniel@53: 	4. Redirect browser (302) to server using mode =checkid_setup=,
daniel@53: 	   asking to validate the given OpenID.
daniel@53: 	5. OpenID server redirects back, providing digitally signed
daniel@53: 	   conformation of the claimed identity.
daniel@53: 	6. Validate signature and redirect to the target location.
daniel@53: 
daniel@53: A *consumer* (an application that allows OpenID login) typically uses
daniel@53: this library through openid_user/3. In addition, it must implement the
daniel@53: hook http_openid:openid_hook(trusted(OpenId, Server)) to define accepted
daniel@53: OpenID servers. Typically, this hook is used to provide a white-list of
daniel@53: aceptable servers. Note that accepting any OpenID server is possible,
daniel@53: but anyone on the internet can setup a dummy OpenID server that simply
daniel@53: grants and signs every request. Here is an example:
daniel@53: 
daniel@53:     ==
daniel@53:     :- multifile http_openid:openid_hook/1.
daniel@53: 
daniel@53:     http_openid:openid_hook(trusted(_, OpenIdServer)) :-
daniel@53: 	(   trusted_server(OpenIdServer)
daniel@53: 	->  true
daniel@53: 	;   throw(http_reply(moved_temporary('/openid/trustedservers')))
daniel@53: 	).
daniel@53: 
daniel@53:     trusted_server('http://www.myopenid.com/server').
daniel@53:     ==
daniel@53: 
daniel@53: By default, information who is logged on  is maintained with the session
daniel@53: using http_session_assert/1 with the term   openid(Identity).  The hooks
daniel@53: login/logout/logged_in can be used to provide alternative administration
daniel@53: of logged-in users (e.g., based on client-IP, using cookies, etc.).
daniel@53: 
daniel@53: To create a *server*,  you  must  do   four  things:  bind  the handlers
daniel@53: openid_server/2  and  openid_grant/1  to  HTTP    locations,  provide  a
daniel@53: user-page for registered users and   define  the grant(Request, Options)
daniel@53: hook to verify  your  users.  An  example   server  is  provided  in  in
daniel@53: <plbase>/doc/packages/examples/demo_openid.pl
daniel@53: */
daniel@53: 
daniel@53: 		 /*******************************
daniel@53: 		 *	  CONFIGURATION		*
daniel@53: 		 *******************************/
daniel@53: 
daniel@53: http:location(openid, root(openid), [priority(-100)]).
daniel@53: 
daniel@53: %%	openid_hook(+Action)
daniel@53: %
daniel@53: %	Call hook on the OpenID management library.  Defined hooks are:
daniel@53: %
daniel@53: %	  * login(+OpenID)
daniel@53: %	  Consider OpenID logged in.
daniel@53: %
daniel@53: %	  * logout(+OpenID)
daniel@53: %	  Logout OpenID
daniel@53: %
daniel@53: %	  * logged_in(?OpenID)
daniel@53: %	  True if OpenID is logged in
daniel@53: %
daniel@53: %	  * grant(+Request, +Options)
daniel@53: %	  Server: Reply positive on OpenID
daniel@53: %
daniel@53: %	  * trusted(+OpenID, +Server)
daniel@53: %	  True if Server is a trusted OpenID server
daniel@53: %
daniel@53: %	  * ax(Values)
daniel@53: %	  Called if the server provided AX attributes
daniel@53: %
daniel@53: %	  * x_parameter(+Server, -Name, -Value)
daniel@53: %	  Called to find additional HTTP parameters to send with the
daniel@53: %	  OpenID verify request.
daniel@53: 
daniel@53: :- multifile
daniel@53: 	openid_hook/1.			% +Action
daniel@53: 
daniel@53: 		 /*******************************
daniel@53: 		 *	 DIRECT LOGIN/OUT	*
daniel@53: 		 *******************************/
daniel@53: 
daniel@53: %%	openid_login(+OpenID) is det.
daniel@53: %
daniel@53: %	Associate the current  HTTP  session   with  OpenID.  If another
daniel@53: %	OpenID is already associated, this association is first removed.
daniel@53: 
daniel@53: openid_login(OpenID) :-
daniel@53: 	openid_hook(login(OpenID)), !,
daniel@53: 	handle_stay_signed_in(OpenID).
daniel@53: openid_login(OpenID) :-
daniel@53: 	openid_logout(_),
daniel@53: 	http_session_assert(openid(OpenID)),
daniel@53: 	handle_stay_signed_in(OpenID).
daniel@53: 
daniel@53: %%	openid_logout(+OpenID) is det.
daniel@53: %
daniel@53: %	Remove the association of the current session with any OpenID
daniel@53: 
daniel@53: openid_logout(OpenID) :-
daniel@53: 	openid_hook(logout(OpenID)), !.
daniel@53: openid_logout(OpenID) :-
daniel@53: 	http_session_retractall(openid(OpenID)).
daniel@53: 
daniel@53: %%	openid_logged_in(-OpenID) is semidet.
daniel@53: %
daniel@53: %	True if session is associated with OpenID.
daniel@53: 
daniel@53: openid_logged_in(OpenID) :-
daniel@53: 	openid_hook(logged_in(OpenID)), !.
daniel@53: openid_logged_in(OpenID) :-
daniel@53: 	http_in_session(_SessionId),		% test in session
daniel@53: 	http_session_data(openid(OpenID)).
daniel@53: 
daniel@53: 
daniel@53: 		 /*******************************
daniel@53: 		 *	      TOPLEVEL		*
daniel@53: 		 *******************************/
daniel@53: 
daniel@53: %%	openid_user(+Request:http_request, -OpenID:url, +Options) is det.
daniel@53: %
daniel@53: %	True if OpenID is a validated OpenID associated with the current
daniel@53: %	session. The scenario for which this predicate is designed is to
daniel@53: %	allow  an  HTTP  handler  that  requires    a   valid  login  to
daniel@53: %	use the transparent code below.
daniel@53: %
daniel@53: %	  ==
daniel@53: %	  handler(Request) :-
daniel@53: %		openid_user(Request, OpenID, []),
daniel@53: %		...
daniel@53: %	  ==
daniel@53: %
daniel@53: %	If the user is not yet logged on a sequence of redirects will
daniel@53: %	follow:
daniel@53: %
daniel@53: %	  1. Show a page for login (default: page /openid/login),
daniel@53: %	     predicate reply_openid_login/1)
daniel@53: %	  2. By default, the OpenID login page is a form that is
daniel@53: %	     submitted to the =verify=, which calls openid_verify/2.
daniel@53: %	  3. openid_verify/2 does the following:
daniel@53: %	     - Find the OpenID claimed identity and server
daniel@53: %	     - Associate to the OpenID server
daniel@53: %	     - redirects to the OpenID server for validation
daniel@53: %	  4. The OpenID server will redirect here with the authetication
daniel@53: %	     information.  This is handled by openid_authenticate/4.
daniel@53: %
daniel@53: %	Options:
daniel@53: %
daniel@53: %	  * login_url(Login)
daniel@53: %	    (Local) URL of page to enter OpenID information. Default
daniel@53: %	    is the handler for openid_login_page/1
daniel@53: %
daniel@53: %	@see openid_authenticate/4 produces errors if login is invalid
daniel@53: %	or cancelled.
daniel@53: 
daniel@53: :- http_handler(openid(login),	      openid_login_page,   [priority(-10)]).
daniel@53: :- http_handler(openid(verify),	      openid_verify([]),   []).
daniel@53: :- http_handler(openid(authenticate), openid_authenticate, []).
daniel@53: :- http_handler(openid(xrds),	      openid_xrds,	   []).
daniel@53: 
daniel@53: openid_user(_Request, OpenID, _Options) :-
daniel@53: 	openid_logged_in(OpenID), !.
daniel@53: openid_user(Request, _OpenID, Options) :-
daniel@53: 	http_link_to_id(openid_login_page, [], DefLoginPage),
daniel@53: 	option(login_url(LoginPage), Options, DefLoginPage),
daniel@53: 	openid_current_url(Request, Here),
daniel@53: 	(  member(referer(Referer),Request)
daniel@53: 	-> ReturnTo=Referer
daniel@53: 	;  ReturnTo=Here
daniel@53: 	),
daniel@53: 	redirect_browser(LoginPage,
daniel@53: 			 [ 'openid.return_to' = ReturnTo
daniel@53: 			 ]).
daniel@53: 
daniel@53: %%	openid_xrds(Request)
daniel@53: %
daniel@53: %	Reply to a request  for   "Discovering  OpenID Relying Parties".
daniel@53: %	This may happen as part of  the provider verification procedure.
daniel@53: %	The  provider  will   do   a    Yadis   discovery   request   on
daniel@53: %	=openid.return=  or  =openid.realm=.  This  is    picked  up  by
daniel@53: %	openid_user/3, pointing the provider to   openid(xrds).  Now, we
daniel@53: %	reply with the locations marked =openid=  and the locations that
daniel@53: %	have actually been doing OpenID validations.
daniel@53: 
daniel@53: openid_xrds(Request) :-
daniel@53: 	http_link_to_id(openid_authenticate, [], Autheticate),
daniel@53: 	public_url(Request, Autheticate, Public),
daniel@53: 	format('Content-type: text/xml\n\n'),
daniel@53: 	format('<?xml version="1.0" encoding="UTF-8"?>\n'),
daniel@53: 	format('<xrds:XRDS\n'),
daniel@53: 	format('    xmlns:xrds="xri://$xrds"\n'),
daniel@53: 	format('    xmlns="xri://$xrd*($v*2.0)">\n'),
daniel@53: 	format('  <XRD>\n'),
daniel@53: 	format('    <Service>\n'),
daniel@53: 	format('      <Type>http://specs.openid.net/auth/2.0/return_to</Type>\n'),
daniel@53: 	format('      <URI>~w</URI>\n', [Public]),
daniel@53: 	format('    </Service>\n'),
daniel@53: 	format('  </XRD>\n'),
daniel@53: 	format('</xrds:XRDS>\n').
daniel@53: 
daniel@53: 
daniel@53: %%	openid_login_page(+Request) is det.
daniel@53: %
daniel@53: %	Present a login-form for OpenID. There  are two ways to redefine
daniel@53: %	this  default  login  page.  One  is    to  provide  the  option
daniel@53: %	=login_url= to openid_user/3 and the other   is  to define a new
daniel@53: %	handler for =|/openid/login|= using http_handler/3.
daniel@53: 
daniel@53: openid_login_page(Request) :-
daniel@53: 	http_open_session(_, []),
daniel@53: 	http_parameters(Request,
daniel@53: 			[ 'openid.return_to'(Target, [])
daniel@53: 			]),
daniel@53: 	reply_html_page([ title('OpenID login')
daniel@53: 			],
daniel@53: 			[ \openid_login_form(Target, [])
daniel@53: 			]).
daniel@53: 
daniel@53: %%	openid_login_form(+ReturnTo, +Options)// is det.
daniel@53: %
daniel@53: %	Create the OpenID  form.  This  exported   as  a  seperate  DCG,
daniel@53: %	allowing applications to redefine /openid/login   and reuse this
daniel@53: %	part of the page.  Options processed:
daniel@53: %
daniel@53: %	  - action(Action)
daniel@53: %	  URL of action to call.  Default is the handler calling
daniel@53: %	  openid_verify/1.
daniel@53: %	  - buttons(+Buttons)
daniel@53: %	  Buttons is a list of =img= structures where the =href=
daniel@53: %	  points to an OpenID 2.0 endpoint.  These buttons are
daniel@53: %	  displayed below the OpenID URL field.  Clicking the
daniel@53: %	  button sets the URL field and submits the form.  Requires
daniel@53: %	  Javascript support.
daniel@53: %
daniel@53: %	  If the =href= is _relative_, clicking it opens the given
daniel@53: %	  location after adding 'openid.return_to' and `stay'.
daniel@53: %	  - show_stay(+Boolean)
daniel@53: %	  If =true=, show a checkbox that allows the user to stay
daniel@53: %	  logged on.
daniel@53: 
daniel@53: openid_login_form(ReturnTo, Options) -->
daniel@53: 	{ http_link_to_id(openid_verify, [], VerifyLocation),
daniel@53: 	  option(action(Action), Options, VerifyLocation),
daniel@53: 	  http_session_retractall(openid(_)),
daniel@53: 	  http_session_retractall(openid_login(_,_,_,_)),
daniel@53: 	  http_session_retractall(ax(_))
daniel@53: 	},
daniel@53: 	html(div([ class('openid-login')
daniel@53: 		 ],
daniel@53: 		 [ \openid_title,
daniel@53: 		   form([ name(login),
daniel@53: 			  id(login),
daniel@53: 			  action(Action),
daniel@53: 			  method('GET')
daniel@53: 			],
daniel@53: 			[ \hidden('openid.return_to', ReturnTo),
daniel@53: 			  div([ input([ class('openid-input'),
daniel@53: 					name(openid_url),
daniel@53: 					id(openid_url),
daniel@53: 					size(30),
daniel@53: 					placeholder('Your OpenID URL')
daniel@53: 				      ]),
daniel@53: 				input([ type(submit),
daniel@53: 					value('Verify!')
daniel@53: 				      ])
daniel@53: 			      ]),
daniel@53: 			  \buttons(Options),
daniel@53: 			  \stay_logged_on(Options)
daniel@53: 			])
daniel@53: 		 ])).
daniel@53: 
daniel@53: stay_logged_on(Options) -->
daniel@53: 	{ option(show_stay(true), Options) }, !,
daniel@53: 	html(div(class('openid-stay'),
daniel@53: 		 [ input([ type(checkbox), id(stay), name(stay), value(yes)]),
daniel@53: 		   'Stay signed in'
daniel@53: 		 ])).
daniel@53: stay_logged_on(_) --> [].
daniel@53: 
daniel@53: buttons(Options) -->
daniel@53: 	{ option(buttons(Buttons), Options),
daniel@53: 	  Buttons \== []
daniel@53: 	},
daniel@53: 	html(div(class('openid-buttons'),
daniel@53: 		 [ 'Sign in with '
daniel@53: 		 | \prelogin_buttons(Buttons)
daniel@53: 		 ])).
daniel@53: buttons(_) --> [].
daniel@53: 
daniel@53: prelogin_buttons([]) --> [].
daniel@53: prelogin_buttons([H|T]) --> prelogin_button(H), prelogin_buttons(T).
daniel@53: 
daniel@53: %%	prelogin_button(+Image)// is det.
daniel@53: %
daniel@53: %	Handle OpenID 2.0 and other pre-login  buttons. If the image has
daniel@53: %	a =href= attribute that is absolute, it   is  taken as an OpenID
daniel@53: %	2.0 endpoint. Otherwise it is taken  as   a  link on the current
daniel@53: %	server. This allows us to present  non-OpenId logons in the same
daniel@53: %	screen. The dedicated  handler  is   passed  the  HTTP paramters
daniel@53: %	=openid.return_to= and =stay=.
daniel@53: 
daniel@53: prelogin_button(img(Attrs)) -->
daniel@53: 	{ select_option(href(HREF), Attrs, RestAttrs),
daniel@53: 	  uri_is_global(HREF), !
daniel@53: 	},
daniel@53: 	html(img([ onClick('javascript:{$("#openid_url").val("'+HREF+'");'+
daniel@53: 			   '$("form#login").submit();}'
daniel@53: 			  )
daniel@53: 		 | RestAttrs
daniel@53: 		 ])).
daniel@53: prelogin_button(img(Attrs)) -->
daniel@53: 	{ select_option(href(HREF), Attrs, RestAttrs)
daniel@53: 	},
daniel@53: 	html(img([ onClick('window.location = "'+HREF+
daniel@53: 			   '?openid.return_to="'+
daniel@53: 			   '+encodeURIComponent($("#return_to").val())'+
daniel@53: 			   '+"&stay="'+
daniel@53: 			   '+$("#stay").val()')
daniel@53: 		 | RestAttrs
daniel@53: 		 ])).
daniel@53: 
daniel@53: 
daniel@53: 		 /*******************************
daniel@53: 		 *	    HTTP REPLIES	*
daniel@53: 		 *******************************/
daniel@53: 
daniel@53: %%	openid_verify(+Options, +Request)
daniel@53: %
daniel@53: %	Handle the initial login  form  presented   to  the  user by the
daniel@53: %	relying party (consumer). This predicate   discovers  the OpenID
daniel@53: %	server, associates itself with  this   server  and redirects the
daniel@53: %	user's  browser  to  the  OpenID  server,  providing  the  extra
daniel@53: %	openid.X name-value pairs. Options is,  against the conventions,
daniel@53: %	placed in front of the Request   to allow for smooth cooperation
daniel@53: %	with http_dispatch.pl.  Options processes:
daniel@53: %
daniel@53: %	  * return_to(+URL)
daniel@53: %	  Specifies where the OpenID provider should return to.
daniel@53: %	  Normally, that is the current location.
daniel@53: %	  * trust_root(+URL)
daniel@53: %	  Specifies the =openid.trust_root= attribute.  Defaults to
daniel@53: %	  the root of the current server (i.e., =|http://host[.port]/|=).
daniel@53: %	  * realm(+URL)
daniel@53: %	  Specifies the =openid.realm= attribute.  Default is the
daniel@53: %	  =trust_root=.
daniel@53: %	  * ax(+Spec)
daniel@53: %	  Request the exchange of additional attributes from the
daniel@53: %	  identity provider.  See http_ax_attributes/2 for details.
daniel@53: %
daniel@53: %	The OpenId server will redirect to the =openid.return_to= URL.
daniel@53: %
daniel@53: %	@throws	http_reply(moved_temporary(Redirect))
daniel@53: 
daniel@53: openid_verify(Options, Request) :-
daniel@53: 	http_parameters(Request,
daniel@53: 			[ openid_url(URL, [length>1]),
daniel@53: 			  'openid.return_to'(ReturnTo0, [optional(true)]),
daniel@53: 			  stay(Stay, [optional(true), default(no)])
daniel@53: 			]),
daniel@53: 	(   option(return_to(ReturnTo1), Options)	% Option
daniel@53: 	->  openid_current_url(Request, CurrentLocation),
daniel@53: 	    global_url(ReturnTo1, CurrentLocation, ReturnTo)
daniel@53: 	;   nonvar(ReturnTo0)
daniel@53: 	->  ReturnTo = ReturnTo0			% Form-data
daniel@53: 	;   openid_current_url(Request, CurrentLocation),
daniel@53: 	    ReturnTo = CurrentLocation			% Current location
daniel@53: 	),
daniel@53: 	public_url(Request, /, CurrentRoot),
daniel@53: 	option(trust_root(TrustRoot), Options, CurrentRoot),
daniel@53: 	option(realm(Realm), Options, TrustRoot),
daniel@53: 	openid_resolve(URL, OpenIDLogin, OpenID, Server, ServerOptions),
daniel@53: 	trusted(OpenID, Server),
daniel@53: 	openid_associate(Server, Handle, _Assoc),
daniel@53: 	assert_openid(OpenIDLogin, OpenID, Server, ReturnTo),
daniel@53: 	stay(Stay),
daniel@53: 	option(ns(NS), Options, 'http://specs.openid.net/auth/2.0'),
daniel@53: 	(   realm_attribute(NS, RealmAttribute)
daniel@53: 	->  true
daniel@53: 	;   domain_error('openid.ns', NS)
daniel@53: 	),
daniel@53: 	findall(P=V, openid_hook(x_parameter(Server, P, V)), XAttrs, AXAttrs),
daniel@53: 	debug(openid(verify), 'XAttrs: ~p', [XAttrs]),
daniel@53: 	ax_options(ServerOptions, Options, AXAttrs),
daniel@53: 	http_link_to_id(openid_authenticate, [], AuthenticateLoc),
daniel@53: 	public_url(Request, AuthenticateLoc, Authenticate),
daniel@53: 	redirect_browser(Server, [ 'openid.ns'		 = NS,
daniel@53: 				   'openid.mode'         = checkid_setup,
daniel@53: 				   'openid.identity'     = OpenID,
daniel@53: 				   'openid.claimed_id'   = OpenID,
daniel@53: 				   'openid.assoc_handle' = Handle,
daniel@53: 				   'openid.return_to'    = Authenticate,
daniel@53: 				   RealmAttribute        = Realm
daniel@53: 				 | XAttrs
daniel@53: 				 ]).
daniel@53: 
daniel@53: realm_attribute('http://specs.openid.net/auth/2.0', 'openid.realm').
daniel@53: realm_attribute('http://openid.net/signon/1.1',     'openid.trust_root').
daniel@53: 
daniel@53: 
daniel@53: %%	stay(+Response)
daniel@53: %
daniel@53: %	Called if the user  ask  to  stay   signed  in.  This  is called
daniel@53: %	_before_ control is handed to the   OpenID server. It leaves the
daniel@53: %	data openid_stay_signed_in(true) in the current session.
daniel@53: 
daniel@53: stay(yes) :- !,
daniel@53: 	http_session_assert(openid_stay_signed_in(true)).
daniel@53: stay(_).
daniel@53: 
daniel@53: %%	handle_stay_signed_in(+OpenID)
daniel@53: %
daniel@53: %	Handle stay_signed_in option after the user has logged on
daniel@53: 
daniel@53: handle_stay_signed_in(OpenID) :-
daniel@53: 	http_session_retract(openid_stay_signed_in(true)), !,
daniel@53: 	http_set_session(timeout(0)),
daniel@53: 	ignore(openid_hook(stay_signed_in(OpenID))).
daniel@53: handle_stay_signed_in(_).
daniel@53: 
daniel@53: %%	assert_openid(+OpenIDLogin, +OpenID, +Server, +Target) is det.
daniel@53: %
daniel@53: %	Associate the OpenID  as  typed  by   the  user,  the  OpenID as
daniel@53: %	validated by the Server with the current HTTP session.
daniel@53: %
daniel@53: %	@param OpenIDLogin Canonized OpenID typed by user
daniel@53: %	@param OpenID OpenID verified by Server.
daniel@53: 
daniel@53: assert_openid(OpenIDLogin, OpenID, Server, Target) :-
daniel@53: 	openid_identifier_select_url(OpenIDLogin),
daniel@53: 	openid_identifier_select_url(OpenID), !,
daniel@53: 	http_session_assert(openid_login(Identity, Identity, Server, Target)).
daniel@53: assert_openid(OpenIDLogin, OpenID, Server, Target) :-
daniel@53: 	http_session_assert(openid_login(OpenIDLogin, OpenID, Server, Target)).
daniel@53: 
daniel@53: %%	openid_server(?OpenIDLogin, ?OpenID, ?Server) is nondet.
daniel@53: %
daniel@53: %	True if OpenIDLogin is the typed id for OpenID verified by
daniel@53: %	Server.
daniel@53: %
daniel@53: %	@param OpenIDLogin ID as typed by user (canonized)
daniel@53: %	@param OpenID ID as verified by server
daniel@53: %	@param Server URL of the OpenID server
daniel@53: 
daniel@53: openid_server(OpenIDLogin, OpenID, Server) :-
daniel@53: 	openid_server(OpenIDLogin, OpenID, Server, _Target).
daniel@53: 
daniel@53: openid_server(OpenIDLogin, OpenID, Server, Target) :-
daniel@53: 	http_in_session(_),
daniel@53: 	http_session_data(openid_login(OpenIDLogin, OpenID, Server, Target)), !.
daniel@53: 
daniel@53: 
daniel@53: %%	public_url(+Request, +Path, -URL) is det.
daniel@53: %
daniel@53: %	True when URL is a publically useable  URL that leads to Path on
daniel@53: %	the current server.
daniel@53: 
daniel@53: public_url(Request, Path, URL) :-
daniel@53: 	openid_current_host(Request, Host, Port),
daniel@53: 	setting(http:public_scheme, Scheme),
daniel@53: 	set_port(Scheme, Port, AuthC),
daniel@53: 	uri_authority_data(host, AuthC, Host),
daniel@53: 	uri_authority_components(Auth, AuthC),
daniel@53: 	uri_data(scheme, Components, Scheme),
daniel@53: 	uri_data(authority, Components, Auth),
daniel@53: 	uri_data(path, Components, Path),
daniel@53: 	uri_components(URL, Components).
daniel@53: 
daniel@53: set_port(Scheme, Port, _) :-
daniel@53: 	scheme_port(Scheme, Port), !.
daniel@53: set_port(_, Port, AuthC) :-
daniel@53: 	uri_authority_data(port, AuthC, Port).
daniel@53: 
daniel@53: scheme_port(http, 80).
daniel@53: scheme_port(https, 443).
daniel@53: 
daniel@53: 
daniel@53: %%	openid_current_url(+Request, -URL) is det.
daniel@53: %
daniel@53: %	@deprecated	New code should use http_public_url/2 with the
daniel@53: %			same semantics.
daniel@53: 
daniel@53: openid_current_url(Request, URL) :-
daniel@53: 	http_public_url(Request, URL).
daniel@53: 
daniel@53: %%	openid_current_host(Request, Host, Port)
daniel@53: %
daniel@53: %	Find current location of the server.
daniel@53: %
daniel@53: %	@deprecated	New code should use http_current_host/4 with the
daniel@53: %			option global(true).
daniel@53: 
daniel@53: openid_current_host(Request, Host, Port) :-
daniel@53: 	http_current_host(Request, Host, Port,
daniel@53: 			  [ global(true)
daniel@53: 			  ]).
daniel@53: 
daniel@53: 
daniel@53: %%	redirect_browser(+URL, +FormExtra)
daniel@53: %
daniel@53: %	Generate a 302 temporary redirect to  URL, adding the extra form
daniel@53: %	information from FormExtra. The specs says   we  must retain the
daniel@53: %	search specification already attached to the URL.
daniel@53: 
daniel@53: redirect_browser(URL, FormExtra) :-
daniel@53: 	uri_components(URL, C0),
daniel@53: 	uri_data(search, C0, Search0),
daniel@53: 	(   var(Search0)
daniel@53: 	->  uri_query_components(Search, FormExtra)
daniel@53: 	;   uri_query_components(Search0, Form0),
daniel@53: 	    append(FormExtra, Form0, Form),
daniel@53: 	    uri_query_components(Search, Form)
daniel@53: 	),
daniel@53: 	uri_data(search, C0, Search, C),
daniel@53: 	uri_components(Redirect, C),
daniel@53: 	throw(http_reply(moved_temporary(Redirect))).
daniel@53: 
daniel@53: 
daniel@53: 		 /*******************************
daniel@53: 		 *	       RESOLVE		*
daniel@53: 		 *******************************/
daniel@53: 
daniel@53: %%	openid_resolve(+URL, -OpenIDOrig, -OpenID, -Server, -ServerOptions)
daniel@53: %
daniel@53: %	True if OpenID is the claimed  OpenID   that  belongs to URL and
daniel@53: %	Server is the URL of the  OpenID   server  that  can be asked to
daniel@53: %	verify this claim.
daniel@53: %
daniel@53: %	@param  URL The OpenID typed by the user
daniel@53: %	@param	OpenIDOrig Canonized OpenID typed by user
daniel@53: %	@param	OpenID Possibly delegated OpenID
daniel@53: %	@param  Server OpenID server that must validate OpenID
daniel@53: %	@param	ServerOptions provides additional XRDS information about
daniel@53: %		the server.  Currently supports xrds_types(Types).
daniel@53: %	@tbd	Implement complete URL canonization as defined by the
daniel@53: %		OpenID 2.0 proposal.
daniel@53: 
daniel@53: openid_resolve(URL, OpenID, OpenID, Server, [xrds_types(Types)]) :-
daniel@53: 	xrds_dom(URL, DOM),
daniel@53: 	xpath(DOM, //(_:'Service'), Service),
daniel@53: 	findall(Type, xpath(Service, _:'Type'(text), Type), Types),
daniel@53: 	memberchk('http://specs.openid.net/auth/2.0/server', Types),
daniel@53: 	xpath(Service, _:'URI'(text), Server), !,
daniel@53: 	debug(openid(yadis), 'Yadis: server: ~q, types: ~q', [Server, Types]),
daniel@53: 	(   xpath(Service, _:'LocalID'(text), OpenID)
daniel@53: 	->  true
daniel@53: 	;   openid_identifier_select_url(OpenID)
daniel@53: 	).
daniel@53: openid_resolve(URL, OpenID0, OpenID, Server, []) :-
daniel@53: 	debug(openid(resolve), 'Opening ~w ...', [URL]),
daniel@53: 	dtd(html, DTD),
daniel@53: 	setup_call_cleanup(
daniel@53: 	    http_open(URL, Stream,
daniel@53: 		      [ final_url(OpenID0),
daniel@53: 			cert_verify_hook(ssl_verify)
daniel@53: 		      ]),
daniel@53: 	    load_structure(Stream, Term,
daniel@53: 			   [ dtd(DTD),
daniel@53: 			     dialect(sgml),
daniel@53: 			     shorttag(false),
daniel@53: 			     syntax_errors(quiet)
daniel@53: 			   ]),
daniel@53: 	    close(Stream)),
daniel@53: 	debug(openid(resolve), 'Scanning HTML document ...', [URL]),
daniel@53: 	contains_term(element(head, _, Head), Term),
daniel@53: 	(   link(Head, 'openid.server', Server)
daniel@53: 	->  debug(openid(resolve), 'OpenID Server=~q', [Server])
daniel@53: 	;   debug(openid(resolve), 'No server in ~q', [Head]),
daniel@53: 	    fail
daniel@53: 	),
daniel@53: 	(   link(Head, 'openid.delegate', OpenID)
daniel@53: 	->  debug(openid(resolve), 'OpenID = ~q (delegated)', [OpenID])
daniel@53: 	;   OpenID = OpenID0,
daniel@53: 	    debug(openid(resolve), 'OpenID = ~q', [OpenID])
daniel@53: 	).
daniel@53: 
daniel@53: openid_identifier_select_url(
daniel@53:     'http://specs.openid.net/auth/2.0/identifier_select').
daniel@53: 
daniel@53: :- public ssl_verify/5.
daniel@53: 
daniel@53: %%	ssl_verify(+SSL, +ProblemCert, +AllCerts, +FirstCert, +Error)
daniel@53: %
daniel@53: %	Accept all certificates. We do not care  too much. Only the user
daniel@53: %	cares s/he is not entering her  credentials with a spoofed side.
daniel@53: %	As we redirect, the browser will take care of this.
daniel@53: 
daniel@53: ssl_verify(_SSL,
daniel@53: 	   _ProblemCertificate, _AllCertificates, _FirstCertificate,
daniel@53: 	   _Error).
daniel@53: 
daniel@53: 
daniel@53: link(DOM, Type, Target) :-
daniel@53: 	sub_term(element(link, Attrs, []), DOM),
daniel@53: 	memberchk(rel=Type, Attrs),
daniel@53: 	memberchk(href=Target, Attrs).
daniel@53: 
daniel@53: 
daniel@53: 		 /*******************************
daniel@53: 		 *	   AUTHENTICATE		*
daniel@53: 		 *******************************/
daniel@53: 
daniel@53: %%	openid_authenticate(+Request)
daniel@53: %
daniel@53: %	HTTP handler when redirected back from the OpenID provider.
daniel@53: 
daniel@53: openid_authenticate(Request) :-
daniel@53: 	memberchk(accept(Accept), Request),
daniel@53: 	Accept = [media(application/'xrds+xml',_,_,_)], !,
daniel@53: 	http_link_to_id(openid_xrds, [], XRDSLocation),
daniel@53: 	http_absolute_uri(XRDSLocation, XRDSServer),
daniel@53: 	debug(openid(yadis), 'Sending XRDS server: ~q', [XRDSServer]),
daniel@53: 	format('X-XRDS-Location: ~w\n', [XRDSServer]),
daniel@53: 	format('Content-type: text/plain\n\n').
daniel@53: openid_authenticate(Request) :-
daniel@53: 	openid_authenticate(Request, _OpenIdServer, OpenID, _ReturnTo),
daniel@53: 	openid_server(User, OpenID, _, Target),
daniel@53: 	openid_login(User),
daniel@53: 	redirect_browser(Target, []).
daniel@53: 
daniel@53: 
daniel@53: %%	openid_authenticate(+Request, -Server:url, -OpenID:url,
daniel@53: %%			    -ReturnTo:url) is semidet.
daniel@53: %
daniel@53: %	Succeeds if Request comes from the   OpenID  server and confirms
daniel@53: %	that User is a verified OpenID   user. ReturnTo provides the URL
daniel@53: %	to return to.
daniel@53: %
daniel@53: %	After openid_verify/2 has redirected the   browser to the OpenID
daniel@53: %	server, and the OpenID server did   its  magic, it redirects the
daniel@53: %	browser back to this address.  The   work  is fairly trivial. If
daniel@53: %	=mode= is =cancel=, the OpenId server   denied. If =id_res=, the
daniel@53: %	OpenId server replied positive, but  we   must  verify  what the
daniel@53: %	server told us by checking the HMAC-SHA signature.
daniel@53: %
daniel@53: %	This call fails silently if their is no =|openid.mode|= field in
daniel@53: %	the request.
daniel@53: %
daniel@53: %	@throws	openid(cancel)
daniel@53: %		if request was cancelled by the OpenId server
daniel@53: %	@throws openid(signature_mismatch)
daniel@53: %		if the HMAC signature check failed
daniel@53: 
daniel@53: openid_authenticate(Request, OpenIdServer, Identity, ReturnTo) :-
daniel@53: 	memberchk(method(get), Request),
daniel@53: 	http_parameters(Request,
daniel@53: 			[ 'openid.mode'(Mode, [optional(true)])
daniel@53: 			]),
daniel@53: 	(   var(Mode)
daniel@53: 	->  fail
daniel@53: 	;   Mode == cancel
daniel@53: 	->  throw(openid(cancel))
daniel@53: 	;   Mode == id_res
daniel@53: 	->  debug(openid(authenticate), 'Mode=id_res, validating response', []),
daniel@53: 	    http_parameters(Request,
daniel@53: 			    [ 'openid.identity'(Identity, []),
daniel@53: 			      'openid.assoc_handle'(Handle, []),
daniel@53: 			      'openid.return_to'(ReturnTo, []),
daniel@53: 			      'openid.signed'(AtomFields, []),
daniel@53: 			      'openid.sig'(Base64Signature, []),
daniel@53: 			      'openid.invalidate_handle'(Invalidate,
daniel@53: 							 [optional(true)])
daniel@53: 			    ],
daniel@53: 			    [ form_data(Form)
daniel@53: 			    ]),
daniel@53: 	    atomic_list_concat(SignedFields, ',', AtomFields),
daniel@53: 	    check_obligatory_fields(SignedFields),
daniel@53: 	    signed_pairs(SignedFields,
daniel@53: 			 [ mode-Mode,
daniel@53: 			   identity-Identity,
daniel@53: 			   assoc_handle-Handle,
daniel@53: 			   return_to-ReturnTo,
daniel@53: 			   invalidate_handle-Invalidate
daniel@53: 			 ],
daniel@53: 			 Form,
daniel@53: 			 SignedPairs),
daniel@53: 	    (	openid_associate(OpenIdServer, Handle, Assoc)
daniel@53: 	    ->  signature(SignedPairs, Assoc, Sig),
daniel@53: 		atom_codes(Base64Signature, Base64SigCodes),
daniel@53: 		phrase(base64(Signature), Base64SigCodes),
daniel@53: 		(   Sig == Signature
daniel@53: 		->  true
daniel@53: 		;   throw(openid(signature_mismatch))
daniel@53: 		)
daniel@53: 	    ;	check_authentication(Request, Form)
daniel@53: 	    ),
daniel@53: 	    ax_store(Form)
daniel@53: 	).
daniel@53: 
daniel@53: %%	signed_pairs(+FieldNames, +Pairs:list(Field-Value),
daniel@53: %%		     +Form, -SignedPairs) is det.
daniel@53: %
daniel@53: %	Extract the signed field in the order they appear in FieldNames.
daniel@53: 
daniel@53: signed_pairs([], _, _, []).
daniel@53: signed_pairs([Field|T0], Pairs, Form, [Field-Value|T]) :-
daniel@53: 	memberchk(Field-Value, Pairs), !,
daniel@53: 	signed_pairs(T0, Pairs, Form, T).
daniel@53: signed_pairs([Field|T0], Pairs, Form, [Field-Value|T]) :-
daniel@53: 	atom_concat('openid.', Field, OpenIdField),
daniel@53: 	memberchk(OpenIdField=Value, Form), !,
daniel@53: 	signed_pairs(T0, Pairs, Form, T).
daniel@53: signed_pairs([Field|T0], Pairs, Form, T) :-
daniel@53: 	format(user_error, 'Form = ~p~n', [Form]),
daniel@53: 	throw(error(existence_error(field, Field),
daniel@53: 		    context(_, 'OpenID Signed field is not present'))),
daniel@53: 	signed_pairs(T0, Pairs, Form, T).
daniel@53: 
daniel@53: 
daniel@53: %%	check_obligatory_fields(+SignedFields:list) is det.
daniel@53: %
daniel@53: %	Verify fields from obligatory_field/1 are   in  the signed field
daniel@53: %	list.
daniel@53: %
daniel@53: %	@error	existence_error(field, Field)
daniel@53: 
daniel@53: check_obligatory_fields(Fields) :-
daniel@53: 	(   obligatory_field(Field),
daniel@53: 	    (	memberchk(Field, Fields)
daniel@53: 	    ->	true
daniel@53: 	    ;	throw(error(existence_error(field, Field),
daniel@53: 			    context(_, 'OpenID field is not in signed fields')))
daniel@53: 	    ),
daniel@53: 	    fail
daniel@53: 	;   true
daniel@53: 	).
daniel@53: 
daniel@53: obligatory_field(identity).
daniel@53: 
daniel@53: 
daniel@53: %%	check_authentication(+Request, +Form) is semidet.
daniel@53: %
daniel@53: %	Implement the stateless verification method.   This seems needed
daniel@53: %	for stackexchange.com, which provides the   =res_id=  with a new
daniel@53: %	association handle.
daniel@53: 
daniel@53: check_authentication(_Request, Form) :-
daniel@53: 	openid_server(_OpenIDLogin, _OpenID, Server),
daniel@53: 	debug(openid(check_authentication),
daniel@53: 	      'Using stateless verification with ~q form~n~q', [Server, Form]),
daniel@53: 	select('openid.mode' = _, Form, Form1),
daniel@53: 	setup_call_cleanup(
daniel@53: 	    http_open(Server, In,
daniel@53: 		      [ post(form([ 'openid.mode' = check_authentication
daniel@53: 				  | Form1
daniel@53: 				  ])),
daniel@53: 			cert_verify_hook(ssl_verify)
daniel@53: 		      ]),
daniel@53: 	    read_stream_to_codes(In, Reply),
daniel@53: 	    close(In)),
daniel@53: 	debug(openid(check_authentication),
daniel@53: 	      'Reply: ~n~s~n', [Reply]),
daniel@53: 	key_values_data(Pairs, Reply),
daniel@53: 	forall(member(invalidate_handle-Handle, Pairs),
daniel@53: 	       retractall(association(_, Handle, _))),
daniel@53: 	memberchk(is_valid-true, Pairs).
daniel@53: 
daniel@53: 
daniel@53: 		 /*******************************
daniel@53: 		 *	    AX HANDLING		*
daniel@53: 		 *******************************/
daniel@53: 
daniel@53: %%	ax_options(+ServerOptions, +Options, +AXAttrs) is det.
daniel@53: %
daniel@53: %	True when AXAttrs is a  list   of  additional attribute exchange
daniel@53: %	options to add to the OpenID redirect request.
daniel@53: 
daniel@53: ax_options(ServerOptions, Options, AXAttrs) :-
daniel@53: 	option(ax(Spec), Options),
daniel@53: 	option(xrds_types(Types), ServerOptions),
daniel@53: 	memberchk('http://openid.net/srv/ax/1.0', Types), !,
daniel@53: 	http_ax_attributes(Spec, AXAttrs),
daniel@53: 	debug(openid(ax), 'AX attributes: ~q', [AXAttrs]).
daniel@53: ax_options(_, _, []) :-
daniel@53: 	debug(openid(ax), 'AX: not supported', []).
daniel@53: 
daniel@53: %%	ax_store(+Form)
daniel@53: %
daniel@53: %	Extract reported AX data and  store   this  into the session. If
daniel@53: %	there is a non-empty list of exchanged values, this calls
daniel@53: %
daniel@53: %	    openid_hook(ax(Values))
daniel@53: %
daniel@53: %	If this hook fails, Values are added   to the session data using
daniel@53: %	http_session_assert(ax(Values)).
daniel@53: 
daniel@53: ax_store(Form) :-
daniel@53: 	debug(openid(ax), 'Form: ~q', [Form]),
daniel@53: 	ax_form_attributes(Form, Values),
daniel@53: 	debug(openid(ax), 'AX: ~q', [Values]),
daniel@53: 	(   Values \== []
daniel@53: 	->  (   openid_hook(ax(Values))
daniel@53: 	    ->  true
daniel@53: 	    ;   http_session_assert(ax(Values))
daniel@53: 	    )
daniel@53: 	;   true
daniel@53: 	).
daniel@53: 
daniel@53: 
daniel@53: 		 /*******************************
daniel@53: 		 *	   OPENID SERVER	*
daniel@53: 		 *******************************/
daniel@53: 
daniel@53: :- dynamic
daniel@53: 	server_association/3.		% URL, Handle, Term
daniel@53: 
daniel@53: %%	openid_server(+Options, +Request)
daniel@53: %
daniel@53: %	Realise the OpenID server. The protocol   demands a POST request
daniel@53: %	here.
daniel@53: 
daniel@53: openid_server(Options, Request) :-
daniel@53: 	http_parameters(Request,
daniel@53: 			[ 'openid.mode'(Mode)
daniel@53: 			],
daniel@53: 			[ attribute_declarations(openid_attribute),
daniel@53: 			  form_data(Form)
daniel@53: 			]),
daniel@53: 	(   Mode == associate
daniel@53: 	->  associate_server(Request, Form, Options)
daniel@53: 	;   Mode == checkid_setup
daniel@53: 	->  checkid_setup_server(Request, Form, Options)
daniel@53: 	).
daniel@53: 
daniel@53: %%	associate_server(+Request, +Form, +Options)
daniel@53: %
daniel@53: %	Handle the association-request. If successful,   create a clause
daniel@53: %	for server_association/3 to record the current association.
daniel@53: 
daniel@53: associate_server(Request, Form, Options) :-
daniel@53: 	memberchk('openid.assoc_type'	      =	AssocType,   Form),
daniel@53: 	memberchk('openid.session_type'	      =	SessionType, Form),
daniel@53: 	memberchk('openid.dh_modulus'	      =	P64,	     Form),
daniel@53: 	memberchk('openid.dh_gen'	      =	G64,	     Form),
daniel@53: 	memberchk('openid.dh_consumer_public' =	CPX64,       Form),
daniel@53: 	base64_btwoc(P, P64),
daniel@53: 	base64_btwoc(G, G64),
daniel@53: 	base64_btwoc(CPX, CPX64),
daniel@53: 	Y is 1+random(P-1),		% Our secret
daniel@53: 	DiffieHellman is powm(CPX, Y, P),
daniel@53: 	btwoc(DiffieHellman, DHBytes),
daniel@53: 	signature_algorithm(SessionType, SHA_Algo),
daniel@53: 	sha_hash(DHBytes, SHA1, [encoding(octet), algorithm(SHA_Algo)]),
daniel@53: 	CPY is powm(G, Y, P),
daniel@53: 	base64_btwoc(CPY, CPY64),
daniel@53: 	mackey_bytes(SessionType, MacBytes),
daniel@53: 	new_assoc_handle(MacBytes, Handle),
daniel@53: 	random_bytes(MacBytes, MacKey),
daniel@53: 	xor_codes(MacKey, SHA1, EncKey),
daniel@53: 	phrase(base64(EncKey), Base64EncKey),
daniel@53: 	DefExpriresIn is 24*3600,
daniel@53: 	option(expires_in(ExpriresIn), Options, DefExpriresIn),
daniel@53: 
daniel@53: 	get_time(Now),
daniel@53: 	ExpiresAt is integer(Now+ExpriresIn),
daniel@53: 	make_association([ session_type(SessionType),
daniel@53: 			   expires_at(ExpiresAt),
daniel@53: 			   mac_key(MacKey)
daniel@53: 			 ],
daniel@53: 			 Record),
daniel@53: 	memberchk(peer(Peer), Request),
daniel@53: 	assert(server_association(Peer, Handle, Record)),
daniel@53: 
daniel@53: 	key_values_data([ assoc_type-AssocType,
daniel@53: 			  assoc_handle-Handle,
daniel@53: 			  expires_in-ExpriresIn,
daniel@53: 			  session_type-SessionType,
daniel@53: 			  dh_server_public-CPY64,
daniel@53: 			  enc_mac_key-Base64EncKey
daniel@53: 			],
daniel@53: 			Text),
daniel@53: 	format('Content-type: text/plain~n~n~s', [Text]).
daniel@53: 
daniel@53: mackey_bytes('DH-SHA1',   20).
daniel@53: mackey_bytes('DH-SHA256', 32).
daniel@53: 
daniel@53: new_assoc_handle(Length, Handle) :-
daniel@53: 	random_bytes(Length, Bytes),
daniel@53: 	phrase(base64(Bytes), HandleCodes),
daniel@53: 	atom_codes(Handle, HandleCodes).
daniel@53: 
daniel@53: 
daniel@53: %%	checkid_setup_server(+Request, +Form, +Options)
daniel@53: %
daniel@53: %	Validate an OpenID for a TrustRoot and redirect the browser back
daniel@53: %	to the ReturnTo argument.  There   are  many  possible scenarios
daniel@53: %	here:
daniel@53: %
daniel@53: %		1. Check some cookie and if present, grant immediately
daniel@53: %		2. Use a 401 challenge page
daniel@53: %		3. Present a normal grant/password page
daniel@53: %		4. As (3), but use HTTPS for the exchange
daniel@53: %		5. etc.
daniel@53: %
daniel@53: %	First thing to check is the immediate acknowledgement.
daniel@53: 
daniel@53: checkid_setup_server(_Request, Form, _Options) :-
daniel@53: 	memberchk('openid.identity'	= Identity,  Form),
daniel@53: 	memberchk('openid.assoc_handle'	= Handle,    Form),
daniel@53: 	memberchk('openid.return_to'	= ReturnTo,  Form),
daniel@53: 	memberchk('openid.trust_root'	= TrustRoot, Form),
daniel@53: 
daniel@53: 	server_association(_, Handle, _Association),		% check
daniel@53: 
daniel@53: 	reply_html_page(
daniel@53: 	    [ title('OpenID login')
daniel@53: 	    ],
daniel@53: 	    [ \openid_title,
daniel@53: 	      div(class('openid-message'),
daniel@53: 		  ['Site ', a(href(TrustRoot), TrustRoot),
daniel@53: 		   ' requests permission to login with OpenID ',
daniel@53: 		   a(href(Identity), Identity), '.'
daniel@53: 		  ]),
daniel@53: 	      table(class('openid-form'),
daniel@53: 		    [ tr(td(form([ action(grant), method('GET') ],
daniel@53: 				 [ \hidden('openid.grant', yes),
daniel@53: 				   \hidden('openid.identity', Identity),
daniel@53: 				   \hidden('openid.assoc_handle', Handle),
daniel@53: 				   \hidden('openid.return_to', ReturnTo),
daniel@53: 				   \hidden('openid.trust_root', TrustRoot),
daniel@53: 				   div(['Password: ',
daniel@53: 					input([ type(password),
daniel@53: 						name('openid.password')
daniel@53: 					      ]),
daniel@53: 					input([ type(submit),
daniel@53: 						value('Grant')
daniel@53: 					      ])
daniel@53: 				       ])
daniel@53: 				 ]))),
daniel@53: 		      tr(td(align(right),
daniel@53: 			    form([ action(grant), method('GET') ],
daniel@53: 				 [ \hidden('openid.grant', no),
daniel@53: 				   \hidden('openid.return_to', ReturnTo),
daniel@53: 				   input([type(submit), value('Deny')])
daniel@53: 				 ])))
daniel@53: 		    ])
daniel@53: 	    ]).
daniel@53: 
daniel@53: hidden(Name, Value) -->
daniel@53: 	html(input([type(hidden), id(return_to), name(Name), value(Value)])).
daniel@53: 
daniel@53: 
daniel@53: openid_title -->
daniel@53: 	{ http_absolute_location(icons('openid-logo-square.png'), SRC, []) },
daniel@53: 	html_requires(css('openid.css')),
daniel@53: 	html(div(class('openid-title'),
daniel@53: 		 [ a(href('http://openid.net/'),
daniel@53: 		     img([ src(SRC), alt('OpenID') ])),
daniel@53: 		   span('Login')
daniel@53: 		 ])).
daniel@53: 
daniel@53: 
daniel@53: %%	openid_grant(+Request)
daniel@53: %
daniel@53: %	Handle the reply from checkid_setup_server/3.   If  the reply is
daniel@53: %	=yes=, check the authority (typically the   password) and if all
daniel@53: %	looks good redirect the browser to   ReturnTo, adding the OpenID
daniel@53: %	properties needed by the Relying Party to verify the login.
daniel@53: 
daniel@53: openid_grant(Request) :-
daniel@53: 	http_parameters(Request,
daniel@53: 			[ 'openid.grant'(Grant),
daniel@53: 			  'openid.return_to'(ReturnTo)
daniel@53: 			],
daniel@53: 			[ attribute_declarations(openid_attribute)
daniel@53: 			]),
daniel@53: 	(   Grant == yes
daniel@53: 	->  http_parameters(Request,
daniel@53: 			    [ 'openid.identity'(Identity),
daniel@53: 			      'openid.assoc_handle'(Handle),
daniel@53: 			      'openid.trust_root'(TrustRoot),
daniel@53: 			      'openid.password'(Password)
daniel@53: 			    ],
daniel@53: 			    [ attribute_declarations(openid_attribute)
daniel@53: 			    ]),
daniel@53: 	    server_association(_, Handle, Association),
daniel@53: 	    grant_login(Request,
daniel@53: 			[ identity(Identity),
daniel@53: 			  password(Password),
daniel@53: 			  trustroot(TrustRoot)
daniel@53: 			]),
daniel@53: 	    SignedPairs = [ 'mode'-id_res,
daniel@53: 			    'identity'-Identity,
daniel@53: 			    'assoc_handle'-Handle,
daniel@53: 			    'return_to'-ReturnTo
daniel@53: 			  ],
daniel@53: 	    signed_fields(SignedPairs, Signed),
daniel@53: 	    signature(SignedPairs, Association, Signature),
daniel@53: 	    phrase(base64(Signature), Bas64Sig),
daniel@53: 	    redirect_browser(ReturnTo,
daniel@53: 			     [ 'openid.mode' = id_res,
daniel@53: 			       'openid.identity' = Identity,
daniel@53: 			       'openid.assoc_handle' = Handle,
daniel@53: 			       'openid.return_to' = ReturnTo,
daniel@53: 			       'openid.signed' = Signed,
daniel@53: 			       'openid.sig' = Bas64Sig
daniel@53: 			     ])
daniel@53: 	;   redirect_browser(ReturnTo,
daniel@53: 			     [ 'openid.mode' = cancel
daniel@53: 			     ])
daniel@53: 	).
daniel@53: 
daniel@53: 
daniel@53: %%	grant_login(+Request, +Options) is det.
daniel@53: %
daniel@53: %	Validate login from Request (can  be   used  to get cookies) and
daniel@53: %	Options, which contains at least:
daniel@53: %
daniel@53: %		* identity(Identity)
daniel@53: %		* password(Password)
daniel@53: %		* trustroot(TrustRoot)
daniel@53: 
daniel@53: grant_login(Request, Options) :-
daniel@53: 	openid_hook(grant(Request, Options)).
daniel@53: 
daniel@53: %%	trusted(+OpenID, +Server)
daniel@53: %
daniel@53: %	True if we  trust  the  given   OpenID  server.  Must  throw  an
daniel@53: %	exception, possibly redirecting to a   page with trusted servers
daniel@53: %	if the given server is not trusted.
daniel@53: 
daniel@53: trusted(OpenID, Server) :-
daniel@53: 	openid_hook(trusted(OpenID, Server)).
daniel@53: 
daniel@53: 
daniel@53: %%	signed_fields(+Pairs, -Signed) is det.
daniel@53: %
daniel@53: %	Create a comma-separated  atom  from   the  field-names  without
daniel@53: %	'openid.' from Pairs.
daniel@53: 
daniel@53: signed_fields(Pairs, Signed) :-
daniel@53: 	signed_field_names(Pairs, Names),
daniel@53: 	atomic_list_concat(Names, ',', Signed).
daniel@53: 
daniel@53: signed_field_names([], []).
daniel@53: signed_field_names([H0-_|T0], [H|T]) :-
daniel@53: 	(   atom_concat('openid.', H, H0)
daniel@53: 	->  true
daniel@53: 	;   H = H0
daniel@53: 	),
daniel@53: 	signed_field_names(T0, T).
daniel@53: 
daniel@53: %%	signature(+Pairs, +Association, -Signature)
daniel@53: %
daniel@53: %	Determine the signature for Pairs
daniel@53: 
daniel@53: signature(Pairs, Association, Signature) :-
daniel@53: 	key_values_data(Pairs, TokenContents),
daniel@53: 	association_mac_key(Association, MacKey),
daniel@53: 	association_session_type(Association, SessionType),
daniel@53: 	signature_algorithm(SessionType, SHA),
daniel@53: 	hmac_sha(MacKey, TokenContents, Signature, [algorithm(SHA)]),
daniel@53: 	debug(openid(crypt),
daniel@53: 	      'Signed:~n~s~nSignature: ~w', [TokenContents, Signature]).
daniel@53: 
daniel@53: signature_algorithm('DH-SHA1',   sha1).
daniel@53: signature_algorithm('DH-SHA256', sha256).
daniel@53: 
daniel@53: 
daniel@53: 		 /*******************************
daniel@53: 		 *	      ASSOCIATE		*
daniel@53: 		 *******************************/
daniel@53: 
daniel@53: :- dynamic
daniel@53: 	association/3.			% URL, Handle, Data
daniel@53: 
daniel@53: :- record
daniel@53: 	association(session_type='DH-SHA1',
daniel@53: 		    expires_at,		% time-stamp
daniel@53: 		    mac_key).		% code-list
daniel@53: 
daniel@53: %%	openid_associate(?URL, ?Handle, ?Assoc) is det.
daniel@53: %
daniel@53: %	Calls openid_associate/4 as
daniel@53: %
daniel@53: %	    ==
daniel@53: %	    openid_associate(URL, Handle, Assoc, []).
daniel@53: %	    ==
daniel@53: 
daniel@53: openid_associate(URL, Handle, Assoc) :-
daniel@53: 	openid_associate(URL, Handle, Assoc, []).
daniel@53: 
daniel@53: %%	openid_associate(+URL, -Handle, -Assoc, +Options) is det.
daniel@53: %%	openid_associate(?URL, +Handle, -Assoc, +Options) is semidet.
daniel@53: %
daniel@53: %	Associate with an open-id server.  We   first  check for a still
daniel@53: %	valid old association. If there is  none   or  it is expired, we
daniel@53: %	esstablish one and remember it.  Options:
daniel@53: %
daniel@53: %	  * ns(URL)
daniel@53: %	  One of =http://specs.openid.net/auth/2.0= (default) or
daniel@53: %	  =http://openid.net/signon/1.1=.
daniel@53: %
daniel@53: %	@tbd	Should we store known associations permanently?  Where?
daniel@53: 
daniel@53: openid_associate(URL, Handle, Assoc, _Options) :-
daniel@53: 	nonvar(Handle), !,
daniel@53: 	debug(openid(associate),
daniel@53: 	      'OpenID: Lookup association with handle ~q', [Handle]),
daniel@53: 	(   association(URL, Handle, Assoc)
daniel@53: 	->  true
daniel@53: 	;   debug(openid(associate),
daniel@53: 		  'OpenID: no association with handle ~q', [Handle]),
daniel@53: 	    fail
daniel@53: 	).
daniel@53: openid_associate(URL, Handle, Assoc, _Options) :-
daniel@53: 	must_be(atom, URL),
daniel@53: 	association(URL, Handle, Assoc),
daniel@53: 	association_expires_at(Assoc, Expires),
daniel@53: 	get_time(Now),
daniel@53: 	(   Now < Expires
daniel@53: 	->  !,
daniel@53: 	    debug(openid(associate),
daniel@53: 		  'OpenID: Reusing association with ~q', [URL])
daniel@53: 	;   retractall(association(URL, Handle, _)),
daniel@53: 	    fail
daniel@53: 	).
daniel@53: openid_associate(URL, Handle, Assoc, Options) :-
daniel@53: 	associate_data(Data, P, _G, X, Options),
daniel@53: 	debug(openid(associate), 'OpenID: Associating with ~q', [URL]),
daniel@53: 	setup_call_cleanup(
daniel@53: 	    http_open(URL, In,
daniel@53: 		      [ post(form(Data)),
daniel@53: 			cert_verify_hook(ssl_verify)
daniel@53: 		      ]),
daniel@53: 	    read_stream_to_codes(In, Reply),
daniel@53: 	    close(In)),
daniel@53: 	debug(openid(associate), 'Reply: ~n~s', [Reply]),
daniel@53: 	key_values_data(Pairs, Reply),
daniel@53: 	shared_secret(Pairs, P, X, MacKey),
daniel@53: 	expires_at(Pairs, ExpiresAt),
daniel@53: 	memberchk(assoc_handle-Handle, Pairs),
daniel@53: 	memberchk(session_type-Type, Pairs),
daniel@53: 	make_association([ session_type(Type),
daniel@53: 			   expires_at(ExpiresAt),
daniel@53: 			   mac_key(MacKey)
daniel@53: 			 ], Assoc),
daniel@53: 	assert(association(URL, Handle, Assoc)).
daniel@53: 
daniel@53: 
daniel@53: %%	shared_secret(+Pairs, +P, +X, -Secret:list(codes))
daniel@53: %
daniel@53: %	Find the shared secret from the peer's reply and our data. First
daniel@53: %	clause deals with the (deprecated) non-encoded version.
daniel@53: 
daniel@53: shared_secret(Pairs, _, _, Secret) :-
daniel@53: 	memberchk(mac_key-Base64, Pairs), !,
daniel@53: 	atom_codes(Base64, Base64Codes),
daniel@53: 	phrase(base64(Base64Codes), Secret).
daniel@53: shared_secret(Pairs, P, X, Secret) :-
daniel@53: 	memberchk(dh_server_public-Base64Public, Pairs),
daniel@53: 	memberchk(enc_mac_key-Base64EncMacKey, Pairs),
daniel@53: 	memberchk(session_type-SessionType, Pairs),
daniel@53: 	base64_btwoc(ServerPublic, Base64Public),
daniel@53: 	DiffieHellman is powm(ServerPublic, X, P),
daniel@53: 	atom_codes(Base64EncMacKey, Base64EncMacKeyCodes),
daniel@53: 	phrase(base64(EncMacKey), Base64EncMacKeyCodes),
daniel@53: 	btwoc(DiffieHellman, DiffieHellmanBytes),
daniel@53: 	signature_algorithm(SessionType, SHA_Algo),
daniel@53: 	sha_hash(DiffieHellmanBytes, DHHash,
daniel@53: 		 [encoding(octet), algorithm(SHA_Algo)]),
daniel@53: 	xor_codes(DHHash, EncMacKey, Secret).
daniel@53: 
daniel@53: 
daniel@53: %%	expires_at(+Pairs, -Time) is det.
daniel@53: %
daniel@53: %	Unify Time with  a  time-stamp   stating  when  the  association
daniel@53: %	exires.
daniel@53: 
daniel@53: expires_at(Pairs, Time) :-
daniel@53: 	memberchk(expires_in-ExpAtom, Pairs),
daniel@53: 	atom_number(ExpAtom, Seconds),
daniel@53: 	get_time(Now),
daniel@53: 	Time is integer(Now)+Seconds.
daniel@53: 
daniel@53: 
daniel@53: %%	associate_data(-Data, -P, -G, -X, +Options) is det.
daniel@53: %
daniel@53: %	Generate the data to initiate an association using Diffie-Hellman
daniel@53: %	shared secret key negotiation.
daniel@53: 
daniel@53: associate_data(Data, P, G, X, Options) :-
daniel@53: 	openid_dh_p(P),
daniel@53: 	openid_dh_g(G),
daniel@53: 	X is 1+random(P-1),			% 1<=X<P-1
daniel@53: 	CP is powm(G, X, P),
daniel@53: 	base64_btwoc(P, P64),
daniel@53: 	base64_btwoc(G, G64),
daniel@53: 	base64_btwoc(CP, CP64),
daniel@53: 	option(ns(NS), Options, 'http://specs.openid.net/auth/2.0'),
daniel@53: 	(   assoc_type(NS, DefAssocType, DefSessionType)
daniel@53: 	->  true
daniel@53: 	;   domain_error('openid.ns', NS)
daniel@53: 	),
daniel@53: 	option(assoc_type(AssocType), Options, DefAssocType),
daniel@53: 	option(assoc_type(SessionType), Options, DefSessionType),
daniel@53: 	Data = [ 'openid.ns'		     = NS,
daniel@53: 		 'openid.mode'		     = associate,
daniel@53: 		 'openid.assoc_type'	     = AssocType,
daniel@53: 		 'openid.session_type'	     = SessionType,
daniel@53: 		 'openid.dh_modulus'	     = P64,
daniel@53: 		 'openid.dh_gen'	     = G64,
daniel@53: 		 'openid.dh_consumer_public' = CP64
daniel@53: 	       ].
daniel@53: 
daniel@53: assoc_type('http://specs.openid.net/auth/2.0',
daniel@53: 	   'HMAC-SHA256',
daniel@53: 	   'DH-SHA256').
daniel@53: assoc_type('http://openid.net/signon/1.1',
daniel@53: 	   'HMAC-SHA1',
daniel@53: 	   'DH-SHA1').
daniel@53: 
daniel@53: 
daniel@53: 		 /*******************************
daniel@53: 		 *	      RANDOM		*
daniel@53: 		 *******************************/
daniel@53: 
daniel@53: %%	random_bytes(+N, -Bytes) is det.
daniel@53: %
daniel@53: %	Bytes is a list of N random bytes (integers 0..255).
daniel@53: 
daniel@53: random_bytes(N, [H|T]) :-
daniel@53: 	N > 0, !,
daniel@53: 	H is random(256),
daniel@53: 	N2 is N - 1,
daniel@53: 	random_bytes(N2, T).
daniel@53: random_bytes(_, []).
daniel@53: 
daniel@53: 
daniel@53: 		 /*******************************
daniel@53: 		 *	     CONSTANTS		*
daniel@53: 		 *******************************/
daniel@53: 
daniel@53: openid_dh_p(155172898181473697471232257763715539915724801966915404479707795314057629378541917580651227423698188993727816152646631438561595825688188889951272158842675419950341258706556549803580104870537681476726513255747040765857479291291572334510643245094715007229621094194349783925984760375594985848253359305585439638443).
daniel@53: 
daniel@53: openid_dh_g(2).
daniel@53: 
daniel@53: 
daniel@53: 		 /*******************************
daniel@53: 		 *	       UTIL		*
daniel@53: 		 *******************************/
daniel@53: 
daniel@53: %%	key_values_data(+KeyValues:list(Key-Value), -Data:list(code)) is det.
daniel@53: %%	key_values_data(-KeyValues:list(Key-Value), +Data:list(code)) is det.
daniel@53: %
daniel@53: %	Encoding  and  decoding  of  key-value  pairs  for  OpenID  POST
daniel@53: %	messages  according  to   Appendix   C    of   the   OpenID  1.1
daniel@53: %	specification.
daniel@53: 
daniel@53: key_values_data(Pairs, Data) :-
daniel@53: 	nonvar(Data), !,
daniel@53: 	phrase(data_form(Pairs), Data).
daniel@53: key_values_data(Pairs, Data) :-
daniel@53: 	phrase(gen_data_form(Pairs), Data).
daniel@53: 
daniel@53: data_form([Key-Value|Pairs]) -->
daniel@53: 	utf8_string(KeyCodes), ":", utf8_string(ValueCodes), "\n", !,
daniel@53: 	{ atom_codes(Key, KeyCodes),
daniel@53: 	  atom_codes(Value, ValueCodes)
daniel@53: 	},
daniel@53: 	data_form(Pairs).
daniel@53: data_form([]) -->
daniel@53: 	ws.
daniel@53: 
daniel@53: %%	utf8_string(-Codes)// is nondet.
daniel@53: %
daniel@53: %	Take a short UTF-8 code-list from input. Extend on backtracking.
daniel@53: 
daniel@53: utf8_string([]) -->
daniel@53: 	[].
daniel@53: utf8_string([H|T]) -->
daniel@53: 	utf8_codes([H]),
daniel@53: 	utf8_string(T).
daniel@53: 
daniel@53: ws -->
daniel@53: 	[C],
daniel@53: 	{ C =< 32 }, !,
daniel@53: 	ws.
daniel@53: ws -->
daniel@53: 	[].
daniel@53: 
daniel@53: 
daniel@53: gen_data_form([]) -->
daniel@53: 	[].
daniel@53: gen_data_form([Key-Value|T]) -->
daniel@53: 	field(Key), ":", field(Value), "\n",
daniel@53: 	gen_data_form(T).
daniel@53: 
daniel@53: field(Field) -->
daniel@53: 	{ to_codes(Field, Codes)
daniel@53: 	},
daniel@53: 	utf8_codes(Codes).
daniel@53: 
daniel@53: to_codes(Codes, Codes) :-
daniel@53: 	is_list(Codes), !.
daniel@53: to_codes(Atomic, Codes) :-
daniel@53: 	atom_codes(Atomic, Codes).
daniel@53: 
daniel@53: %%	base64_btwoc(+Int, -Base64:list(code)) is det.
daniel@53: %%	base64_btwoc(-Int, +Base64:list(code)) is det.
daniel@53: %%	base64_btwoc(-Int, +Base64:atom) is det.
daniel@53: 
daniel@53: base64_btwoc(Int, Base64) :-
daniel@53: 	integer(Int), !,
daniel@53: 	btwoc(Int, Bytes),
daniel@53: 	phrase(base64(Bytes), Base64).
daniel@53: base64_btwoc(Int, Base64) :-
daniel@53: 	atom(Base64), !,
daniel@53: 	atom_codes(Base64, Codes),
daniel@53: 	phrase(base64(Bytes), Codes),
daniel@53: 	btwoc(Int, Bytes).
daniel@53: base64_btwoc(Int, Base64) :-
daniel@53: 	phrase(base64(Bytes), Base64),
daniel@53: 	btwoc(Int, Bytes).
daniel@53: 
daniel@53: 
daniel@53: %%	btwoc(+Integer, -Bytes) is det.
daniel@53: %%	btwoc(-Integer, +Bytes) is det.
daniel@53: %
daniel@53: %	Translate between a big integer and and its representation in
daniel@53: %	bytes.  The first bit is always 0, as Integer is nonneg.
daniel@53: 
daniel@53: btwoc(Int, Bytes) :-
daniel@53: 	integer(Int), !,
daniel@53: 	int_to_bytes(Int, Bytes).
daniel@53: btwoc(Int, Bytes) :-
daniel@53: 	is_list(Bytes),
daniel@53: 	bytes_to_int(Bytes, Int).
daniel@53: 
daniel@53: int_to_bytes(Int, Bytes) :-
daniel@53: 	int_to_bytes(Int, [], Bytes).
daniel@53: 
daniel@53: int_to_bytes(Int, Bytes0, [Int|Bytes0]) :-
daniel@53: 	Int < 128, !.
daniel@53: int_to_bytes(Int, Bytes0, Bytes) :-
daniel@53: 	Last is Int /\ 0xff,
daniel@53: 	Int1 is Int >> 8,
daniel@53: 	int_to_bytes(Int1, [Last|Bytes0], Bytes).
daniel@53: 
daniel@53: 
daniel@53: bytes_to_int([B|T], Int) :-
daniel@53: 	bytes_to_int(T, B, Int).
daniel@53: 
daniel@53: bytes_to_int([], Int, Int).
daniel@53: bytes_to_int([B|T], Int0, Int) :-
daniel@53: 	Int1 is (Int0<<8)+B,
daniel@53: 	bytes_to_int(T, Int1, Int).
daniel@53: 
daniel@53: 
daniel@53: %%	xor_codes(+C1:list(int), +C2:list(int), -XOR:list(int)) is det.
daniel@53: %
daniel@53: %	Compute xor of two strings.
daniel@53: %
daniel@53: %	@error	length_mismatch(L1, L2) if the two lists do not have equal
daniel@53: %		length.
daniel@53: 
daniel@53: xor_codes([], [], []) :- !.
daniel@53: xor_codes([H1|T1], [H2|T2], [H|T]) :- !,
daniel@53: 	H is H1 xor H2, !,
daniel@53: 	xor_codes(T1, T2, T).
daniel@53: xor_codes(L1, L2, _) :-
daniel@53: 	throw(error(length_mismatch(L1, L2), _)).
daniel@53: 
daniel@53: 
daniel@53: 		 /*******************************
daniel@53: 		 *	  HTTP ATTRIBUTES	*
daniel@53: 		 *******************************/
daniel@53: 
daniel@53: openid_attribute('openid.mode',
daniel@53: 		 [ oneof([ associate,
daniel@53: 			   checkid_setup,
daniel@53: 			   cancel,
daniel@53: 			   id_res
daniel@53: 			 ])
daniel@53: 		 ]).
daniel@53: openid_attribute('openid.assoc_type',
daniel@53: 		 [ oneof(['HMAC-SHA1'])
daniel@53: 		 ]).
daniel@53: openid_attribute('openid.session_type',
daniel@53: 		 [ oneof([ 'DH-SHA1',
daniel@53: 			   'DH-SHA256'
daniel@53: 			 ])
daniel@53: 		 ]).
daniel@53: openid_attribute('openid.dh_modulus',	      [length > 1]).
daniel@53: openid_attribute('openid.dh_gen',	      [length > 1]).
daniel@53: openid_attribute('openid.dh_consumer_public', [length > 1]).
daniel@53: openid_attribute('openid.assoc_handle',	      [length > 1]).
daniel@53: openid_attribute('openid.return_to',	      [length > 1]).
daniel@53: openid_attribute('openid.trust_root',	      [length > 1]).
daniel@53: openid_attribute('openid.identity',	      [length > 1]).
daniel@53: openid_attribute('openid.password',	      [length > 1]).
daniel@53: openid_attribute('openid.grant',	      [oneof([yes,no])]).