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).

  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.

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:

  1. Show a page for login (default: page /openid/login), predicate reply_openid_login/1)
  2. By default, the OpenID login page is a form that is submitted to the verify, which calls openid_verify/2.
  3. 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
  4. The OpenID server will redirect here with the authetication 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 seperate 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(Session)
  550    ->  debug(openid(verify), 'Assert ~p in ~p', [Term, Session])
  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(Session),
  569    (   http_session_data(openid_login(OpenIDLogin, OpenID, Server, Target))
  570    ->  true
  571    ;   http_session_data(openid_login(OpenIDLogin1, OpenID1, Server1, Target1)),
  572        debug(openid(verify), '~p \\== ~p',
  573              [ openid_login(OpenIDLogin, OpenID, Server, Target),
  574                openid_login(OpenIDLogin1, OpenID1, Server1, Target1)
  575              ]),
  576        fail
  577    ;   debug(openid(verify), 'No openid_login/4 term in session ~p', [Session]),
  578        fail
  579    ).
 public_url(+Request, +Path, -URL) is det
True when URL is a publically useable URL that leads to Path on the current server.
  587public_url(Request, Path, URL) :-
  588    openid_current_host(Request, Host, Port),
  589    setting(http:public_scheme, Scheme),
  590    set_port(Scheme, Port, AuthC),
  591    uri_authority_data(host, AuthC, Host),
  592    uri_authority_components(Auth, AuthC),
  593    uri_data(scheme, Components, Scheme),
  594    uri_data(authority, Components, Auth),
  595    uri_data(path, Components, Path),
  596    uri_components(URL, Components).
  597
  598set_port(Scheme, Port, _) :-
  599    scheme_port(Scheme, Port),
  600    !.
  601set_port(_, Port, AuthC) :-
  602    uri_authority_data(port, AuthC, Port).
  603
  604scheme_port(http, 80).
  605scheme_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 wether the login message contains a referer parameter or wether the browser provided one.
  616openid_current_url(Request, URL) :-
  617    option(request_uri(URI), Request),
  618    uri_components(URI, Components),
  619    uri_data(path, Components, Path),
  620    (   uri_data(search, Components, QueryString),
  621        nonvar(QueryString),
  622        uri_query_components(QueryString, Query),
  623        memberchk(referer=Base, Query)
  624    ->  true
  625    ;   option(referer(Base), Request)
  626    ), !,
  627    uri_normalized(Path, Base, URL).
  628openid_current_url(Request, URL) :-
  629    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).
  638openid_current_host(Request, Host, Port) :-
  639    http_current_host(Request, Host, Port,
  640                      [ global(true)
  641                      ]).
 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.
  650redirect_browser(URL, FormExtra) :-
  651    uri_components(URL, C0),
  652    uri_data(search, C0, Search0),
  653    (   var(Search0)
  654    ->  uri_query_components(Search, FormExtra)
  655    ;   uri_query_components(Search0, Form0),
  656        append(FormExtra, Form0, Form),
  657        uri_query_components(Search, Form)
  658    ),
  659    uri_data(search, C0, Search, C),
  660    uri_components(Redirect, C),
  661    throw(http_reply(moved_temporary(Redirect))).
  662
  663
  664                 /*******************************
  665                 *             RESOLVE          *
  666                 *******************************/
 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.
  683openid_resolve(URL, OpenID, OpenID, Server, [xrds_types(Types)]) :-
  684    xrds_dom(URL, DOM),
  685    xpath(DOM, //(_:'Service'), Service),
  686    findall(Type, xpath(Service, _:'Type'(text), Type), Types),
  687    memberchk('http://specs.openid.net/auth/2.0/server', Types),
  688    xpath(Service, _:'URI'(text), Server),
  689    !,
  690    debug(openid(yadis), 'Yadis: server: ~q, types: ~q', [Server, Types]),
  691    (   xpath(Service, _:'LocalID'(text), OpenID)
  692    ->  true
  693    ;   openid_identifier_select_url(OpenID)
  694    ).
  695openid_resolve(URL, OpenID0, OpenID, Server, []) :-
  696    debug(openid(resolve), 'Opening ~w ...', [URL]),
  697    dtd(html, DTD),
  698    setup_call_cleanup(
  699        http_open(URL, Stream,
  700                  [ final_url(OpenID0),
  701                    cert_verify_hook(ssl_verify)
  702                  ]),
  703        load_structure(Stream, Term,
  704                       [ dtd(DTD),
  705                         dialect(sgml),
  706                         shorttag(false),
  707                         syntax_errors(quiet)
  708                       ]),
  709        close(Stream)),
  710    debug(openid(resolve), 'Scanning HTML document ...', []),
  711    contains_term(element(head, _, Head), Term),
  712    (   link(Head, 'openid.server', Server)
  713    ->  debug(openid(resolve), 'OpenID Server=~q', [Server])
  714    ;   debug(openid(resolve), 'No server in ~q', [Head]),
  715        fail
  716    ),
  717    (   link(Head, 'openid.delegate', OpenID)
  718    ->  debug(openid(resolve), 'OpenID = ~q (delegated)', [OpenID])
  719    ;   OpenID = OpenID0,
  720        debug(openid(resolve), 'OpenID = ~q', [OpenID])
  721    ).
  722
  723openid_identifier_select_url(
  724    'http://specs.openid.net/auth/2.0/identifier_select').
  725
  726:- 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.
  734ssl_verify(_SSL,
  735           _ProblemCertificate, _AllCertificates, _FirstCertificate,
  736           _Error).
  737
  738
  739link(DOM, Type, Target) :-
  740    sub_term(element(link, Attrs, []), DOM),
  741    memberchk(rel=Type, Attrs),
  742    memberchk(href=Target, Attrs).
  743
  744
  745                 /*******************************
  746                 *         AUTHENTICATE         *
  747                 *******************************/
 openid_authenticate(+Request)
HTTP handler when redirected back from the OpenID provider.
  753openid_authenticate(Request) :-
  754    memberchk(accept(Accept), Request),
  755    Accept = [media(application/'xrds+xml',_,_,_)],
  756    !,
  757    http_link_to_id(openid_xrds, [], XRDSLocation),
  758    http_absolute_uri(XRDSLocation, XRDSServer),
  759    debug(openid(yadis), 'Sending XRDS server: ~q', [XRDSServer]),
  760    format('X-XRDS-Location: ~w\n', [XRDSServer]),
  761    format('Content-type: text/plain\n\n').
  762openid_authenticate(Request) :-
  763    openid_authenticate(Request, _OpenIdServer, OpenID, _ReturnTo),
  764    openid_server(User, OpenID, _, Target),
  765    openid_login(User),
  766    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
  791openid_authenticate(Request, OpenIdServer, Identity, ReturnTo) :-
  792    memberchk(method(get), Request),
  793    http_parameters(Request,
  794                    [ 'openid.mode'(Mode, [optional(true)])
  795                    ]),
  796    (   var(Mode)
  797    ->  fail
  798    ;   Mode == cancel
  799    ->  throw(openid(cancel))
  800    ;   Mode == id_res
  801    ->  debug(openid(authenticate), 'Mode=id_res, validating response', []),
  802        http_parameters(Request,
  803                        [ 'openid.identity'(Identity, []),
  804                          'openid.assoc_handle'(Handle, []),
  805                          'openid.return_to'(ReturnTo, []),
  806                          'openid.signed'(AtomFields, []),
  807                          'openid.sig'(Base64Signature, []),
  808                          'openid.invalidate_handle'(Invalidate,
  809                                                     [optional(true)])
  810                        ],
  811                        [ form_data(Form)
  812                        ]),
  813        atomic_list_concat(SignedFields, ',', AtomFields),
  814        check_obligatory_fields(SignedFields),
  815        signed_pairs(SignedFields,
  816                     [ mode-Mode,
  817                       identity-Identity,
  818                       assoc_handle-Handle,
  819                       return_to-ReturnTo,
  820                       invalidate_handle-Invalidate
  821                     ],
  822                     Form,
  823                     SignedPairs),
  824        (   openid_associate(OpenIdServer, Handle, Assoc)
  825        ->  signature(SignedPairs, Assoc, Sig),
  826            atom_codes(Base64Signature, Base64SigCodes),
  827            phrase(base64(Signature), Base64SigCodes),
  828            (   Sig == Signature
  829            ->  true
  830            ;   throw(openid(signature_mismatch))
  831            )
  832        ;   check_authentication(Request, Form)
  833        ),
  834        ax_store(Form)
  835    ).
 signed_pairs(+FieldNames, +Pairs:list(Field-Value), +Form, -SignedPairs) is det
Extract the signed field in the order they appear in FieldNames.
  842signed_pairs([], _, _, []).
  843signed_pairs([Field|T0], Pairs, Form, [Field-Value|T]) :-
  844    memberchk(Field-Value, Pairs),
  845    !,
  846    signed_pairs(T0, Pairs, Form, T).
  847signed_pairs([Field|T0], Pairs, Form, [Field-Value|T]) :-
  848    atom_concat('openid.', Field, OpenIdField),
  849    memberchk(OpenIdField=Value, Form),
  850    !,
  851    signed_pairs(T0, Pairs, Form, T).
  852signed_pairs([Field|T0], Pairs, Form, T) :-
  853    format(user_error, 'Form = ~p~n', [Form]),
  854    throw(error(existence_error(field, Field),
  855                context(_, 'OpenID Signed field is not present'))),
  856    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)
  866check_obligatory_fields(Fields) :-
  867    (   obligatory_field(Field),
  868        (   memberchk(Field, Fields)
  869        ->  true
  870        ;   throw(error(existence_error(field, Field),
  871                        context(_, 'OpenID field is not in signed fields')))
  872        ),
  873        fail
  874    ;   true
  875    ).
  876
  877obligatory_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.
  886check_authentication(_Request, Form) :-
  887    openid_server(_OpenIDLogin, _OpenID, Server),
  888    debug(openid(check_authentication),
  889          'Using stateless verification with ~q form~n~q', [Server, Form]),
  890    select('openid.mode' = _, Form, Form1),
  891    setup_call_cleanup(
  892        http_open(Server, In,
  893                  [ post(form([ 'openid.mode' = check_authentication
  894                              | Form1
  895                              ])),
  896                    cert_verify_hook(ssl_verify)
  897                  ]),
  898        read_stream_to_codes(In, Reply),
  899        close(In)),
  900    debug(openid(check_authentication),
  901          'Reply: ~n~s~n', [Reply]),
  902    key_values_data(Pairs, Reply),
  903    forall(member(invalidate_handle-Handle, Pairs),
  904           retractall(association(_, Handle, _))),
  905    memberchk(is_valid-true, Pairs).
  906
  907
  908                 /*******************************
  909                 *          AX HANDLING         *
  910                 *******************************/
 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.
  917ax_options(ServerOptions, Options, AXAttrs) :-
  918    option(ax(Spec), Options),
  919    option(xrds_types(Types), ServerOptions),
  920    memberchk('http://openid.net/srv/ax/1.0', Types),
  921    !,
  922    http_ax_attributes(Spec, AXAttrs),
  923    debug(openid(ax), 'AX attributes: ~q', [AXAttrs]).
  924ax_options(_, _, []) :-
  925    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)).

  937ax_store(Form) :-
  938    debug(openid(ax), 'Form: ~q', [Form]),
  939    ax_form_attributes(Form, Values),
  940    debug(openid(ax), 'AX: ~q', [Values]),
  941    (   Values \== []
  942    ->  (   openid_hook(ax(Values))
  943        ->  true
  944        ;   http_session_assert(ax(Values))
  945        )
  946    ;   true
  947    ).
  948
  949
  950                 /*******************************
  951                 *         OPENID SERVER        *
  952                 *******************************/
  953
  954:- dynamic
  955    server_association/3.           % URL, Handle, Term
 openid_server(+Options, +Request)
