View source with raw comments or as raw

    1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  2010-2015, University of Amsterdam,
    7                              VU University Amsterdam
    8    All rights reserved.
    9
   10    Redistribution and use in source and binary forms, with or without
   11    modification, are permitted provided that the following conditions
   12    are met:
   13
   14    1. Redistributions of source code must retain the above copyright
   15       notice, this list of conditions and the following disclaimer.
   16
   17    2. Redistributions in binary form must reproduce the above copyright
   18       notice, this list of conditions and the following disclaimer in
   19       the documentation and/or other materials provided with the
   20       distribution.
   21
   22    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   23    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   24    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   25    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   26    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   27    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   28    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   29    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   30    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   31    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   32    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   33    POSSIBILITY OF SUCH DAMAGE.
   34*/
   35
   36:- module(http_openid,
   37          [ openid_login/1,             % +OpenID
   38            openid_logout/1,            % +OpenID
   39            openid_logged_in/1,         % -OpenID
   40
   41                                        % transparent login
   42            openid_user/3,              % +Request, -User, +Options
   43
   44                                        % low-level primitives
   45            openid_verify/2,            % +Options, +Request
   46            openid_authenticate/4,      % +Request, -Server, -Identity, -ReturnTo
   47            openid_associate/3,         % +OpenIDServer, -Handle, -Association
   48            openid_associate/4,         % +OpenIDServer, -Handle, -Association,
   49                                        % +Options
   50            openid_server/2,            % +Options, +Request
   51            openid_server/3,            % ?OpenIDLogin, ?OpenID, ?Server
   52            openid_grant/1,             % +Request
   53
   54            openid_login_form//2,       % +ReturnTo, +Options, //
   55
   56            openid_current_url/2,       % +Request, -URL
   57            openid_current_host/3       % +Request, -Host, -Port
   58          ]).   59:- use_module(library(http/http_open)).   60:- use_module(library(http/html_write)).   61:- use_module(library(http/http_parameters)).   62:- use_module(library(http/http_dispatch)).   63:- use_module(library(http/http_session)).   64:- use_module(library(http/http_host)).   65:- use_module(library(http/http_path)).   66:- use_module(library(http/html_head)).   67:- use_module(library(http/http_server_files), []).   68:- use_module(library(http/yadis)).   69:- use_module(library(http/ax)).   70:- use_module(library(utf8)).   71:- use_module(library(error)).   72:- use_module(library(xpath)).   73:- use_module(library(sgml)).   74:- use_module(library(uri)).   75:- use_module(library(occurs)).   76:- use_module(library(base64)).   77:- use_module(library(debug)).   78:- use_module(library(record)).   79:- use_module(library(option)).   80:- use_module(library(sha)).   81:- use_module(library(lists)).   82:- use_module(library(settings)).   83
   84:- predicate_options(openid_login_form/4, 2,
   85                     [ action(atom),
   86                       buttons(list),
   87                       show_stay(boolean)
   88                     ]).   89:- predicate_options(openid_server/2, 1,
   90                     [ expires_in(any)
   91                     ]).   92:- predicate_options(openid_user/3, 3,
   93                     [ login_url(atom)
   94                     ]).   95:- predicate_options(openid_verify/2, 1,
   96                     [ return_to(atom),
   97                       trust_root(atom),
   98                       realm(atom),
   99                       ax(any)
  100                     ]).

OpenID consumer and server 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).

Show login form, asking for openid_identifier
Get HTML page from openid_identifier and lookup <link rel="openid.server" href="server">
Associate to server
Redirect browser (302) to server using mode checkid_setup, asking to validate the given OpenID.
OpenID server redirects back, providing digitally signed conformation of the claimed identity.
Validate signature and redirect to the target location.

A consumer (an application that allows OpenID login) typically uses this library through openid_user/3. In addition, it must implement the hook http_openid:openid_hook(trusted(OpenId, Server)) to define accepted OpenID servers. Typically, this hook is used to provide a white-list of acceptable servers. Note that accepting any OpenID server is possible, but anyone on the internet can setup a dummy OpenID server that simply grants and signs every request. Here is an example:

:- multifile http_openid:openid_hook/1.

http_openid:openid_hook(trusted(_, OpenIdServer)) :-
    (   trusted_server(OpenIdServer)
    ->  true
    ;   throw(http_reply(moved_temporary('/openid/trustedservers')))
    ).

trusted_server('http://www.myopenid.com/server').

By default, information who is logged on is maintained with the session using http_session_assert/1 with the term openid(Identity). The hooks login/logout/logged_in can be used to provide alternative administration of logged-in users (e.g., based on client-IP, using cookies, etc.).

To create a server, you must do four things: bind the handlers openid_server/2 and openid_grant/1 to HTTP locations, provide a user-page for registered users and define the grant(Request, Options) hook to verify your users. An example server is provided in in <plbase>/doc/packages/examples/demo_openid.pl */

  153                 /*******************************
  154                 *        CONFIGURATION         *
  155                 *******************************/
  156
  157http:location(openid, root(openid), [priority(-100)]).

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(+OpenID, +Server): True if Server is a trusted OpenID server
ax(Values): Called if the server provided AX attributes
x_parameter(+Server, -Name, -Value): Called to find additional HTTP parameters to send with the OpenID verify request.

  185:- multifile
  186    openid_hook/1.                  % +Action
  187
  188                 /*******************************
  189                 *       DIRECT LOGIN/OUT       *
  190                 *******************************/

openid_login(+OpenID) is det: Associate the current HTTP session with OpenID. If another OpenID is already associated, this association is first removed.

  197openid_login(OpenID) :-
  198    openid_hook(login(OpenID)),
  199    !,
  200    handle_stay_signed_in(OpenID).
  201openid_login(OpenID) :-
  202    openid_logout(_),
  203    http_session_assert(openid(OpenID)),
  204    handle_stay_signed_in(OpenID).

openid_logout(+OpenID) is det: Remove the association of the current session with any OpenID

  210openid_logout(OpenID) :-
  211    openid_hook(logout(OpenID)),
  212    !.
  213openid_logout(OpenID) :-
  214    http_session_retractall(openid(OpenID)).

openid_logged_in(-OpenID) is semidet: True if session is associated with OpenID.

  220openid_logged_in(OpenID) :-
  221    openid_hook(logged_in(OpenID)),
  222    !.
  223openid_logged_in(OpenID) :-
  224    http_in_session(_SessionId),            % test in session
  225    http_session_data(openid(OpenID)).
  226
  227
  228                 /*******************************
  229                 *            TOPLEVEL          *
  230                 *******************************/

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:

