Mercurial > hg > dbtune-rdf-services
view jamendo/sparql-archived/SeRQL/lib/http/http_openid.pl @ 27:d95e683fbd35 tip
Enable CORS on urispace redirects as well
| author | Chris Cannam |
|---|---|
| date | Tue, 20 Feb 2018 14:52:02 +0000 |
| parents | df9685986338 |
| children |
line wrap: on
line source
/* $Id$ Part of SWI-Prolog Author: Jan Wielemaker E-mail: wielemak@science.uva.nl WWW: http://www.swi-prolog.org Copyright (C): 2007, University of Amsterdam This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA As a special exception, if you link this library with other files, compiled with a Free Software compiler, to produce an executable, this library does not by itself cause the resulting executable to be covered by the GNU General Public License. This exception does not however invalidate any other reasons why the executable file might be covered by the GNU General Public License. */ :- module(http_openid, [ openid_login/1, % +OpenID openid_logout/1, % +OpenID openid_logged_in/1, % -OpenID % transparent login openid_user/3, % +Request, -User, +Options % low-level primitives openid_verify/2, % +Options, +Request openid_authenticate/4, % +Request, -Server, -User, -ReturnTo openid_associate/3, % +OpenIDServer, -Handle, -Association openid_server/2, % +Request openid_grant/1, % +Request openid_file/1, % +Request (?name=File) openid_server/3, % ?OpenIDLogin, ?OpenID, ?Server openid_login_form/4, % +ReturnTo, +Options, // openid_css/2, % +Emit link to CSS page openid_current_host/3 % +Request, -Host, -Port ]). :- use_module(library('http/http_open')). :- use_module(library('http/http_client')). :- use_module(library('http/html_write')). :- use_module(library('http/http_parameters')). :- use_module(library('http/http_wrapper')). :- use_module(library('http/thread_httpd')). :- use_module(library('http/http_dispatch')). :- use_module(library('http/http_session')). :- use_module(library('http/http_host')). :- use_module(library(utf8)). :- use_module(library(error)). :- use_module(library(sgml)). :- use_module(library(url)). :- use_module(library(occurs)). :- use_module(library(base64)). :- use_module(library(debug)). :- use_module(library(record)). :- use_module(library(option)). :- use_module(library(sha)). :- use_module(library(socket)). :- use_module(library(lists)). /** <module> OpenID consumer library This library implements the OpenID protocol (http://openid.net/). OpenID is a protocol to share identities on the network. The protocol itself uses simple basic HTTP, adding reliability using digitally signed messages. Steps, as seen from the _consumer_ (or _|relying partner|_). 1. Show login form, asking for =openid_identifier= 2. Get HTML page from =openid_identifier= and lookup =|<link rel="openid.server" href="server">|= 3. Associate to _server_ 4. Redirect browser (302) to server using mode =checkid_setup=, asking to validate the given OpenID. 5. OpenID server redirects back, providing digitally signed conformation of the claimed identity. 6. Validate signature and redirect to the target location. This module is typically used through openid_user/3. @author Jan Wielemaker */ %% openid_hook(+Action) % % Call hook on the OpenID management library. Defined hooks are: % % * login(+OpenID) % Consider OpenID logged in. % % * logout(+OpenID) % Logout OpenID % % * logged_in(?OpenID) % True if OpenID is logged in % % * grant(+Request, +Options) % Server: Reply positive on OpenID % % * trusted_server(?Server) % True if Server is a trusted OpenID server :- multifile openid_hook/1. % +Action /******************************* * DIRECT LOGIN/OUT * *******************************/ %% openid_login(+OpenID) is det. % % Associate the current HTTP session with OpenID. If another % OpenID is already associated, this association is first removed. openid_login(OpenID) :- openid_hook(login(OpenID)), !. openid_login(OpenID) :- openid_logout(_), http_session_assert(openid(OpenID)). %% openid_logout(+OpenID) is det. % % Remove the association of the current session with any OpenID openid_logout(OpenID) :- openid_hook(logout(OpenID)), !. openid_logout(OpenID) :- http_session_retractall(openid(OpenID)). %% openid_logged_in(-OpenID) is semidet. % % True if session is associated with OpenID. openid_logged_in(OpenID) :- openid_hook(logged_in(OpenID)), !. openid_logged_in(OpenID) :- http_session_data(openid(OpenID)). /******************************* * TOPLEVEL * *******************************/ %% openid_user(+Request:http_request, -OpenID:url, +Options) is det. % % True if OpenID is a validated OpenID associated with the current % session. The scenario for which this predicate is designed is to % allow an HTTP handler that requires a valid login to % use the transparent code below. % % == % handler(Request) :- % openid_user(Request, OpenID, []), % ... % == % % If the user is not yet logged on a sequence of redirects will % follow: % % 1. Show a page for login (default: page /openid/login), % predicate reply_openid_login/1) % 2. Redirect to OpenID server to validate % 3. Redirect to validation % % Options: % % * login_url(Login) % (Local) URL of page to enter OpenID information. Default % is =|/openid/login|=. % % @see openid_authenticate/4 produces errors if login is invalid % or cancelled. :- http_handler('/openid/login', openid_login_page, []). :- http_handler('/openid/verify', openid_verify([]), []). openid_user(_Request, OpenID, _Options) :- openid_logged_in(OpenID), !. openid_user(Request, User, _Options) :- openid_authenticate(Request, _OpenIdServer, OpenID, _ReturnTo), !, openid_server(User, OpenID, _), openid_login(User). openid_user(Request, _OpenID, Options) :- option(login_url(Login), Options, '/openid/login'), current_url(Request, Here), redirect_browser(Login, [ 'openid.return_to' = Here ]). %% openid_login_page(+Request) is det. % % Present a login-form for OpenID. There are two ways to redefine % this default login page. One is to provide the option % =login_url= to openid_user/3 and the other is to define a new % handler for =|/openid/login|= using http_handler/3. % % @tbd Add CSS to page % @tbd Use http_current_handler/2 to make the link more dynamic. openid_login_page(Request) :- http_parameters(Request, [ 'openid.return_to'(ReturnTo, []) ]), reply_html_page([ title('OpenID login'), \openid_css ], [ \openid_login_form(ReturnTo, []) ]). %% openid_css// is det. % % Emit a link to the OpenID CSS file. openid_css --> html(link([ rel(stylesheet), type('text/css'), href('file?name=openid_css') ])). %% openid_login_form(+ReturnTo, +Options)// is det. % % Create the OpenID form. This exported as a seperate DCG, % allowing applications to redefine /openid/login and reuse this % part of the page. openid_login_form(ReturnTo, Options) --> { option(action(Action), Options, verify) }, html(div(class('openid-login'), [ \openid_title, form([ name(login), action(Action), method('GET') ], [ \hidden('openid.return_to', ReturnTo), div([ input([ class('openid-input'), name(openid_url), size(30) ]), input([ type(submit), value('Verify!') ]) ]) ]) ])). /******************************* * HTTP REPLIES * *******************************/ %% openid_verify(+Options, +Request) % % Handle the initial login form presented to the user by the % relying party (consumer). This predicate discovers the OpenID % server, associates itself with this server and redirects the % user's browser to the OpenID server, providing the extra % openid.X name-value pairs. Options is, against the conventions, % placed in front of the Request to allow for smooth cooperation % with http_dispatch.pl. % % The OpenId server will redirect to the openid.return_to URL. % % @throws http_reply(moved_temporary(Redirect)) openid_verify(Options, Request) :- http_parameters(Request, [ openid_url(URL, [length>1]), 'openid.return_to'(ReturnTo0, [optional(true)]) ]), ( option(return_to(ReturnTo1), Options) % Option -> current_url(Request, CurrentLocation), global_url(ReturnTo1, CurrentLocation, ReturnTo) ; nonvar(ReturnTo0) -> ReturnTo = ReturnTo0 % Form-data ; current_url(Request, CurrentLocation), ReturnTo = CurrentLocation % Current location ), current_root_url(Request, CurrentRoot), option(trust_root(TrustRoot), Options, CurrentRoot), openid_resolve(URL, OpenIDLogin, OpenID, Server), trusted(OpenID, Server), openid_associate(Server, Handle, _Assoc), assert_openid(OpenIDLogin, OpenID, Server), redirect_browser(Server, [ 'openid.mode' = checkid_setup, 'openid.identity' = OpenID, 'openid.assoc_handle' = Handle, 'openid.return_to' = ReturnTo, 'openid.trust_root' = TrustRoot ]). %% assert_openid(+OpenIDLogin, +OpenID, +Server) is det. % % Associate the OpenID as typed by the user, the OpenID as % validated by the Server with the current HTTP session. % % @param OpenIDLogin Canonized OpenID typed by user % @param OpenID OpenID verified by Server. assert_openid(OpenIDLogin, OpenID, Server) :- http_session_assert(openid_login(OpenIDLogin, OpenID, Server)). %% openid_server(?OpenIDLogin, ?OpenID, ?Server) is nondet. % % True if OpenIDLogin is the typed id for OpenID verified by % Server. % % @param OpenIDLogin ID as typed by user (canonized) % @param OpenID ID as verified by server % @param Server URL of the OpenID server openid_server(OpenIDLogin, OpenID, Server) :- http_session_data(openid_login(OpenIDLogin, OpenID, Server)), !. %% current_url(+Request, -Root) is det. %% current_root_url(+Request, -Root) is det. % % Return URL of current request or current root. current_root_url(Request, Root) :- openid_current_host(Request, Host, Port), parse_url(Root, [protocol(http), host(Host), port(Port), path(/)]). current_url(Request, URL) :- openid_current_host(Request, Host, Port), ( option(x_redirected_path(Path), Request) -> true ; option(path(Path), Request, /) ), option(search(Search), Request, []), parse_url(URL, [ protocol(http), host(Host), port(Port), path(Path), search(Search) ]). %% openid_current_host(Request, Host, Port) % % Find current location of the server. openid_current_host(Request, Host, Port) :- http_current_host(Request, Host, Port, [ global(true) ]). %% redirect_browser(+URL, +FormExtra) % % Generate a 302 temporary redirect to URL, adding the extra form % information from FormExtra. The specs says we must retain the % search specification already attached to the URL. redirect_browser(URL, FormExtra) :- is_absolute_url(URL), !, parse_url(URL, Parts0), ( select(search(List), Parts0, Parts1) -> append(List, FormExtra, Search), Parts = [search(Search)|Parts1] ; Parts = [search(FormExtra)|Parts0] ), parse_url(Redirect, Parts), throw(http_reply(moved_temporary(Redirect))). redirect_browser(Location, FormExtra) :- http_location(Parts0, Location), ( select(search(List), Parts0, Parts1) -> append(List, FormExtra, Search), Parts = [search(Search)|Parts1] ; Parts = [search(FormExtra)|Parts0] ), http_location(Parts, Redirect), throw(http_reply(moved_temporary(Redirect))). /******************************* * RESOLVE * *******************************/ %% openid_resolve(+URL, -OpenIDOrig, -OpenID, -Server) % % True if OpenID is the claimed OpenID that belongs to URL and % Server is the URL of the OpenID server that can be asked to % verify this claim. % % @param URL The OpenID typed by the user % @param OpenIDOrig Canonized OpenID typed by user % @param OpenID Possibly delegated OpenID % @param Server OpenID server that must validate OpenID % % @tbd Implement complete URL canonization as defined by the % OpenID 2.0 proposal. openid_resolve(URL, OpenID0, OpenID, Server) :- debug(openid(resolve), 'Opening ~w ...', [URL]), http_open(URL, Stream, [ final_url(OpenID0) ]), dtd(html, DTD), call_cleanup(load_structure(Stream, Term, [ dtd(DTD), dialect(sgml), shorttag(false), syntax_errors(quiet) ]), close(Stream)), debug(openid(resolve), 'Scanning HTML document ...', [URL]), contains_term(element(head, _, Head), Term), ( link(Head, 'openid.server', Server) -> debug(openid(resolve), 'OpenID Server=~q', [Server]) ; debug(openid(resolve), 'No server in ~q', [Head]), fail ), ( link(Head, 'openid.delegate', OpenID) -> debug(openid(resolve), 'OpenID = ~q (delegated)', [OpenID]) ; OpenID = OpenID0, debug(openid(resolve), 'OpenID = ~q', [OpenID]) ). link(DOM, Type, Target) :- sub_term(element(link, Attrs, []), DOM), memberchk(rel=Type, Attrs), memberchk(href=Target, Attrs). /******************************* * AUTHENTICATE * *******************************/ %% openid_authenticate(+Request, -Server:url, -OpenID:url, %% -ReturnTo:url) is semidet. % % Succeeds if Request comes from the OpenID server and confirms % that User is a verified OpenID user. ReturnTo provides the URL % to return to. % % After openid_verify/2 has redirected the browser to the OpenID % server, and the OpenID server did its magic, it redirects the % browser back to this address. The work is fairly trivial. If % =mode= is =cancel=, the OpenId server denied. If =id_res=, the % OpenId server replied positive, but we must verify what the % server tells us by checking the HMAC-SHA signature. % % This call fails silently if their is no =|openid.mode|= field in % the request. % % @throws openid(cancel) % if request was cancelled by the OpenId server % @throws openid(signature_mismatch) % if the HMAC signature check failed openid_authenticate(Request, OpenIdServer, Identity, ReturnTo) :- http_parameters(Request, [ 'openid.mode'(Mode, [optional(true)]) ]), ( var(Mode) -> fail ; Mode == cancel -> throw(openid(cancel)) ; Mode == id_res -> http_parameters(Request, [ 'openid.identity'(Identity, []), 'openid.assoc_handle'(Handle, []), 'openid.return_to'(ReturnTo, []), 'openid.signed'(AtomFields, []), 'openid.sig'(Base64Signature, []), 'openid.invalidate_handle'(Invalidate, [optional(true)]) ], [ form_data(Form) ]), concat_atom(SignedFields, ',', AtomFields), check_obligatory_fields(SignedFields), signed_pairs(SignedFields, [ mode-Mode, identity-Identity, assoc_handle-Handle, return_to-ReturnTo, invalidate_handle-Invalidate ], Form, SignedPairs), ( openid_associate(OpenIdServer, Handle, Assoc) -> signature(SignedPairs, Assoc, Sig) ; existence_error(assoc_handle, Handle) ), atom_codes(Base64Signature, Base64SigCodes), phrase(base64(Signature), Base64SigCodes), ( Sig == Signature -> true ; throw(openid(signature_mismatch)) ) ). %% signed_pairs(+FieldNames, +Pairs:list(Field-Value), +Form, -SignedPairs) is det. % % Extract the signed field in the order they appear in FieldNames. signed_pairs([], _, _, []). signed_pairs([Field|T0], Pairs, Form, [Field-Value|T]) :- memberchk(Field-Value, Pairs), !, signed_pairs(T0, Pairs, Form, T). signed_pairs([Field|T0], Pairs, Form, [Field-Value|T]) :- atom_concat('openid.', Field, OpenIdField), memberchk(OpenIdField=Value, Form), !, signed_pairs(T0, Pairs, Form, T). signed_pairs([Field|T0], Pairs, Form, T) :- format(user_error, 'Form = ~p~n', [Form]), throw(error(existence_error(field, Field), context(_, 'OpenID Signed field is not present'))), signed_pairs(T0, Pairs, Form, T). %% check_obligatory_fields(+SignedFields:list) is det. % % Verify fields from obligatory_field/1 are in the signed field % list. % % @error existence_error(field, Field) check_obligatory_fields(Fields) :- ( obligatory_field(Field), ( memberchk(Field, Fields) -> true ; throw(error(existence_error(field, Field), context(_, 'OpenID field is not in signed fields'))) ), fail ; true ). obligatory_field(identity). /******************************* * OPENID SERVER * *******************************/ :- dynamic server_association/3. % URL, Handle, Term %% openid_server(+Options, +Request) % % Realise the OpenID server. The protocol demands a POST request % here. openid_server(Options, Request) :- http_parameters(Request, [ 'openid.mode'(Mode) ], [ attribute_declarations(openid_attribute), form_data(Form) ]), ( Mode == associate -> associate_server(Request, Form, Options) ; Mode == checkid_setup -> checkid_setup_server(Request, Form, Options) ). %% associate_server(+Request, +Form, +Options) % % Handle the association-request. If successful, create a clause % for server_association/3 to record the current association. associate_server(Request, Form, Options) :- memberchk('openid.assoc_type' = AssocType, Form), memberchk('openid.session_type' = SessionType, Form), memberchk('openid.dh_modulus' = P64, Form), memberchk('openid.dh_gen' = G64, Form), memberchk('openid.dh_consumer_public' = CPX64, Form), base64_btwoc(P, P64), base64_btwoc(G, G64), base64_btwoc(CPX, CPX64), dh_x(P, Y), % Our secret DiffieHellman is powm(CPX, Y, P), btwoc(DiffieHellman, DHBytes), sha_hash(DHBytes, SHA1, [algorithm(sha1)]), CPY is powm(G, Y, P), base64_btwoc(CPY, CPY64), new_assoc_handle(Handle), random_bytes(20, MacKey), xor_codes(MacKey, SHA1, EncKey), phrase(base64(EncKey), Base64EncKey), DefExpriresIn is 24*3600, option(expires_in(ExpriresIn), Options, DefExpriresIn), get_time(Now), ExpiresAt is integer(Now+ExpriresIn), make_association([ session_type(SessionType), expires_at(ExpiresAt), mac_key(MacKey) ], Record), memberchk(peer(Peer), Request), assert(server_association(Peer, Handle, Record)), key_values_data([ assoc_type-AssocType, assoc_handle-Handle, expires_in-ExpriresIn, session_type-SessionType, dh_server_public-CPY64, enc_mac_key-Base64EncKey ], Text), format('Content-type: text/plain~n~n~s', [Text]). new_assoc_handle(Handle) :- random_bytes(20, Bytes), phrase(base64(Bytes), HandleCodes), atom_codes(Handle, HandleCodes). %% checkid_setup_server(+Request, +Form, +Options) % % Validate an OpenID for a TrustRoot and redirect the browser back % to the ReturnTo argument. There are many possible scenarios % here: % % 1. Check some cookie and if present, grant immediately % 2. Use a 401 challenge page % 3. Present a normal grant/password page % 4. As (3), but use HTTPS for the exchange % 5. etc. % % First thing to check is the immediate acknowledgement. checkid_setup_server(_Request, Form, _Options) :- memberchk('openid.identity' = Identity, Form), memberchk('openid.assoc_handle' = Handle, Form), memberchk('openid.return_to' = ReturnTo, Form), memberchk('openid.trust_root' = TrustRoot, Form), server_association(_, Handle, _Association), % check reply_html_page([ title('OpenID login'), \openid_css ], [ \openid_title, div(class('openid-message'), ['Site ', a(href(TrustRoot), TrustRoot), ' requests permission \ to login with OpenID ', a(href(Identity), Identity), '.' ]), table(class('openid-form'), [ tr(td(form([ action(grant), method('GET') ], [ \hidden('openid.grant', yes), \hidden('openid.identity', Identity), \hidden('openid.assoc_handle', Handle), \hidden('openid.return_to', ReturnTo), \hidden('openid.trust_root', TrustRoot), div(['Password: ', input([type(password), name('openid.password')]), input([type(submit), value('Grant')]) ]) ]))), tr(td(align(right), form([ action(grant), method('GET') ], [ \hidden('openid.grant', no), \hidden('openid.return_to', ReturnTo), input([type(submit), value('Deny')]) ]))) ]) ]). hidden(Name, Value) --> html(input([type(hidden), name(Name), value(Value)])). openid_title --> html(div(class('openid-title'), [ a(href('http://openid.net/'), img([ src('file?name=openid_logo'), alt('OpenID') ])), span('Login') ])). %% openid_grant(+Request) % % Handle the reply from checkid_setup_server/3. If the reply is % =yes=, check the authority (typically the password) and if all % looks good redirect the browser to ReturnTo, adding the OpenID % properties needed by the Relying Party to verify the login. openid_grant(Request) :- http_parameters(Request, [ 'openid.grant'(Grant), 'openid.return_to'(ReturnTo) ], [ attribute_declarations(openid_attribute) ]), ( Grant == yes -> http_parameters(Request, [ 'openid.identity'(Identity), 'openid.assoc_handle'(Handle), 'openid.trust_root'(TrustRoot), 'openid.password'(Password) ], [ attribute_declarations(openid_attribute) ]), server_association(_, Handle, Association), grant_login(Request, [ identity(Identity), password(Password), trustroot(TrustRoot) ]), SignedPairs = [ 'mode'-id_res, 'identity'-Identity, 'assoc_handle'-Handle, 'return_to'-ReturnTo ], signed_fields(SignedPairs, Signed), signature(SignedPairs, Association, Signature), phrase(base64(Signature), Bas64Sig), redirect_browser(ReturnTo, [ 'openid.mode' = id_res, 'openid.identity' = Identity, 'openid.assoc_handle' = Handle, 'openid.return_to' = ReturnTo, 'openid.signed' = Signed, 'openid.sig' = Bas64Sig ]) ; redirect_browser(ReturnTo, [ 'openid.mode' = cancel ]) ). %% grant_login(+Request, +Options) is det. % % Validate login from Request (can be used to get cookies) and % Options, which contains at least: % % * identity(Identity) % * password(Password) % * trustroot(TrustRoot) grant_login(Request, Options) :- openid_hook(grant(Request, Options)). %% trusted(+OpenID, +Server) % % True if we trust the given OpenID server. Must throw an % exception, possibly redirecting to a page with trusted servers % if the given server is not trusted. % % @tbd How do we manage this? Broadcast? Settings? Hook? trusted(OpenID, Server) :- openid_hook(trusted(OpenID, Server)). %% signed_fields(+Pairs, -Signed) is det. % % Create a comma-separated atom from the field-names without % 'openid.' from Pairs. signed_fields(Pairs, Signed) :- signed_field_names(Pairs, Names), concat_atom(Names, ',', Signed). signed_field_names([], []). signed_field_names([H0-_|T0], [H|T]) :- ( atom_concat('openid.', H, H0) -> true ; H = H0 ), signed_field_names(T0, T). %% signature(+Pairs, +Association, -Signature) % % Determine the signature for Pairs signature(Pairs, Association, Signature) :- key_values_data(Pairs, TokenContents), association_mac_key(Association, MacKey), association_session_type(Association, SessionType), signature_algorithm(SessionType, SHA), hmac_sha(MacKey, TokenContents, Signature, [algorithm(SHA)]), debug(openid(crypt), 'Signed:~n~s~nSignature: ~w', [TokenContents, Signature]). signature_algorithm('DH-SHA1', sha1). signature_algorithm('DH-SHA256', sha256). /******************************* * IMAGES * *******************************/ %% openid_file(+Request) % % Serve fiels we use as logos, style-sheets, etc. openid_file(Request) :- http_parameters(Request, [ name(Name, []) ]), image_file(Name, File), http_reply_file(File, [], Request). image_file(openid_logo, library('http/openid-logo-square.png')). image_file(openid_logo_tiny, library('http/openid-logo-tiny.png')). image_file(openid_css, library('http/openid.css')). /******************************* * ASSOCIATE * *******************************/ :- dynamic association/3. % URL, Handle, Data :- record association(session_type='DH-SHA1', expires_at, % time-stamp mac_key). % code-list %% openid_associate(+URL, -Handle, -Assoc) is det. %% openid_associate(?URL, +Handle, -Assoc) is semidet. % % Associate with an open-id server. We first check for a still % valid old association. If there is none or it is expired, we % esstablish one and remember it. % % @tbd Should we store known associations permanently? Where? openid_associate(URL, Handle, Assoc) :- association(URL, Handle, Assoc), association_expires_at(Assoc, Expires), get_time(Now), ( Now < Expires -> debug(openid(associate), '~w: Reusing association', [URL]) ; retractall(association(URL, Handle, _)), fail ). openid_associate(URL, Handle, Assoc) :- ground(URL), associate_data(Data, P, _G, X), http_post(URL, form(Data), Reply, [to(codes)]), debug(openid(associate), 'Reply: ~n~s', [Reply]), key_values_data(Pairs, Reply), shared_secret(Pairs, P, X, MacKey), expires_at(Pairs, ExpiresAt), memberchk(assoc_handle-Handle, Pairs), memberchk(session_type-Type, Pairs), make_association([ session_type(Type), expires_at(ExpiresAt), mac_key(MacKey) ], Assoc), assert(association(URL, Handle, Assoc)). %% shared_secret(+Pairs, +P, +X, -Secret:list(codes)) % % Find the shared secret from the peer's reply and our data. First % clause deals with the (deprecated) non-encoded version. shared_secret(Pairs, _, _, Secret) :- memberchk(mac_key-Base64, Pairs), !, atom_codes(Base64, Base64Codes), phrase(base64(Base64Codes), Secret). shared_secret(Pairs, P, X, Secret) :- memberchk(dh_server_public-Base64Public, Pairs), memberchk(enc_mac_key-Base64EncMacKey, Pairs), base64_btwoc(ServerPublic, Base64Public), DiffieHellman is powm(ServerPublic, X, P), atom_codes(Base64EncMacKey, Base64EncMacKeyCodes), phrase(base64(EncMacKey), Base64EncMacKeyCodes), btwoc(DiffieHellman, DiffieHellmanBytes), sha_hash(DiffieHellmanBytes, DHHash, [algorithm(sha1)]), xor_codes(DHHash, EncMacKey, Secret). %% expires_at(+Pairs, -Time) is det. % % Unify Time with a time-stamp stating when the association % exires. expires_at(Pairs, Time) :- memberchk(expires_in-ExpAtom, Pairs), atom_number(ExpAtom, Seconds), get_time(Now), Time is integer(Now)+Seconds. %% associate_data(-Data, -X) is det. % % Generate the data to initiate an association using Diffie-Hellman % shared secret key negotiation. associate_data(Data, P, G, X) :- openid_dh_p(P), openid_dh_g(G), dh_x(P, X), CP is powm(G, X, P), base64_btwoc(P, P64), base64_btwoc(G, G64), base64_btwoc(CP, CP64), Data = [ 'openid.mode' = associate, 'openid.assoc_type' = 'HMAC-SHA1', 'openid.session_type' = 'DH-SHA1', 'openid.dh_modulus' = P64, 'openid.dh_gen' = G64, 'openid.dh_consumer_public' = CP64 ]. /******************************* * RANDOM * *******************************/ %% random_bytes(+N, -Bytes) is det. % % Bytes is a list of N random bytes (integers 0..255). random_bytes(N, [H|T]) :- N > 0, !, H is random(256), N2 is N - 1, random_bytes(N2, T). random_bytes(_, []). %% dh_x(+Max, -X) % % Generate a random key X where 1<=X<P-1) % % @tbd If we have /dev/urandom, use that. dh_x(P, X) :- X0 is random(65536), Max is P - 1, dh_x(Max, X0, X). dh_x(Max, X0, X) :- X1 is X0<<16+random(65536), ( X1 >= Max -> X = X0 ; dh_x(Max, X1, X) ). /******************************* * CONSTANTS * *******************************/ openid_dh_p(155172898181473697471232257763715539915724801966915404479707795314057629378541917580651227423698188993727816152646631438561595825688188889951272158842675419950341258706556549803580104870537681476726513255747040765857479291291572334510643245094715007229621094194349783925984760375594985848253359305585439638443). openid_dh_g(2). /******************************* * UTIL * *******************************/ %% key_values_data(+KeyValues:list(Key-Value), -Data:list(code)) is det. %% key_values_data(-KeyValues:list(Key-Value), +Data:list(code)) is det. % % Encoding and decoding of key-value pairs for OpenID POST % messages according to Appendix C of the OpenID 1.1 % specification. key_values_data(Pairs, Data) :- nonvar(Data), !, phrase(data_form(Pairs), Data). key_values_data(Pairs, Data) :- phrase(gen_data_form(Pairs), Data). data_form([Key-Value|Pairs]) --> utf8_string(KeyCodes), ":", utf8_string(ValueCodes), "\n", !, { atom_codes(Key, KeyCodes), atom_codes(Value, ValueCodes) }, data_form(Pairs). data_form([]) --> ws. %% utf8_string(-Codes)// is nondet. % % Take a short UTF-8 code-list from input. Extend on backtracking. utf8_string([]) --> []. utf8_string([H|T]) --> utf8_codes([H]), utf8_string(T). ws --> [C], { C =< 32 }, !, ws. ws --> []. gen_data_form([]) --> []. gen_data_form([Key-Value|T]) --> field(Key), ":", field(Value), "\n", gen_data_form(T). field(Field) --> { to_codes(Field, Codes) }, utf8_codes(Codes). to_codes(Codes, Codes) :- is_list(Codes), !. to_codes(Atomic, Codes) :- atom_codes(Atomic, Codes). %% base64_btwoc(+Int, -Base64:list(code)) is det. %% base64_btwoc(-Int, +Base64:list(code)) is det. %% base64_btwoc(-Int, +Base64:atom) is det. base64_btwoc(Int, Base64) :- integer(Int), !, btwoc(Int, Bytes), phrase(base64(Bytes), Base64). base64_btwoc(Int, Base64) :- atom(Base64), !, atom_codes(Base64, Codes), phrase(base64(Bytes), Codes), btwoc(Int, Bytes). base64_btwoc(Int, Base64) :- phrase(base64(Bytes), Base64), btwoc(Int, Bytes). %% btwoc(+Integer, -Bytes) is det. %% btwoc(-Integer, +Bytes) is det. % % Translate between a big integer and and its representation in % bytes. The first bit is always 0, as Integer is nonneg. btwoc(Int, Bytes) :- integer(Int), !, int_to_bytes(Int, Bytes). btwoc(Int, Bytes) :- is_list(Bytes), bytes_to_int(Bytes, Int). int_to_bytes(Int, Bytes) :- int_to_bytes(Int, [], Bytes). int_to_bytes(Int, Bytes0, [Int|Bytes0]) :- Int < 128, !. int_to_bytes(Int, Bytes0, Bytes) :- Last is Int /\ 0xff, Int1 is Int >> 8, int_to_bytes(Int1, [Last|Bytes0], Bytes). bytes_to_int([B|T], Int) :- bytes_to_int(T, B, Int). bytes_to_int([], Int, Int). bytes_to_int([B|T], Int0, Int) :- Int1 is (Int0<<8)+B, bytes_to_int(T, Int1, Int). %% xor_codes(+C1:list(int), +C2:list(int), -XOR:list(int)) is det. % % Compute xor of two strings. % % @error length_mismatch(L1, L2) if the two lists do not have equal % length. xor_codes([], [], []). xor_codes([H1|T1], [H2|T2], [H|T]) :- H is H1 xor H2, !, xor_codes(T1, T2, T). xor_codes(L1, L2, _) :- throw(error(length_mismatch(L1, L2), _)). /******************************* * HTTP ATTRIBUTES * *******************************/ openid_attribute('openid.mode', [ oneof([ associate, checkid_setup, cancel, id_res ]) ]). openid_attribute('openid.assoc_type', [ oneof(['HMAC-SHA1']) ]). openid_attribute('openid.session_type', [ oneof([ 'DH-SHA1', 'DH-SHA256' ]) ]). openid_attribute('openid.dh_modulus', [length > 1]). openid_attribute('openid.dh_gen', [length > 1]). openid_attribute('openid.dh_consumer_public', [length > 1]). openid_attribute('openid.assoc_handle', [length > 1]). openid_attribute('openid.return_to', [length > 1]). openid_attribute('openid.trust_root', [length > 1]). openid_attribute('openid.identity', [length > 1]). openid_attribute('openid.password', [length > 1]). openid_attribute('openid.grant', [oneof([yes,no])]).