Realise the OpenID server. The protocol demands a POST request here.
  962openid_server(Options, Request) :-
  963    http_parameters(Request,
  964                    [ 'openid.mode'(Mode)
  965                    ],
  966                    [ attribute_declarations(openid_attribute),
  967                      form_data(Form)
  968                    ]),
  969    (   Mode == associate
  970    ->  associate_server(Request, Form, Options)
  971    ;   Mode == checkid_setup
  972    ->  checkid_setup_server(Request, Form, Options)
  973    ).
 associate_server(+Request, +Form, +Options)
Handle the association-request. If successful, create a clause for server_association/3 to record the current association.
  980associate_server(Request, Form, Options) :-
  981    memberchk('openid.assoc_type'         = AssocType,   Form),
  982    memberchk('openid.session_type'       = SessionType, Form),
  983    memberchk('openid.dh_modulus'         = P64,         Form),
  984    memberchk('openid.dh_gen'             = G64,         Form),
  985    memberchk('openid.dh_consumer_public' = CPX64,       Form),
  986    base64_btwoc(P, P64),
  987    base64_btwoc(G, G64),
  988    base64_btwoc(CPX, CPX64),
  989    Y is 1+random(P-1),             % Our secret
  990    DiffieHellman is powm(CPX, Y, P),
  991    btwoc(DiffieHellman, DHBytes),
  992    signature_algorithm(SessionType, SHA_Algo),
  993    sha_hash(DHBytes, SHA1, [encoding(octet), algorithm(SHA_Algo)]),
  994    CPY is powm(G, Y, P),
  995    base64_btwoc(CPY, CPY64),
  996    mackey_bytes(SessionType, MacBytes),
  997    new_assoc_handle(MacBytes, Handle),
  998    random_bytes(MacBytes, MacKey),
  999    xor_codes(MacKey, SHA1, EncKey),
 1000    phrase(base64(EncKey), Base64EncKey),
 1001    DefExpriresIn is 24*3600,
 1002    option(expires_in(ExpriresIn), Options, DefExpriresIn),
 1003
 1004    get_time(Now),
 1005    ExpiresAt is integer(Now+ExpriresIn),
 1006    make_association([ session_type(SessionType),
 1007                       expires_at(ExpiresAt),
 1008                       mac_key(MacKey)
 1009                     ],
 1010                     Record),
 1011    memberchk(peer(Peer), Request),
 1012    assert(server_association(Peer, Handle, Record)),
 1013
 1014    key_values_data([ assoc_type-AssocType,
 1015                      assoc_handle-Handle,
 1016                      expires_in-ExpriresIn,
 1017                      session_type-SessionType,
 1018                      dh_server_public-CPY64,
 1019                      enc_mac_key-Base64EncKey
 1020                    ],
 1021                    Text),
 1022    format('Content-type: text/plain~n~n~s', [Text]).
 1023
 1024mackey_bytes('DH-SHA1',   20).
 1025mackey_bytes('DH-SHA256', 32).
 1026
 1027new_assoc_handle(Length, Handle) :-
 1028    random_bytes(Length, Bytes),
 1029    phrase(base64(Bytes), HandleCodes),
 1030    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.

 1047checkid_setup_server(_Request, Form, _Options) :-
 1048    memberchk('openid.identity'       = Identity,  Form),
 1049    memberchk('openid.assoc_handle'   = Handle,    Form),
 1050    memberchk('openid.return_to'      = ReturnTo,  Form),
 1051    (   memberchk('openid.realm'      = Realm,     Form) -> true
 1052    ;   memberchk('openid.trust_root' = Realm, Form)
 1053    ),
 1054
 1055    server_association(_, Handle, _Association),            % check
 1056
 1057    reply_html_page(
 1058        [ title('OpenID login')
 1059        ],
 1060        [ \openid_title,
 1061          div(class('openid-message'),
 1062              ['Site ', a(href(TrustRoot), TrustRoot),
 1063               ' requests permission to login with OpenID ',
 1064               a(href(Identity), Identity), '.'
 1065              ]),
 1066          table(class('openid-form'),
 1067                [ tr(td(form([ action(grant), method('GET') ],
 1068                             [ \hidden('openid.grant', yes),
 1069                               \hidden('openid.identity', Identity),
 1070                               \hidden('openid.assoc_handle', Handle),
 1071                               \hidden('openid.return_to', ReturnTo),
 1072                               \hidden('openid.realm', Realm),
 1073                               \hidden('openid.trust_root', Realm),
 1074                               div(['Password: ',
 1075                                    input([ type(password),
 1076                                            name('openid.password')
 1077                                          ]),
 1078                                    input([ type(submit),
 1079                                            value('Grant')
 1080                                          ])
 1081                                   ])
 1082                             ]))),
 1083                  tr(td(align(right),
 1084                        form([ action(grant), method('GET') ],
 1085                             [ \hidden('openid.grant', no),
 1086                               \hidden('openid.return_to', ReturnTo),
 1087                               input([type(submit), value('Deny')])
 1088                             ])))
 1089                ])
 1090        ]).
 1091
 1092hidden(Name, Value) -->
 1093    html(input([type(hidden), id(return_to), name(Name), value(Value)])).
 1094
 1095
 1096openid_title -->
 1097    { http_absolute_location(icons('openid-logo-square.png'), SRC, []) },
 1098    html_requires(css('openid.css')),
 1099    html(div(class('openid-title'),
 1100             [ a(href('http://openid.net/'),
 1101                 img([ src(SRC), alt('OpenID') ])),
 1102               span('Login')
 1103             ])).
 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.
 1113openid_grant(Request) :-
 1114    http_parameters(Request,
 1115                    [ 'openid.grant'(Grant),
 1116                      'openid.return_to'(ReturnTo)
 1117                    ],
 1118                    [ attribute_declarations(openid_attribute)
 1119                    ]),
 1120    (   Grant == yes
 1121    ->  http_parameters(Request,
 1122                        [ 'openid.identity'(Identity),
 1123                          'openid.assoc_handle'(Handle),
 1124                          'openid.trust_root'(TrustRoot),
 1125                          'openid.password'(Password)
 1126                        ],
 1127                        [ attribute_declarations(openid_attribute)
 1128                        ]),
 1129        server_association(_, Handle, Association),
 1130        grant_login(Request,
 1131                    [ identity(Identity),
 1132                      password(Password),
 1133                      trustroot(TrustRoot)
 1134                    ]),
 1135        SignedPairs = [ 'mode'-id_res,
 1136                        'identity'-Identity,
 1137                        'assoc_handle'-Handle,
 1138                        'return_to'-ReturnTo
 1139                      ],
 1140        signed_fields(SignedPairs, Signed),
 1141        signature(SignedPairs, Association, Signature),
 1142        phrase(base64(Signature), Bas64SigCodes),
 1143        string_codes(Bas64Sig, Bas64SigCodes),
 1144        redirect_browser(ReturnTo,
 1145                         [ 'openid.mode' = id_res,
 1146                           'openid.identity' = Identity,
 1147                           'openid.assoc_handle' = Handle,
 1148                           'openid.return_to' = ReturnTo,
 1149                           'openid.signed' = Signed,
 1150                           'openid.sig' = Bas64Sig
 1151                         ])
 1152    ;   redirect_browser(ReturnTo,
 1153                         [ 'openid.mode' = cancel
 1154                         ])
 1155    ).
 grant_login(+Request, +Options) is det