Show a page for login (default: page /openid/login), predicate reply_openid_login/1)
By default, the OpenID login page is a form that is submitted to the verify, which calls openid_verify/2.
openid_verify/2 does the following:
- Find the OpenID claimed identity and server
- Associate to the OpenID server
- redirects to the OpenID server for validation
The OpenID server will redirect here with the authentication information. This is handled by openid_authenticate/4.

Options:

login_url(Login): (Local) URL of page to enter OpenID information. Default is the handler for openid_login_page/1

See also: - openid_authenticate/4 produces errors if login is invalid or cancelled.

  268:- http_handler(openid(login),        openid_login_page,   [priority(-10)]).  269:- http_handler(openid(verify),       openid_verify([]),   []).  270:- http_handler(openid(authenticate), openid_authenticate, []).  271:- http_handler(openid(xrds),         openid_xrds,         []).  272
  273openid_user(_Request, OpenID, _Options) :-
  274    openid_logged_in(OpenID),
  275    !.
  276openid_user(Request, _OpenID, Options) :-
  277    http_link_to_id(openid_login_page, [], DefLoginPage),
  278    option(login_url(LoginPage), Options, DefLoginPage),
  279    openid_current_url(Request, Here),
  280    redirect_browser(LoginPage,
  281                     [ 'openid.return_to' = Here
  282                     ]).

openid_xrds(Request): Reply to a request for "Discovering OpenID Relying Parties". This may happen as part of the provider verification procedure. The provider will do a Yadis discovery request on openid.return or openid.realm. This is picked up by openid_user/3, pointing the provider to openid(xrds). Now, we reply with the locations marked openid and the locations that have actually been doing OpenID validations.

  294openid_xrds(Request) :-
  295    http_link_to_id(openid_authenticate, [], Autheticate),
  296    public_url(Request, Autheticate, Public),
  297    format('Content-type: text/xml\n\n'),
  298    format('<?xml version="1.0" encoding="UTF-8"?>\n'),
  299    format('<xrds:XRDS\n'),
  300    format('    xmlns:xrds="xri://$xrds"\n'),
  301    format('    xmlns="xri://$xrd*($v*2.0)">\n'),
  302    format('  <XRD>\n'),
  303    format('    <Service>\n'),
  304    format('      <Type>http://specs.openid.net/auth/2.0/return_to</Type>\n'),
  305    format('      <URI>~w</URI>\n', [Public]),
  306    format('    </Service>\n'),
  307    format('  </XRD>\n'),
  308    format('</xrds:XRDS>\n').

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.

  318openid_login_page(Request) :-
  319    http_open_session(_, []),
  320    http_parameters(Request,
  321                    [ 'openid.return_to'(Target, [])
  322                    ]),
  323    reply_html_page([ title('OpenID login')
  324                    ],
  325                    [ \openid_login_form(Target, [])
  326                    ]).

openid_login_form(+ReturnTo, +Options)// is det

Create the OpenID form. This exported as a separate DCG, allowing applications to redefine /openid/login and reuse this part of the page. Options processed:

action(Action): URL of action to call. Default is the handler calling openid_verify/1.
buttons(+Buttons): Buttons is a list of img structures where the href points to an OpenID 2.0 endpoint. These buttons are displayed below the OpenID URL field. Clicking the button sets the URL field and submits the form. Requires Javascript support.
If the href is relative, clicking it opens the given location after adding 'openid.return_to' and `stay'.
show_stay(+Boolean): If true, show a checkbox that allows the user to stay logged on.

  350openid_login_form(ReturnTo, Options) -->
  351    { http_link_to_id(openid_verify, [], VerifyLocation),
  352      option(action(Action), Options, VerifyLocation),
  353      http_session_retractall(openid(_)),
  354      http_session_retractall(openid_login(_,_,_,_)),
  355      http_session_retractall(ax(_))
  356    },
  357    html(div([ class('openid-login')
  358             ],
  359             [ \openid_title,
  360               form([ name(login),
  361                      id(login),
  362                      action(Action),
  363                      method('GET')
  364                    ],
  365                    [ \hidden('openid.return_to', ReturnTo),
  366                      div([ input([ class('openid-input'),
  367                                    name(openid_url),
  368                                    id(openid_url),
  369                                    size(30),
  370                                    placeholder('Your OpenID URL')
  371                                  ]),
  372                            input([ type(submit),
  373                                    value('Verify!')
  374                                  ])
  375                          ]),
  376                      \buttons(Options),
  377                      \stay_logged_on(Options)
  378                    ])
  379             ])).
  380
  381stay_logged_on(Options) -->
  382    { option(show_stay(true), Options) },
  383    !,
  384    html(div(class('openid-stay'),
  385             [ input([ type(checkbox), id(stay), name(stay), value(yes)]),
  386               'Stay signed in'
  387             ])).
  388stay_logged_on(_) --> [].
  389
  390buttons(Options) -->
  391    { option(buttons(Buttons), Options),
  392      Buttons \== []
  393    },
  394    html(div(class('openid-buttons'),
  395             [ 'Sign in with '
  396             | \prelogin_buttons(Buttons)
  397             ])).
  398buttons(_) --> [].
  399
  400prelogin_buttons([]) --> [].
  401prelogin_buttons([H|T]) --> prelogin_button(H), prelogin_buttons(T).

prelogin_button(+Image)// is det: Handle OpenID 2.0 and other pre-login buttons. If the image has a href attribute that is absolute, it is taken as an OpenID 2.0 endpoint. Otherwise it is taken as a link on the current server. This allows us to present non-OpenId logons in the same screen. The dedicated handler is passed the HTTP parameters openid.return_to and stay.

  412prelogin_button(img(Attrs)) -->
  413    { select_option(href(HREF), Attrs, RestAttrs),
  414      uri_is_global(HREF), !
  415    },
  416    html(img([ onClick('javascript:{$("#openid_url").val("'+HREF+'");'+
  417                       '$("form#login").submit();}'
  418                      )
  419                 | RestAttrs
  420             ])).
  421prelogin_button(img(Attrs)) -->
  422    { select_option(href(HREF), Attrs, RestAttrs)
  423    },
  424    html(img([ onClick('window.location = "'+HREF+
  425                       '?openid.return_to="'+
  426                       '+encodeURIComponent($("#return_to").val())'+
  427                       '+"&stay="'+
  428                       '+$("#stay").val()')
  429             | RestAttrs
  430             ])).
  431
  432
  433                 /*******************************
  434                 *          HTTP REPLIES        *
  435                 *******************************/

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. Options processes:

return_to(+URL): Specifies where the OpenID provider should return to. Normally, that is the current location.
trust_root(+URL): Specifies the openid.trust_root attribute. Defaults to the root of the current server (i.e., http://host[.port]/).
realm(+URL): Specifies the openid.realm attribute. Default is the trust_root.
ax(+Spec): Request the exchange of additional attributes from the identity provider. See http_ax_attributes/2 for details.

The OpenId server will redirect to the openid.return_to URL.

throws: - http_reply(moved_temporary(Redirect))

  464openid_verify(Options, Request) :-
  465    http_parameters(Request,
  466                    [ openid_url(URL, [length>1]),
  467                      'openid.return_to'(ReturnTo0, [optional(true)]),
  468                      stay(Stay, [optional(true), default(no)])
  469                    ]),
  470    (   option(return_to(ReturnTo1), Options)       % Option
  471    ->  openid_current_url(Request, CurrentLocation),
  472        global_url(ReturnTo1, CurrentLocation, ReturnTo)
  473    ;   nonvar(ReturnTo0)
  474    ->  ReturnTo = ReturnTo0                        % Form-data
  475    ;   openid_current_url(Request, CurrentLocation),
  476        ReturnTo = CurrentLocation                  % Current location
  477    ),
  478    public_url(Request, /, CurrentRoot),
  479    option(trust_root(TrustRoot), Options, CurrentRoot),
  480    option(realm(Realm), Options, TrustRoot),
  481    openid_resolve(URL, OpenIDLogin, OpenID, Server, ServerOptions),
  482    trusted(OpenID, Server),
  483    openid_associate(Server, Handle, _Assoc),
  484    assert_openid(OpenIDLogin, OpenID, Server, ReturnTo),
  485    stay(Stay),
  486    option(ns(NS), Options, 'http://specs.openid.net/auth/2.0'),
  487    (   realm_attribute(NS, RealmAttribute)
  488    ->  true
  489    ;   domain_error('openid.ns', NS)
  490    ),
  491    findall(P=V, openid_hook(x_parameter(Server, P, V)), XAttrs, AXAttrs),
  492    debug(openid(verify), 'XAttrs: ~p', [XAttrs]),
  493    ax_options(ServerOptions, Options, AXAttrs),
  494    http_link_to_id(openid_authenticate, [], AuthenticateLoc),
  495    public_url(Request, AuthenticateLoc, Authenticate),
  496    redirect_browser(Server, [ 'openid.ns'           = NS,
  497                               'openid.mode'         = checkid_setup,
  498                               'openid.identity'     = OpenID,
  499                               'openid.claimed_id'   = OpenID,
  500                               'openid.assoc_handle' = Handle,
  501                               'openid.return_to'    = Authenticate,
  502                               RealmAttribute        = Realm
  503                             | XAttrs
  504                             ]).
  505
  506realm_attribute('http://specs.openid.net/auth/2.0', 'openid.realm').
  507realm_attribute('http://openid.net/signon/1.1',     'openid.trust_root').

stay(+Response): Called if the user ask to stay signed in. This is called before control is handed to the OpenID server. It leaves the data openid_stay_signed_in(true) in the current session.

  516stay(yes) :-
  517    !,
  518    http_session_assert(openid_stay_signed_in(true)).
  519stay(_).

handle_stay_signed_in(+OpenID): Handle stay_signed_in option after the user has logged on

  525handle_stay_signed_in(OpenID) :-
  526    http_session_retract(openid_stay_signed_in(true)),
  527    !,
  528    http_set_session(timeout(0)),
  529    ignore(openid_hook(stay_signed_in(OpenID))).
  530handle_stay_signed_in(_).

assert_openid(+OpenIDLogin, +OpenID, +Server, +Target) is det

Associate the OpenID as typed by the user, the OpenID as validated by the Server with the current HTTP session.

Arguments:

`OpenIDLogin`	- Canonized `OpenID` typed by user
`OpenID`	- `OpenID` verified by `Server`.

  540assert_openid(OpenIDLogin, OpenID, Server, Target) :-
  541    openid_identifier_select_url(OpenIDLogin),
  542    openid_identifier_select_url(OpenID),
  543    !,
  544    assert_openid_in_session(openid_login(Identity, Identity, Server, Target)).
  545assert_openid(OpenIDLogin, OpenID, Server, Target) :-
  546    assert_openid_in_session(openid_login(OpenIDLogin, OpenID, Server, Target)).
  547
  548assert_openid_in_session(Term) :-
  549    (   http_in_session(_0Session)
  550    ->  debug(openid(verify), 'Assert ~p in ~p', [Term, _0Session])
  551    ;   debug(openid(verify), 'No session!', [])
  552    ),
  553    http_session_assert(Term).

openid_server(?OpenIDLogin, ?OpenID, ?Server) is nondet

True if OpenIDLogin is the typed id for OpenID verified by Server.

Arguments:

`OpenIDLogin`	- ID as typed by user (canonized)
`OpenID`	- ID as verified by server
`Server`	- URL of the `OpenID` server

  564openid_server(OpenIDLogin, OpenID, Server) :-
  565    openid_server(OpenIDLogin, OpenID, Server, _Target).
  566
  567openid_server(OpenIDLogin, OpenID, Server, Target) :-
  568    http_in_session(_0Session),
  569    (   http_session_data(openid_login(OpenIDLogin, OpenID, Server, Target))
  570    ->  true
  571    ;   http_session_data(openid_login(_0OpenIDLogin1, _0OpenID1,
  572                                       _0Server1, _0Target1)),
  573        debug(openid(verify), '~p \\== ~p',
  574              [ openid_login(OpenIDLogin, OpenID, Server, Target),
  575                openid_login(_0OpenIDLogin1, _0OpenID1, _0Server1, _0Target1)
  576              ]),
  577        fail
  578    ;   debug(openid(verify), 'No openid_login/4 term in session ~p',
  579              [_0Session]),
  580        fail
  581    ).

public_url(+Request, +Path, -URL) is det: True when URL is a publicly usable URL that leads to Path on the current server.

  589public_url(Request, Path, URL) :-
  590    openid_current_host(Request, Host, Port),
  591    setting(http:public_scheme, Scheme),
  592    set_port(Scheme, Port, AuthC),
  593    uri_authority_data(host, AuthC, Host),
  594    uri_authority_components(Auth, AuthC),
  595    uri_data(scheme, Components, Scheme),
  596    uri_data(authority, Components, Auth),
  597    uri_data(path, Components, Path),
  598    uri_components(URL, Components).
  599
  600set_port(Scheme, Port, _) :-
  601    scheme_port(Scheme, Port),
  602    !.
  603set_port(_, Port, AuthC) :-
  604    uri_authority_data(port, AuthC, Port).
  605
  606scheme_port(http, 80).
  607scheme_port(https, 443).

openid_current_url(+Request, -URL) is det: Find the public URL for Request that we can make available to our identity provider. This must be an absolute URL where we can be contacted. Before trying a configured version through http_public_url/2, we try to see whether the login message contains a referrer parameter or whether the browser provided one.

  618openid_current_url(Request, URL) :-
  619    option(request_uri(URI), Request),
  620    uri_components(URI, Components),
  621    uri_data(path, Components, Path),
  622    (   uri_data(search, Components, QueryString),
  623        nonvar(QueryString),
  624        uri_query_components(QueryString, Query),
  625        memberchk(referer=Base, Query)
  626    ->  true
  627    ;   option(referer(Base), Request)
  628    ), !,
  629    uri_normalized(Path, Base, URL).
  630openid_current_url(Request, URL) :-
  631    http_public_url(Request, URL).

openid_current_host(Request, Host, Port)

Find current location of the server.

deprecated: - New code should use http_current_host/4 with the option global(true).

  640openid_current_host(Request, Host, Port) :-
  641    http_current_host(Request, Host, Port,
  642                      [ global(true)
  643                      ]).

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.

  652redirect_browser(URL, FormExtra) :-
  653    uri_components(URL, C0),
  654    uri_data(search, C0, Search0),
  655    (   var(Search0)
  656    ->  uri_query_components(Search, FormExtra)
  657    ;   uri_query_components(Search0, Form0),
  658        append(FormExtra, Form0, Form),
  659        uri_query_components(Search, Form)
  660    ),
  661    uri_data(search, C0, Search, C),
  662    uri_components(Redirect, C),
  663    throw(http_reply(moved_temporary(Redirect))).
  664
  665
  666                 /*******************************
  667                 *             RESOLVE          *
  668                 *******************************/

openid_resolve(+URL, -OpenIDOrig, -OpenID, -Server, -ServerOptions)

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.

Arguments:

`URL`	- The `OpenID` typed by the user
`OpenIDOrig`	- Canonized `OpenID` typed by user
`OpenID`	- Possibly delegated `OpenID`
`Server`	- `OpenID` server that must validate `OpenID`
`ServerOptions`	- provides additional XRDS information about the server. Currently supports `xrds_types(Types)`.

To be done

- Implement complete URL canonization as defined by the OpenID 2.0 proposal.

  685openid_resolve(URL, OpenID, OpenID, Server, [xrds_types(Types)]) :-
  686    xrds_dom(URL, DOM),
  687    xpath(DOM, //(_:'Service'), Service),
  688    findall(Type, xpath(Service, _:'Type'(text), Type), Types),
  689    memberchk('http://specs.openid.net/auth/2.0/server', Types),
  690    xpath(Service, _:'URI'(text), Server),
  691    !,
  692    debug(openid(yadis), 'Yadis: server: ~q, types: ~q', [Server, Types]),
  693    (   xpath(Service, _:'LocalID'(text), OpenID)
  694    ->  true
  695    ;   openid_identifier_select_url(OpenID)
  696    ).
  697openid_resolve(URL, OpenID0, OpenID, Server, []) :-
  698    debug(openid(resolve), 'Opening ~w ...', [URL]),
  699    dtd(html, DTD),
  700    setup_call_cleanup(
  701        http_open(URL, Stream,
  702                  [ final_url(OpenID0),
  703                    cert_verify_hook(ssl_verify)
  704                  ]),
  705        load_structure(Stream, Term,
  706                       [ dtd(DTD),
  707                         dialect(sgml),
  708                         shorttag(false),
  709                         syntax_errors(quiet)
  710                       ]),
  711        close(Stream)),
  712    debug(openid(resolve), 'Scanning HTML document ...', []),
  713    contains_term(element(head, _, Head), Term),
  714    (   link(Head, 'openid.server', Server)
  715    ->  debug(openid(resolve), 'OpenID Server=~q', [Server])
  716    ;   debug(openid(resolve), 'No server in ~q', [Head]),
  717        fail
  718    ),
  719    (   link(Head, 'openid.delegate', OpenID)
  720    ->  debug(openid(resolve), 'OpenID = ~q (delegated)', [OpenID])
  721    ;   OpenID = OpenID0,
  722        debug(openid(resolve), 'OpenID = ~q', [OpenID])
  723    ).
  724
  725openid_identifier_select_url(
  726    'http://specs.openid.net/auth/2.0/identifier_select').
  727
  728:- public ssl_verify/5.

ssl_verify(+SSL, +ProblemCert, +AllCerts, +FirstCert, +Error): Accept all certificates. We do not care too much. Only the user cares s/he is not entering her credentials with a spoofed side. As we redirect, the browser will take care of this.

  736ssl_verify(_SSL,
  737           _ProblemCertificate, _AllCertificates, _FirstCertificate,
  738           _Error).
  739
  740
  741link(DOM, Type, Target) :-
  742    sub_term(element(link, Attrs, []), DOM),
  743    memberchk(rel=Type, Attrs),
  744    memberchk(href=Target, Attrs).
  745
  746
  747                 /*******************************
  748                 *         AUTHENTICATE         *
  749                 *******************************/

openid_authenticate(+Request): HTTP handler when redirected back from the OpenID provider.

  755openid_authenticate(Request) :-
  756    memberchk(accept(Accept), Request),
  757    Accept = [media(application/'xrds+xml',_,_,_)],
  758    !,
  759    http_link_to_id(openid_xrds, [], XRDSLocation),
  760    http_absolute_uri(XRDSLocation, XRDSServer),
  761    debug(openid(yadis), 'Sending XRDS server: ~q', [XRDSServer]),
  762    format('X-XRDS-Location: ~w\n', [XRDSServer]),
  763    format('Content-type: text/plain\n\n').
  764openid_authenticate(Request) :-
  765    openid_authenticate(Request, _OpenIdServer, OpenID, _ReturnTo),
  766    openid_server(User, OpenID, _, Target),
  767    openid_login(User),
  768    redirect_browser(Target, []).

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 told 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; - openid(signature_mismatch) if the HMAC signature check failed

  793openid_authenticate(Request, OpenIdServer, Identity, ReturnTo) :-
  794    memberchk(method(get), Request),
  795    http_parameters(Request,
  796                    [ 'openid.mode'(Mode, [optional(true)])
  797                    ]),
  798    (   var(Mode)
  799    ->  fail
  800    ;   Mode == cancel
  801    ->  throw(openid(cancel))
  802    ;   Mode == id_res
  803    ->  debug(openid(authenticate), 'Mode=id_res, validating response', []),
  804        http_parameters(Request,
  805                        [ 'openid.identity'(Identity, []),
  806                          'openid.assoc_handle'(Handle, []),
  807                          'openid.return_to'(ReturnTo, []),
  808                          'openid.signed'(AtomFields, []),
  809                          'openid.sig'(Base64Signature, []),
  810                          'openid.invalidate_handle'(Invalidate,
  811                                                     [optional(true)])
  812                        ],
  813                        [ form_data(Form)
  814                        ]),
  815        atomic_list_concat(SignedFields, ',', AtomFields),
  816        check_obligatory_fields(SignedFields),
  817        signed_pairs(SignedFields,
  818                     [ mode-Mode,
  819                       identity-Identity,
  820                       assoc_handle-Handle,
  821                       return_to-ReturnTo,
  822                       invalidate_handle-Invalidate
  823                     ],
  824                     Form,
  825                     SignedPairs),
  826        (   openid_associate(OpenIdServer, Handle, Assoc)
  827        ->  signature(SignedPairs, Assoc, Sig),
  828            atom_codes(Base64Signature, Base64SigCodes),
  829            phrase(base64(Signature), Base64SigCodes),
  830            (   Sig == Signature
  831            ->  true
  832            ;   throw(openid(signature_mismatch))
  833            )
  834        ;   check_authentication(Request, Form)
  835        ),
  836        ax_store(Form)
  837    ).

signed_pairs(+FieldNames, +Pairs:list(Field-Value), +Form, -SignedPairs) is det: Extract the signed field in the order they appear in FieldNames.

  844signed_pairs([], _, _, []).
  845signed_pairs([Field|T0], Pairs, Form, [Field-Value|T]) :-
  846    memberchk(Field-Value, Pairs),
  847    !,
  848    signed_pairs(T0, Pairs, Form, T).
  849signed_pairs([Field|T0], Pairs, Form, [Field-Value|T]) :-
  850    atom_concat('openid.', Field, OpenIdField),
  851    memberchk(OpenIdField=Value, Form),
  852    !,
  853    signed_pairs(T0, Pairs, Form, T).
  854signed_pairs([Field|T0], Pairs, Form, T) :-
  855    format(user_error, 'Form = ~p~n', [Form]),
  856    throw(error(existence_error(field, Field),
  857                context(_, 'OpenID Signed field is not present'))),
  858    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.

Errors: - existence_error(field, Field)

  868check_obligatory_fields(Fields) :-
  869    (   obligatory_field(Field),
  870        (   memberchk(Field, Fields)
  871        ->  true
  872        ;   throw(error(existence_error(field, Field),
  873                        context(_, 'OpenID field is not in signed fields')))
  874        ),
  875        fail
  876    ;   true
  877    ).
  878
  879obligatory_field(identity).

check_authentication(+Request, +Form) is semidet: Implement the stateless verification method. This seems needed for stackexchange.com, which provides the res_id with a new association handle.

  888check_authentication(_Request, Form) :-
  889    openid_server(_OpenIDLogin, _OpenID, Server),
  890    debug(openid(check_authentication),
  891          'Using stateless verification with ~q form~n~q', [Server, Form]),
  892    select('openid.mode' = _, Form, Form1),
  893    setup_call_cleanup(
  894        http_open(Server, In,
  895                  [ post(form([ 'openid.mode' = check_authentication
  896                              | Form1
  897                              ])),
  898                    cert_verify_hook(ssl_verify)
  899                  ]),
  900        read_stream_to_codes(In, Reply),
  901        close(In)),
  902    debug(openid(check_authentication),
  903          'Reply: ~n~s~n', [Reply]),
  904    key_values_data(Pairs, Reply),
  905    forall(member(invalidate_handle-Handle, Pairs),
  906           retractall(association(_, Handle, _))),
  907    memberchk(is_valid-true, Pairs).
  908
  909
  910                 /*******************************
  911                 *          AX HANDLING         *
  912                 *******************************/

ax_options(+ServerOptions, +Options, +AXAttrs) is det: True when AXAttrs is a list of additional attribute exchange options to add to the OpenID redirect request.

  919ax_options(ServerOptions, Options, AXAttrs) :-
  920    option(ax(Spec), Options),
  921    option(xrds_types(Types), ServerOptions),
  922    memberchk('http://openid.net/srv/ax/1.0', Types),
  923    !,
  924    http_ax_attributes(Spec, AXAttrs),
  925    debug(openid(ax), 'AX attributes: ~q', [AXAttrs]).
  926ax_options(_, _, []) :-
  927    debug(openid(ax), 'AX: not supported', []).

ax_store(+Form)

Extract reported AX data and store this into the session. If there is a non-empty list of exchanged values, this calls

openid_hook(ax(Values))

If this hook fails, Values are added to the session data using http_session_assert(ax(Values)).

  939ax_store(Form) :-
  940    debug(openid(ax), 'Form: ~q', [Form]),
  941    ax_form_attributes(Form, Values),
  942    debug(openid(ax), 'AX: ~q', [Values]),
  943    (   Values \== []
  944    ->  (   openid_hook(ax(Values))
  945        ->  true
  946        ;   http_session_assert(ax(Values))
  947        )
  948    ;   true
  949    ).
  950
  951
  952                 /*******************************
  953                 *         OPENID SERVER        *
  954                 *******************************/
  955
  956:- dynamic
  957    server_association/3.           % URL, Handle, Term

openid_server(+Options, +Request): Realise the OpenID server. The protocol demands a POST request here.

  964openid_server(Options, Request) :-
  965    http_parameters(Request,
  966                    [ 'openid.mode'(Mode)
  967                    ],
  968                    [ attribute_declarations(openid_attribute),
  969                      form_data(Form)
  970                    ]),
  971    (   Mode == associate
  972    ->  associate_server(Request, Form, Options)
  973    ;   Mode == checkid_setup
  974    ->  checkid_setup_server(Request, Form, Options)
  975    ).

associate_server(+Request, +Form, +Options): Handle the association-request. If successful, create a clause for server_association/3 to record the current association.

  982associate_server(Request, Form, Options) :-
  983    memberchk('openid.assoc_type'         = AssocType,   Form),
  984    memberchk('openid.session_type'       = SessionType, Form),
  985    memberchk('openid.dh_modulus'         = P64,         Form),
  986    memberchk('openid.dh_gen'             = G64,         Form),
  987    memberchk('openid.dh_consumer_public' = CPX64,       Form),
  988    base64_btwoc(P, P64),
  989    base64_btwoc(G, G64),
  990    base64_btwoc(CPX, CPX64),
  991    Y is 1+random(P-1),             % Our secret
  992    DiffieHellman is powm(CPX, Y, P),
  993    btwoc(DiffieHellman, DHBytes),
  994    signature_algorithm(SessionType, SHA_Algo),
  995    sha_hash(DHBytes, SHA1, [encoding(octet), algorithm(SHA_Algo)]),
  996    CPY is powm(G, Y, P),
  997    base64_btwoc(CPY, CPY64),
  998    mackey_bytes(SessionType, MacBytes),
  999    new_assoc_handle(MacBytes, Handle),
 1000    random_bytes(MacBytes, MacKey),
 1001    xor_codes(MacKey, SHA1, EncKey),
 1002    phrase(base64(EncKey), Base64EncKey),
 1003    DefExpriresIn is 24*3600,
 1004    option(expires_in(ExpriresIn), Options, DefExpriresIn),
 1005
 1006    get_time(Now),
 1007    ExpiresAt is integer(Now+ExpriresIn),
 1008    make_association([ session_type(SessionType),
 1009                       expires_at(ExpiresAt),
 1010                       mac_key(MacKey)
 1011                     ],
 1012                     Record),
 1013    memberchk(peer(Peer), Request),
 1014    assert(server_association(Peer, Handle, Record)),
 1015
 1016    key_values_data([ assoc_type-AssocType,
 1017                      assoc_handle-Handle,
 1018                      expires_in-ExpriresIn,
 1019                      session_type-SessionType,
 1020                      dh_server_public-CPY64,
 1021                      enc_mac_key-Base64EncKey
 1022                    ],
 1023                    Text),
 1024    format('Content-type: text/plain~n~n~s', [Text]).
 1025
 1026mackey_bytes('DH-SHA1',   20).
 1027mackey_bytes('DH-SHA256', 32).
 1028
 1029new_assoc_handle(Length, Handle) :-
 1030    random_bytes(Length, Bytes),
 1031    phrase(base64(Bytes), HandleCodes),
 1032    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:

Check some cookie and if present, grant immediately
Use a 401 challenge page
Present a normal grant/password page
As (3), but use HTTPS for the exchange
etc.

First thing to check is the immediate acknowledgement.

 1049checkid_setup_server(_Request, Form, _Options) :-
 1050    memberchk('openid.identity'       = Identity,  Form),
 1051    memberchk('openid.assoc_handle'   = Handle,    Form),
 1052    memberchk('openid.return_to'      = ReturnTo,  Form),
 1053    (   memberchk('openid.realm'      = Realm,     Form) -> true
 1054    ;   memberchk('openid.trust_root' = Realm, Form)
 1055    ),
 1056
 1057    server_association(_, Handle, _Association),            % check
 1058
 1059    reply_html_page(
 1060        [ title('OpenID login')
 1061        ],
 1062        [ \openid_title,
 1063          div(class('openid-message'),
 1064              ['Site ', a(href(TrustRoot), TrustRoot),
 1065               ' requests permission to login with OpenID ',
 1066               a(href(Identity), Identity), '.'
 1067              ]),
 1068          table(class('openid-form'),
 1069                [ tr(td(form([ action(grant), method('GET') ],
 1070                             [ \hidden('openid.grant', yes),
 1071                               \hidden('openid.identity', Identity),
 1072                               \hidden('openid.assoc_handle', Handle),
 1073                               \hidden('openid.return_to', ReturnTo),
 1074                               \hidden('openid.realm', Realm),
 1075                               \hidden('openid.trust_root', Realm),
 1076                               div(['Password: ',
 1077                                    input([ type(password),
 1078                                            name('openid.password')
 1079                                          ]),
 1080                                    input([ type(submit),
 1081                                            value('Grant')
 1082                                          ])
 1083                                   ])
 1084                             ]))),
 1085                  tr(td(align(right),
 1086                        form([ action(grant), method('GET') ],
 1087                             [ \hidden('openid.grant', no),
 1088                               \hidden('openid.return_to', ReturnTo),
 1089                               input([type(submit), value('Deny')])
 1090                             ])))
 1091                ])
 1092        ]).
 1093
 1094hidden(Name, Value) -->
 1095    html(input([type(hidden), id(return_to), name(Name), value(Value)])).
 1096
 1097
 1098openid_title -->
 1099    { http_absolute_location(icons('openid-logo-square.png'), SRC, []) },
 1100    html_requires(css('openid.css')),
 1101    html(div(class('openid-title'),
 1102             [ a(href('http://openid.net/'),
 1103                 img([ src(SRC), alt('OpenID') ])),
 1104               span('Login')
 1105             ])).

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.

 1115openid_grant(Request) :-
 1116    http_parameters(Request,
 1117                    [ 'openid.grant'(Grant),
 1118                      'openid.return_to'(ReturnTo)
 1119                    ],
 1120                    [ attribute_declarations(openid_attribute)
 1121                    ]),
 1122    (   Grant == yes
 1123    ->  http_parameters(Request,
 1124                        [ 'openid.identity'(Identity),
 1125                          'openid.assoc_handle'(Handle),
 1126                          'openid.trust_root'(TrustRoot),
 1127                          'openid.password'(Password)
 1128                        ],
 1129                        [ attribute_declarations(openid_attribute)
 1130                        ]),
 1131        server_association(_, Handle, Association),
 1132        grant_login(Request,
 1133                    [ identity(Identity),
 1134                      password(Password),
 1135                      trustroot(TrustRoot)
 1136                    ]),
 1137        SignedPairs = [ 'mode'-id_res,
 1138                        'identity'-Identity,
 1139                        'assoc_handle'-Handle,
 1140                        'return_to'-ReturnTo
 1141                      ],
 1142        signed_fields(SignedPairs, Signed),
 1143        signature(SignedPairs, Association, Signature),
 1144        phrase(base64(Signature), Bas64SigCodes),
 1145        string_codes(Bas64Sig, Bas64SigCodes),
 1146        redirect_browser(ReturnTo,
 1147                         [ 'openid.mode' = id_res,
 1148                           'openid.identity' = Identity,
 1149                           'openid.assoc_handle' = Handle,
 1150                           'openid.return_to' = ReturnTo,
 1151                           'openid.signed' = Signed,
 1152                           'openid.sig' = Bas64Sig
 1153                         ])
 1154    ;   redirect_browser(ReturnTo,
 1155                         [ 'openid.mode' = cancel
 1156                         ])
 1157    ).

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)

 1169grant_login(Request, Options) :-
 1170    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.

 1178trusted(OpenID, Server) :-
 1179    openid_hook(trusted(OpenID, Server)).

signed_fields(+Pairs, -Signed) is det: Create a comma-separated atom from the field-names without 'openid.' from Pairs.

 1187signed_fields(Pairs, Signed) :-
 1188    signed_field_names(Pairs, Names),
 1189    atomic_list_concat(Names, ',', Signed).
 1190
 1191signed_field_names([], []).
 1192signed_field_names([H0-_|T0], [H|T]) :-
 1193    (   atom_concat('openid.', H, H0)
 1194    ->  true
 1195    ;   H = H0
 1196    ),
 1197    signed_field_names(T0, T).

signature(+Pairs, +Association, -Signature): Determine the signature for Pairs

 1203signature(Pairs, Association, Signature) :-
 1204    key_values_data(Pairs, TokenContents),
 1205    association_mac_key(Association, MacKey),
 1206    association_session_type(Association, SessionType),
 1207    signature_algorithm(SessionType, SHA),
 1208    hmac_sha(MacKey, TokenContents, Signature, [algorithm(SHA)]),
 1209    debug(openid(crypt),
 1210          'Signed:~n~s~nSignature: ~w', [TokenContents, Signature]).
 1211
 1212signature_algorithm('DH-SHA1',   sha1).
 1213signature_algorithm('DH-SHA256', sha256).
 1214
 1215
 1216                 /*******************************
 1217                 *            ASSOCIATE         *
 1218                 *******************************/
 1219
 1220:- dynamic
 1221    association/3.                  % URL, Handle, Data
 1222
 1223:- record
 1224    association(session_type='DH-SHA1',
 1225                expires_at,         % time-stamp
 1226                mac_key).           % code-list

openid_associate(?URL, ?Handle, ?Assoc) is det

Calls openid_associate/4 as

openid_associate(URL, Handle, Assoc, []).

 1236openid_associate(URL, Handle, Assoc) :-
 1237    openid_associate(URL, Handle, Assoc, []).

openid_associate(+URL, -Handle, -Assoc, +Options) is det

openid_associate(?URL, +Handle, -Assoc, +Options) 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 establish one and remember it. Options:

ns(URL): One of http://specs.openid.net/auth/2.0 (default) or http://openid.net/signon/1.1.

To be done: - Should we store known associations permanently? Where?

 1252openid_associate(URL, Handle, Assoc, _Options) :-
 1253    nonvar(Handle),
 1254    !,
 1255    debug(openid(associate),
 1256          'OpenID: Lookup association with handle ~q', [Handle]),
 1257    (   association(URL, Handle, Assoc)
 1258    ->  true
 1259    ;   debug(openid(associate),
 1260              'OpenID: no association with handle ~q', [Handle]),
 1261        fail
 1262    ).
 1263openid_associate(URL, Handle, Assoc, _Options) :-
 1264    must_be(atom, URL),
 1265    association(URL, Handle, Assoc),
 1266    association_expires_at(Assoc, Expires),
 1267    get_time(Now),
 1268    (   Now < Expires
 1269    ->  !,
 1270        debug(openid(associate),
 1271              'OpenID: Reusing association with ~q', [URL])
 1272    ;   retractall(association(URL, Handle, _)),
 1273        fail
 1274    ).
 1275openid_associate(URL, Handle, Assoc, Options) :-
 1276    associate_data(Data, P, _G, X, Options),
 1277    debug(openid(associate), 'OpenID: Associating with ~q', [URL]),
 1278    setup_call_cleanup(
 1279        http_open(URL, In,
 1280                  [ post(form(Data)),
 1281                    cert_verify_hook(ssl_verify)
 1282                  ]),
 1283        read_stream_to_codes(In, Reply),
 1284        close(In)),
 1285    debug(openid(associate), 'Reply: ~n~s', [Reply]),
 1286    key_values_data(Pairs, Reply),
 1287    shared_secret(Pairs, P, X, MacKey),
 1288    expires_at(Pairs, ExpiresAt),
 1289    memberchk(assoc_handle-Handle, Pairs),
 1290    memberchk(session_type-Type, Pairs),
 1291    make_association([ session_type(Type),
 1292                       expires_at(ExpiresAt),
 1293                       mac_key(MacKey)
 1294                     ], Assoc),
 1295    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.

 1303shared_secret(Pairs, _, _, Secret) :-
 1304    memberchk(mac_key-Base64, Pairs),
 1305    !,
 1306    atom_codes(Base64, Base64Codes),
 1307    phrase(base64(Base64Codes), Secret).
 1308shared_secret(Pairs, P, X, Secret) :-
 1309    memberchk(dh_server_public-Base64Public, Pairs),
 1310    memberchk(enc_mac_key-Base64EncMacKey, Pairs),
 1311    memberchk(session_type-SessionType, Pairs),
 1312    base64_btwoc(ServerPublic, Base64Public),
 1313    DiffieHellman is powm(ServerPublic, X, P),
 1314    atom_codes(Base64EncMacKey, Base64EncMacKeyCodes),
 1315    phrase(base64(EncMacKey), Base64EncMacKeyCodes),
 1316    btwoc(DiffieHellman, DiffieHellmanBytes),
 1317    signature_algorithm(SessionType, SHA_Algo),
 1318    sha_hash(DiffieHellmanBytes, DHHash,
 1319             [encoding(octet), algorithm(SHA_Algo)]),
 1320    xor_codes(DHHash, EncMacKey, Secret).

expires_at(+Pairs, -Time) is det: Unify Time with a time-stamp stating when the association exires.

 1328expires_at(Pairs, Time) :-
 1329    memberchk(expires_in-ExpAtom, Pairs),
 1330    atom_number(ExpAtom, Seconds),
 1331    get_time(Now),
 1332    Time is integer(Now)+Seconds.

associate_data(-Data, -P, -G, -X, +Options) is det: Generate the data to initiate an association using Diffie-Hellman shared secret key negotiation.

 1340associate_data(Data, P, G, X, Options) :-
 1341    openid_dh_p(P),
 1342    openid_dh_g(G),
 1343    X is 1+random(P-1),                     % 1<=X<P-1
 1344    CP is powm(G, X, P),
 1345    base64_btwoc(P, P64),
 1346    base64_btwoc(G, G64),
 1347    base64_btwoc(CP, CP64),
 1348    option(ns(NS), Options, 'http://specs.openid.net/auth/2.0'),
 1349    (   assoc_type(NS, DefAssocType, DefSessionType)
 1350    ->  true
 1351    ;   domain_error('openid.ns', NS)
 1352    ),
 1353    option(assoc_type(AssocType), Options, DefAssocType),
 1354    option(assoc_type(SessionType), Options, DefSessionType),
 1355    Data = [ 'openid.ns'                 = NS,
 1356             'openid.mode'               = associate,
 1357             'openid.assoc_type'         = AssocType,
 1358             'openid.session_type'       = SessionType,
 1359             'openid.dh_modulus'         = P64,
 1360             'openid.dh_gen'             = G64,
 1361             'openid.dh_consumer_public' = CP64
 1362           ].
 1363
 1364assoc_type('http://specs.openid.net/auth/2.0',
 1365           'HMAC-SHA256',
 1366           'DH-SHA256').
 1367assoc_type('http://openid.net/signon/1.1',
 1368           'HMAC-SHA1',
 1369           'DH-SHA1').
 1370
 1371
 1372                 /*******************************
 1373                 *            RANDOM            *
 1374                 *******************************/

random_bytes(+N, -Bytes) is det: Bytes is a list of N random bytes (integers 0..255).

 1380random_bytes(N, [H|T]) :-
 1381    N > 0,
 1382    !,
 1383    H is random(256),
 1384    N2 is N - 1,
 1385    random_bytes(N2, T).
 1386random_bytes(_, []).
 1387
 1388
 1389                 /*******************************
 1390                 *           CONSTANTS          *
 1391                 *******************************/
 1392
 1393openid_dh_p(155172898181473697471232257763715539915724801966915404479707795314057629378541917580651227423698188993727816152646631438561595825688188889951272158842675419950341258706556549803580104870537681476726513255747040765857479291291572334510643245094715007229621094194349783925984760375594985848253359305585439638443).
 1394
 1395openid_dh_g(2).
 1396
 1397
 1398                 /*******************************
 1399                 *             UTIL             *
 1400                 *******************************/

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.

 1409key_values_data(Pairs, Data) :-
 1410    nonvar(Data),
 1411    !,
 1412    phrase(data_form(Pairs), Data).
 1413key_values_data(Pairs, Data) :-
 1414    phrase(gen_data_form(Pairs), Data).
 1415
 1416data_form([Key-Value|Pairs]) -->
 1417    utf8_string(KeyCodes), ":", utf8_string(ValueCodes), "\n",
 1418    !,
 1419    { atom_codes(Key, KeyCodes),
 1420      atom_codes(Value, ValueCodes)
 1421    },
 1422    data_form(Pairs).
 1423data_form([]) -->
 1424    ws.

utf8_string(-Codes)// is nondet: Take a short UTF-8 code-list from input. Extend on backtracking.

 1430utf8_string([]) -->
 1431    [].
 1432utf8_string([H|T]) -->
 1433    utf8_codes([H]),
 1434    utf8_string(T).
 1435
 1436ws -->
 1437    [C],
 1438    { C =< 32 },
 1439    !,
 1440    ws.
 1441ws -->
 1442    [].
 1443
 1444
 1445gen_data_form([]) -->
 1446    [].
 1447gen_data_form([Key-Value|T]) -->
 1448    field(Key), ":", field(Value), "\n",
 1449    gen_data_form(T).
 1450
 1451field(Field) -->
 1452    { to_codes(Field, Codes)
 1453    },
 1454    utf8_codes(Codes).
 1455
 1456to_codes(Codes, Codes) :-
 1457    is_list(Codes),
 1458    !.
 1459to_codes(Atomic, Codes) :-
 1460    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

 1466base64_btwoc(Int, Base64) :-
 1467    integer(Int),
 1468    !,
 1469    btwoc(Int, Bytes),
 1470    phrase(base64(Bytes), Base64).
 1471base64_btwoc(Int, Base64) :-
 1472    atom(Base64),
 1473    !,
 1474    atom_codes(Base64, Codes),
 1475    phrase(base64(Bytes), Codes),
 1476    btwoc(Int, Bytes).
 1477base64_btwoc(Int, Base64) :-
 1478    phrase(base64(Bytes), Base64),
 1479    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.

 1488btwoc(Int, Bytes) :-
 1489    integer(Int),
 1490    !,
 1491    int_to_bytes(Int, Bytes).
 1492btwoc(Int, Bytes) :-
 1493    is_list(Bytes),
 1494    bytes_to_int(Bytes, Int).
 1495
 1496int_to_bytes(Int, Bytes) :-
 1497    int_to_bytes(Int, [], Bytes).
 1498
 1499int_to_bytes(Int, Bytes0, [Int|Bytes0]) :-
 1500    Int < 128,
 1501    !.
 1502int_to_bytes(Int, Bytes0, Bytes) :-
 1503    Last is Int /\ 0xff,
 1504    Int1 is Int >> 8,
 1505    int_to_bytes(Int1, [Last|Bytes0], Bytes).
 1506
 1507
 1508bytes_to_int([B|T], Int) :-
 1509    bytes_to_int(T, B, Int).
 1510
 1511bytes_to_int([], Int, Int).
 1512bytes_to_int([B|T], Int0, Int) :-
 1513    Int1 is (Int0<<8)+B,
 1514    bytes_to_int(T, Int1, Int).

xor_codes(+C1:list(int), +C2:list(int), -XOR:list(int)) is det

Compute xor of two strings.

Errors: - length_mismatch(L1, L2) if the two lists do not have equal length.

 1524xor_codes([], [], []) :- !.
 1525xor_codes([H1|T1], [H2|T2], [H|T]) :-
 1526    !,
 1527    H is H1 xor H2,
 1528    !,
 1529    xor_codes(T1, T2, T).
 1530xor_codes(L1, L2, _) :-
 1531    throw(error(length_mismatch(L1, L2), _)).
 1532
 1533
 1534                 /*******************************
 1535                 *        HTTP ATTRIBUTES       *
 1536                 *******************************/
 1537
 1538openid_attribute('openid.mode',
 1539                 [ oneof([ associate,
 1540                           checkid_setup,
 1541                           cancel,
 1542                           id_res
 1543                         ])
 1544                 ]).
 1545openid_attribute('openid.assoc_type',
 1546                 [ oneof(['HMAC-SHA1'])
 1547                 ]).
 1548openid_attribute('openid.session_type',
 1549                 [ oneof([ 'DH-SHA1',
 1550                           'DH-SHA256'
 1551                         ])
 1552                 ]).
 1553openid_attribute('openid.dh_modulus',         [length > 1]).
 1554openid_attribute('openid.dh_gen',             [length > 1]).
 1555openid_attribute('openid.dh_consumer_public', [length > 1]).
 1556openid_attribute('openid.assoc_handle',       [length > 1]).
 1557openid_attribute('openid.return_to',          [length > 1]).
 1558openid_attribute('openid.trust_root',         [length > 1]).
 1559openid_attribute('openid.identity',           [length > 1]).
 1560openid_attribute('openid.password',           [length > 1]).
 1561openid_attribute('openid.grant',              [oneof([yes,no])])