Validate login from Request (can be used to get cookies) and Options, which contains at least:
 1167grant_login(Request, Options) :-
 1168    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.
 1176trusted(OpenID, Server) :-
 1177    openid_hook(trusted(OpenID, Server)).
 signed_fields(+Pairs, -Signed) is det
Create a comma-separated atom from the field-names without 'openid.' from Pairs.
 1185signed_fields(Pairs, Signed) :-
 1186    signed_field_names(Pairs, Names),
 1187    atomic_list_concat(Names, ',', Signed).
 1188
 1189signed_field_names([], []).
 1190signed_field_names([H0-_|T0], [H|T]) :-
 1191    (   atom_concat('openid.', H, H0)
 1192    ->  true
 1193    ;   H = H0
 1194    ),
 1195    signed_field_names(T0, T).
 signature(+Pairs, +Association, -Signature)
Determine the signature for Pairs
 1201signature(Pairs, Association, Signature) :-
 1202    key_values_data(Pairs, TokenContents),
 1203    association_mac_key(Association, MacKey),
 1204    association_session_type(Association, SessionType),
 1205    signature_algorithm(SessionType, SHA),
 1206    hmac_sha(MacKey, TokenContents, Signature, [algorithm(SHA)]),
 1207    debug(openid(crypt),
 1208          'Signed:~n~s~nSignature: ~w', [TokenContents, Signature]).
 1209
 1210signature_algorithm('DH-SHA1',   sha1).
 1211signature_algorithm('DH-SHA256', sha256).
 1212
 1213
 1214                 /*******************************
 1215                 *            ASSOCIATE         *
 1216                 *******************************/
 1217
 1218:- dynamic
 1219    association/3.                  % URL, Handle, Data
 1220
 1221:- record
 1222    association(session_type='DH-SHA1',
 1223                expires_at,         % time-stamp
 1224                mac_key).           % code-list
 openid_associate(?URL, ?Handle, ?Assoc) is det
Calls openid_associate/4 as
openid_associate(URL, Handle, Assoc, []).
 1234openid_associate(URL, Handle, Assoc) :-
 1235    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 esstablish 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?
 1250openid_associate(URL, Handle, Assoc, _Options) :-
 1251    nonvar(Handle),
 1252    !,
 1253    debug(openid(associate),
 1254          'OpenID: Lookup association with handle ~q', [Handle]),
 1255    (   association(URL, Handle, Assoc)
 1256    ->  true
 1257    ;   debug(openid(associate),
 1258              'OpenID: no association with handle ~q', [Handle]),
 1259        fail
 1260    ).
 1261openid_associate(URL, Handle, Assoc, _Options) :-
 1262    must_be(atom, URL),
 1263    association(URL, Handle, Assoc),
 1264    association_expires_at(Assoc, Expires),
 1265    get_time(Now),
 1266    (   Now < Expires
 1267    ->  !,
 1268        debug(openid(associate),
 1269              'OpenID: Reusing association with ~q', [URL])
 1270    ;   retractall(association(URL, Handle, _)),
 1271        fail
 1272    ).
 1273openid_associate(URL, Handle, Assoc, Options) :-
 1274    associate_data(Data, P, _G, X, Options),
 1275    debug(openid(associate), 'OpenID: Associating with ~q', [URL]),
 1276    setup_call_cleanup(
 1277        http_open(URL, In,
 1278                  [ post(form(Data)),
 1279                    cert_verify_hook(ssl_verify)
 1280                  ]),
 1281        read_stream_to_codes(In, Reply),
 1282        close(In)),
 1283    debug(openid(associate), 'Reply: ~n~s', [Reply]),
 1284    key_values_data(Pairs, Reply),
 1285    shared_secret(Pairs, P, X, MacKey),
 1286    expires_at(Pairs, ExpiresAt),
 1287    memberchk(assoc_handle-Handle, Pairs),
 1288    memberchk(session_type-Type, Pairs),
 1289    make_association([ session_type(Type),
 1290                       expires_at(ExpiresAt),
 1291                       mac_key(MacKey)
 1292                     ], Assoc),
 1293    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.
 1301shared_secret(Pairs, _, _, Secret) :-
 1302    memberchk(mac_key-Base64, Pairs),
 1303    !,
 1304    atom_codes(Base64, Base64Codes),
 1305    phrase(base64(Base64Codes), Secret).
 1306shared_secret(Pairs, P, X, Secret) :-
 1307    memberchk(dh_server_public-Base64Public, Pairs),
 1308    memberchk(enc_mac_key-Base64EncMacKey, Pairs),
 1309    memberchk(session_type-SessionType, Pairs),
 1310    base64_btwoc(ServerPublic, Base64Public),
 1311    DiffieHellman is powm(ServerPublic, X, P),
 1312    atom_codes(Base64EncMacKey, Base64EncMacKeyCodes),
 1313    phrase(base64(EncMacKey), Base64EncMacKeyCodes),
 1314    btwoc(DiffieHellman, DiffieHellmanBytes),
 1315    signature_algorithm(SessionType, SHA_Algo),
 1316    sha_hash(DiffieHellmanBytes, DHHash,
 1317             [encoding(octet), algorithm(SHA_Algo)]),
 1318    xor_codes(DHHash, EncMacKey, Secret).
 expires_at(+Pairs, -Time) is det
Unify Time with a time-stamp stating when the association exires.
 1326expires_at(Pairs, Time) :-
 1327    memberchk(expires_in-ExpAtom, Pairs),
 1328    atom_number(ExpAtom, Seconds),
 1329    get_time(Now),
 1330    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.
 1338associate_data(Data, P, G, X, Options) :-
 1339    openid_dh_p(P),
 1340    openid_dh_g(G),
 1341    X is 1+random(P-1),                     % 1<=X<P-1
 1342    CP is powm(G, X, P),
 1343    base64_btwoc(P, P64),
 1344    base64_btwoc(G, G64),
 1345    base64_btwoc(CP, CP64),
 1346    option(ns(NS), Options, 'http://specs.openid.net/auth/2.0'),
 1347    (   assoc_type(NS, DefAssocType, DefSessionType)
 1348    ->  true
 1349    ;   domain_error('openid.ns', NS)
 1350    ),
 1351    option(assoc_type(AssocType), Options, DefAssocType),
 1352    option(assoc_type(SessionType), Options, DefSessionType),
 1353    Data = [ 'openid.ns'                 = NS,
 1354             'openid.mode'               = associate,
 1355             'openid.assoc_type'         = AssocType,
 1356             'openid.session_type'       = SessionType,
 1357             'openid.dh_modulus'         = P64,
 1358             'openid.dh_gen'             = G64,
 1359             'openid.dh_consumer_public' = CP64
 1360           ].
 1361
 1362assoc_type('http://specs.openid.net/auth/2.0',
 1363           'HMAC-SHA256',
 1364           'DH-SHA256').
 1365assoc_type('http://openid.net/signon/1.1',
 1366           'HMAC-SHA1',
 1367           'DH-SHA1').
 1368
 1369
 1370                 /*******************************
 1371                 *            RANDOM            *
 1372                 *******************************/
 random_bytes(+N, -Bytes) is det
Bytes is a list of N random bytes (integers 0..255).
 1378random_bytes(N, [H|T]) :-
 1379    N > 0,
 1380    !,
 1381    H is random(256),
 1382    N2 is N - 1,
 1383    random_bytes(N2, T).
 1384random_bytes(_, []).
 1385
 1386
 1387                 /*******************************
 1388                 *           CONSTANTS          *
 1389                 *******************************/
 1390
 1391openid_dh_p(155172898181473697471232257763715539915724801966915404479707795314057629378541917580651227423698188993727816152646631438561595825688188889951272158842675419950341258706556549803580104870537681476726513255747040765857479291291572334510643245094715007229621094194349783925984760375594985848253359305585439638443).
 1392
 1393openid_dh_g(2).
 1394
 1395
 1396                 /*******************************
 1397                 *             UTIL             *
 1398                 *******************************/
 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.
 1407key_values_data(Pairs, Data) :-
 1408    nonvar(Data),
 1409    !,
 1410    phrase(data_form(Pairs), Data).
 1411key_values_data(Pairs, Data) :-
 1412    phrase(gen_data_form(Pairs), Data).
 1413
 1414data_form([Key-Value|Pairs]) -->
 1415    utf8_string(KeyCodes), ":", utf8_string(ValueCodes), "\n",
 1416    !,
 1417    { atom_codes(Key, KeyCodes),
 1418      atom_codes(Value, ValueCodes)
 1419    },
 1420    data_form(Pairs).
 1421data_form([]) -->
 1422    ws.
 utf8_string(-Codes)// is nondet
Take a short UTF-8 code-list from input. Extend on backtracking.
 1428utf8_string([]) -->
 1429    [].
 1430utf8_string([H|T]) -->
 1431    utf8_codes([H]),
 1432    utf8_string(T).
 1433
 1434ws -->
 1435    [C],
 1436    { C =< 32 },
 1437    !,
 1438    ws.
 1439ws -->
 1440    [].
 1441
 1442
 1443gen_data_form([]) -->
 1444    [].
 1445gen_data_form([Key-Value|T]) -->
 1446    field(Key), ":", field(Value), "\n",
 1447    gen_data_form(T).
 1448
 1449field(Field) -->
 1450    { to_codes(Field, Codes)
 1451    },
 1452    utf8_codes(Codes).
 1453
 1454to_codes(Codes, Codes) :-
 1455    is_list(Codes),
 1456    !.
 1457to_codes(Atomic, Codes) :-
 1458    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
 1464base64_btwoc(Int, Base64) :-
 1465    integer(Int),
 1466    !,
 1467    btwoc(Int, Bytes),
 1468    phrase(base64(Bytes), Base64).
 1469base64_btwoc(Int, Base64) :-
 1470    atom(Base64),
 1471    !,
 1472    atom_codes(Base64, Codes),
 1473    phrase(base64(Bytes), Codes),
 1474    btwoc(Int, Bytes).
 1475base64_btwoc(Int, Base64) :-
 1476    phrase(base64(Bytes), Base64),
 1477    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.
 1486btwoc(Int, Bytes) :-
 1487    integer(Int),
 1488    !,
 1489    int_to_bytes(Int, Bytes).
 1490btwoc(Int, Bytes) :-
 1491    is_list(Bytes),
 1492    bytes_to_int(Bytes, Int).
 1493
 1494int_to_bytes(Int, Bytes) :-
 1495    int_to_bytes(Int, [], Bytes).
 1496
 1497int_to_bytes(Int, Bytes0, [Int|Bytes0]) :-
 1498    Int < 128,
 1499    !.
 1500int_to_bytes(Int, Bytes0, Bytes) :-
 1501    Last is Int /\ 0xff,
 1502    Int1 is Int >> 8,
 1503    int_to_bytes(Int1, [Last|Bytes0], Bytes).
 1504
 1505
 1506bytes_to_int([B|T], Int) :-
 1507    bytes_to_int(T, B, Int).
 1508
 1509bytes_to_int([], Int, Int).
 1510bytes_to_int([B|T], Int0, Int) :-
 1511    Int1 is (Int0<<8)+B,
 1512    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.
 1522xor_codes([], [], []) :- !.
 1523xor_codes([H1|T1], [H2|T2], [H|T]) :-
 1524    !,
 1525    H is H1 xor H2,
 1526    !,
 1527    xor_codes(T1, T2, T).
 1528xor_codes(L1, L2, _) :-
 1529    throw(error(length_mismatch(L1, L2), _)).
 1530
 1531
 1532                 /*******************************
 1533                 *        HTTP ATTRIBUTES       *
 1534                 *******************************/
 1535
 1536openid_attribute('openid.mode',
 1537                 [ oneof([ associate,
 1538                           checkid_setup,
 1539                           cancel,
 1540                           id_res
 1541                         ])
 1542                 ]).
 1543openid_attribute('openid.assoc_type',
 1544                 [ oneof(['HMAC-SHA1'])
 1545                 ]).
 1546openid_attribute('openid.session_type',
 1547                 [ oneof([ 'DH-SHA1',
 1548                           'DH-SHA256'
 1549                         ])
 1550                 ]).
 1551openid_attribute('openid.dh_modulus',         [length > 1]).
 1552openid_attribute('openid.dh_gen',             [length > 1]).
 1553openid_attribute('openid.dh_consumer_public', [length > 1]).
 1554openid_attribute('openid.assoc_handle',       [length > 1]).
 1555openid_attribute('openid.return_to',          [length > 1]).
 1556openid_attribute('openid.trust_root',         [length > 1]).
 1557openid_attribute('openid.identity',           [length > 1]).
 1558openid_attribute('openid.password',           [length > 1]).
 1559openid_attribute('openid.grant',              [oneof([yes,no])])