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)  2015-2016, VU University Amsterdam
    7    All rights reserved.
    8
    9    Redistribution and use in source and binary forms, with or without
   10    modification, are permitted provided that the following conditions
   11    are met:
   12
   13    1. Redistributions of source code must retain the above copyright
   14       notice, this list of conditions and the following disclaimer.
   15
   16    2. Redistributions in binary form must reproduce the above copyright
   17       notice, this list of conditions and the following disclaimer in
   18       the documentation and/or other materials provided with the
   19       distribution.
   20
   21    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   22    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   23    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   24    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   25    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   26    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   27    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   28    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   29    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   30    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   31    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   32    POSSIBILITY OF SUCH DAMAGE.
   33*/
   34
   35:- module(http_digest,
   36          [ http_digest_challenge//2,      % +Realm, +Options
   37            http_digest_password_hash/4,   % +User, +Realm, +Passwd, -Hash
   38                                           % client support
   39            http_parse_digest_challenge/2, % +Challenge, -Fields
   40            http_digest_response/5         % +Fields, +User, +Password,
   41                                           % -Reply +Opts
   42          ]).   43:- use_module(library(http/http_authenticate)).   44:- use_module(library(http/http_stream)).   45:- use_module(library(dcg/basics)).   46:- use_module(library(md5)).   47:- use_module(library(error)).   48:- use_module(library(option)).   49:- use_module(library(debug)).   50:- use_module(library(settings)).   51:- use_module(library(base64)).   52:- use_module(library(broadcast)).   53:- use_module(library(uri)).   54:- use_module(library(apply)).

HTTP Digest authentication

This library implements HTTP Digest Authentication as per RFC2617. Unlike Basic Authentication, digest authentication is based on challenge-reponse and therefore does not need to send the password over the (insecure) connection. In addition, it provides a count mechanism that ensure that old credentials cannot be reused, which prevents attackers from using old credentials with a new request. Digest authentication have the following advantages and disadvantages:

And, of course, the connection itself remains insecure. Digest based authentication is a viable alternative if HTTPS is not a good option and security of the data itself is not an issue.

This library acts as plugin for library(http/http_dispatch), where the registered handler (http_handler/3) can be given the option below to initiate digest authentication.

Above, PasswdFile is a file containing lines of the from below, where PasswordHash is computed using http_digest_password_hash/4. See also library(http/http_authenticate), http_read_passwd_file/2 and http_write_passwd_file/2.

User ":" PasswordHash (":" Extra)*

This library also hooks into library(http/http_open) if the option authorization(digest(User, Password)) is given.

See also
- https://tools.ietf.org/html/rfc2617 */
  108:- setting(nonce_timeout, number, 3600,
  109           "Validity time for a server nonce").  110:- setting(client_nonce_timeout, number, 3600,
  111           "Validity time for a client nonce").  112
  113                 /*******************************
  114                 *      TRACK CONNECTIONS       *
  115                 *******************************/
  116
  117:- dynamic
  118    nonce_key/1,                    % Our nonce private key
  119    nonce/2,                        % Nonce, CreatedTime
  120    nonce_nc/3,                     % Nonce, NC, Time
  121    nonce_nc_first/2,               % Nonce, NC
  122    nonce_gc_time/1.                % Time of last nonce GC
 register_nonce(+Nonce, +Created) is det
Register a nonce created by the server. We need to do so to ensure the client uses our nonce and that the connection should not considered timed out.
  130register_nonce(Nonce64, Created) :-
  131    broadcast(http_digest(nonce(Nonce64, Created))),
  132    assertz(nonce(Nonce64, Created)),
  133    gc_nonce.
 nonce_ok(+Nonce, +NC, -Stale) is semidet
True if Nonce at nonce-count NC is acceptable. That means the nonce has not timed out and we have not seen the same sequence number before. Note that requests may be concurrent and therefore NC values may not come in order.
  142nonce_ok(Nonce, NC, Stale) :-
  143    get_time(Now),
  144    nonce_not_timed_out(Nonce, Now, Stale),
  145    nonce_nc_ok(Nonce, NC, Now).
  146
  147nonce_not_timed_out(Nonce, Now, Stale) :-
  148    (   nonce(Nonce, Created)
  149    ->  setting(nonce_timeout, TimeOut),
  150        (   Now - Created < TimeOut
  151        ->  Stale = false
  152        ;   forget_nonce(Nonce),
  153            debug(http(nonce), 'Nonce timed out: ~q', [Nonce]),
  154            Stale = true
  155        )
  156    ;   our_nonce(Nonce, _Stamp)
  157    ->  Stale = true
  158    ;   debug(http(nonce), 'Unknown nonce: ~q', [Nonce]),
  159        fail
  160    ).
  161
  162nonce_nc_ok(Nonce, NC, _Now) :-
  163    (   nonce_nc(Nonce, NC, _)
  164    ;   nonce_nc_first(Nonce, First),
  165        NC @=< First
  166    ),
  167    !,
  168    debug(http(nonce), 'Nonce replay attempt: ~q@~q', [Nonce, NC]),
  169    fail.
  170nonce_nc_ok(Nonce, NC, Now) :-
  171    assertz(nonce_nc(Nonce, NC, Now)).
  172
  173forget_nonce(Nonce) :-
  174    retractall(nonce(Nonce, _)),
  175    retractall(nonce_nc(Nonce, _, _)),
  176    retractall(nonce_nc_first(Nonce, _)).
 gc_nonce
Garbage collect server nonce.
  182gc_nonce :-
  183    nonce_gc_time(Last),
  184    get_time(Now),
  185    setting(nonce_timeout, TimeOut),
  186    Now-Last < TimeOut/4,
  187    !.
  188gc_nonce :-
  189    with_mutex(http_digest_gc_nonce,
  190               gc_nonce_sync).
  191
  192gc_nonce_sync :-
  193    get_time(Now),
  194    asserta(nonce_gc_time(Now)),
  195    forall(( nonce_gc_time(T),
  196             T \== Now
  197           ),
  198           retractall(nonce_gc_time(T))),
  199    setting(nonce_timeout, TimeOut),
  200    Before is Now - TimeOut,
  201    forall(nonce_timed_out(Nonce, Before),
  202           forget_nonce(Nonce)),
  203    NCBefore is Now - 60,
  204    forall(nonce(Nonce, _Created),
  205           gc_nonce_nc(Nonce, NCBefore)).
  206
  207nonce_timed_out(Nonce, Before) :-
  208    nonce(Nonce, Created),
  209    Created < Before.
  210
  211gc_nonce_nc(Nonce, Before) :-
  212    findall(NC, gc_nonce_nc(Nonce, Before, NC), List),
  213    sort(0, @>, List, [Max|_]),
  214    !,
  215    asserta(nonce_nc_first(Nonce, Max)),
  216    forall(( nonce_nc_first(Nonce, NC),
  217             NC \== Max
  218           ),
  219           retractall(nonce_nc_first(Nonce, NC))).
  220gc_nonce_nc(_, _).
  221
  222gc_nonce_nc(Nonce, Before, NC) :-
  223    nonce_nc(Nonce, NC, Time),
  224    Time < Before,
  225    retractall(nonce_nc(Nonce, NC, Time)).
 private_key(-PrivateKey) is det
Return our private key.
  233private_key(PrivateKey) :-
  234    nonce_key(PrivateKey),
  235    !.
  236private_key(PrivateKey) :-
  237    with_mutex(http_digest,
  238               private_key_sync(PrivateKey)).
  239
  240private_key_sync(PrivateKey) :-
  241    nonce_key(PrivateKey),
  242    !.
  243private_key_sync(PrivateKey) :-
  244    PrivateKey is random(1<<63-1),
  245    assertz(nonce_key(PrivateKey)).
 our_nonce(+Nonce, -Stamp:string) is semidet
True if we created Nonce at time Stamp.
Arguments:
Stamp- is the stamp as created by nonce//1: a time stamp*1000+sequence number.
  254our_nonce(Nonce64, Stamp) :-
  255    base64(Nonce, Nonce64),
  256    split_string(Nonce, ":", "", [Stamp,HNonceContent]),
  257    private_key(PrivateKey),
  258    atomics_to_string([Stamp,PrivateKey], ":", NonceContent),
  259    hash(NonceContent, HNonceContent).
  260
  261
  262                 /*******************************
  263                 *            GRAMMAR           *
  264                 *******************************/
 http_digest_challenge(+Realm, +Options)//
Generate the content for a 401 WWW-Authenticate: Digest header field.
  271http_digest_challenge(Realm, Options) -->
  272    %       "Digest ",
  273            realm(Realm),
  274            domain(Options),
  275            nonce(Options),
  276            option_value(opaque, Options),
  277            stale(Options),
  278    %       algorithm(Options),
  279            qop_options(Options).
  280%       auth_param(Options).
  281
  282realm(Realm) -->
  283    { no_dquote(realm, Realm) },
  284    "realm=\"", atom(Realm), "\"".
  285
  286domain(Options) -->
  287    { option(domain(Domain), Options) },
  288    !,
  289    sep, "domain=\"", uris(Domain), "\"".
  290domain(_) --> "".
  291
  292uris(Domain) -->
  293    { atomic(Domain) },
  294    !,
  295    uri(Domain).
  296uris(Domains) -->
  297    { must_be(list(atomic), Domains)
  298    },
  299    uri_list(Domains).
  300
  301uri_list([]) --> "".
  302uri_list([H|T]) -->
  303    uri(H),
  304    (   {T \== []}
  305    ->  " ", uri_list(T)
  306    ;   ""
  307    ).
  308
  309uri(URI) -->
  310    { no_dquote(uri, URI) },
  311    atom(URI).
 nonce(+Options)
Compute the server nonce value. Note that we should never generate the same nonce twice for the same client. The client may issue multiple requests without an authorization header for resources appearing on a page. As long as we return distinct nonce values, this is ok. If we do not, the server will reuse NC counters on the same nonce, which will break the authentication.
  322nonce(Options) -->
  323    { get_time(Now),
  324      flag(http_digest_nonce_seq, Seq, Seq+1),
  325      Stamp is floor(Now)*1000+(Seq mod 1000),
  326      private_key(PrivateKey),
  327      atomics_to_string([Stamp,PrivateKey], ":", NonceContent),
  328      hash(NonceContent, HNonceContent),
  329      atomics_to_string([Stamp,HNonceContent], ":", NonceText),
  330      base64(NonceText, Nonce),
  331      option(nonce(Nonce-Now), Options, _),
  332      debug(http(authenticate), 'Server nonce: ~q', [Nonce])
  333    },
  334    sep, "nonce=\"", atom(Nonce), "\"".
  335
  336stale(Options) -->
  337    { option(stale(true), Options), !
  338    },
  339    sep, "stale=true".
  340stale(_) --> "".
  341
  342qop_options(_Options) -->
  343    sep, "qop=\"auth,auth-int\"".
  344
  345option_value(Key, Options) -->
  346    { Opt =.. [Key,Value],
  347      option(Opt, Options), !
  348    },
  349    key_qvalue(Key, Value).
  350option_value(_, _) --> "".
  351
  352key_value(Key, Value)  -->
  353    atom(Key), "=", atom(Value).
  354key_qvalue(Key, Value) -->
  355    { no_dquote(Key, Value) },
  356    atom(Key), "=\"", atom(Value), "\"".
  357
  358no_dquote(Key, Value) :-
  359    nonvar(Value),
  360    sub_atom(Value, _, _, _, '"'),
  361    !,
  362    domain_error(Key, value).
  363no_dquote(_, _).
  364
  365sep --> ", ".
  366
  367hash(Text, Hash) :-
  368    md5_hash(Text, Hash, []).
 http_digest_authenticate(+Request, -User, -UserFields, +Options)
Validate the client reponse from the Request header. On success, User is the validated user and UserFields are additional fields from the password file. Options include:
passwd_file(+File)
Validate passwords agains the given password file. The file is read using http_current_user/3 from library(http/http_authenticate).
stale(-Stale)
The request may succeed on a timed-out server nonce. In that case, Stale is unified with true.
  384http_digest_authenticate(Request, [User|Fields], Options) :-
  385    memberchk(authorization(Authorization), Request),
  386    debug(http(authenticate), 'Authorization: ~w', [Authorization]),
  387    digest_authenticate(Authorization, User, Fields, Options).
  388
  389digest_authenticate(Authorization, User, Fields, Options) :-
  390    string_codes(Authorization, AuthorizationCodes),
  391    phrase(parse_digest_reponse(AuthValues), AuthorizationCodes),
  392    memberchk(username(User), AuthValues),
  393    memberchk(realm(Realm), AuthValues),
  394    memberchk(nonce(ServerNonce), AuthValues),
  395    memberchk(uri(Path), AuthValues),
  396    memberchk(qop(QOP), AuthValues),
  397    memberchk(nc(NC), AuthValues),
  398    memberchk(cnonce(ClientNonce), AuthValues),
  399    memberchk(response(Response), AuthValues),
  400    user_ha1_details(User, Realm, HA1, Fields, Options),
  401    option(method(Method), Options, get),
  402    ha2(Method, Path, HA2),
  403    atomics_to_string([ HA1,
  404                        ServerNonce,
  405                        NC,
  406                        ClientNonce,
  407                        QOP,
  408                        HA2
  409                      ], ":", ResponseText),
  410    debug(http(authenticate), 'ResponseText: ~w', [ResponseText]),
  411    hash(ResponseText, ResponseExpected),
  412    (   Response == ResponseExpected
  413    ->  debug(http(authenticate), 'We have a match!', [])
  414    ;   debug(http(authenticate),
  415              '~q \\== ~q', [Response, ResponseExpected]),
  416        fail
  417    ),
  418    nonce_ok(ServerNonce, NC, Stale),
  419    (   option(stale(Stale), Options)
  420    ->  true
  421    ;   Stale == false
  422    ).
  423
  424user_ha1_details(User, _Realm, HA1, Fields, Options) :-
  425    option(passwd_file(File), Options),
  426    http_current_user(File, User, [HA1|Fields]).
 parse_digest_request(-Fields)//
Parse a digest request into a list of Name(Value) terms.
  432parse_digest_request(Fields) -->
  433    "Digest", whites,
  434    digest_values(Fields).
 parse_digest_reponse(-ResponseValues)//
  438parse_digest_reponse(ResponseValues) -->
  439    "Digest", whites,
  440    digest_values(ResponseValues).
  441
  442
  443digest_values([H|T]) -->
  444    digest_value(H),
  445    !,
  446    whites,
  447    (   ","
  448    ->  whites,
  449        digest_values(T)
  450    ;   {T = []}
  451    ).
  452
  453digest_value(V) -->
  454    string_without(`=`, NameCodes), "=",
  455    { atom_codes(Name, NameCodes) },
  456    digest_value(Name, V).
  457
  458digest_value(Name, V) -->
  459    "\"",
  460    !,
  461    string_without(`"`, ValueCodes), "\"",
  462    { parse_value(Name, ValueCodes, Value),
  463      V =.. [Name,Value]
  464    }.
  465digest_value(stale, stale(V)) -->
  466    !,
  467    boolean(V).
  468digest_value(Name, V) -->
  469    string_without(`, `, ValueCodes),
  470    { parse_value(Name, ValueCodes, Value),
  471      V =.. [Name,Value]
  472    }.
  473
  474
  475parse_value(domain, Codes, Domain) :-
  476    !,
  477    string_codes(String, Codes),
  478    atomic_list_concat(Domain, ' ', String).
  479parse_value(Name, Codes, Value) :-
  480    atom_value(Name),
  481    atom_codes(Value, Codes).
  482parse_value(_Name, Codes, Value) :-
  483    string_codes(Value, Codes).
  484
  485atom_value(realm).
  486atom_value(username).
  487atom_value(response).
  488atom_value(nonce).
  489atom_value(stale).              % for misbehaving servers that quote stale
  490
  491boolean(true) --> "true".
  492boolean(false) --> "false".
  493
  494
  495                 /*******************************
  496                 *           CLIENT             *
  497                 *******************************/
 http_parse_digest_challenge(+Challenge, -Fields) is det
Parse the value of an HTTP WWW-Authenticate header into a list of Name(Value) terms.
  504http_parse_digest_challenge(Challenge, Fields) :-
  505    string_codes(Challenge, ReqCodes),
  506    phrase(parse_digest_request(Fields), ReqCodes).
 http_digest_response(+Challenge, +User, +Password, -Reply, +Options)
Formulate a reply to a digest authentication request. Options:
path(+Path)
The request URI send along with the authentication. Defaults to /
method(+Method)
The HTTP method. Defaults to 'GET'
nc(+Integer)
The nonce-count as an integer. This is formatted as an 8 hex-digit string.
Arguments:
Challenge- is a list Name(Value), normally from http_parse_digest_challenge/2. Must contain realm and nonce. Optionally contains opaque.
User- is the user we want to authenticated
Password- is the user's password
Options- provides additional options
  529http_digest_response(Fields, User, Password, Reply, Options) :-
  530    phrase(http_digest_response(Fields, User, Password, Options), Codes),
  531    string_codes(Reply, Codes).
  532
  533http_digest_response(Fields, User, Password, Options) -->
  534    { memberchk(nonce(ServerNonce), Fields),
  535      memberchk(realm(Realm), Fields),
  536      client_nonce(ClientNonce),
  537      http_digest_password_hash(User, Realm, Password, HA1),
  538      QOP = 'auth',
  539      option(path(Path), Options, /),
  540      option(method(Method), Options, 'GET'),
  541      option(nc(NC), Options, 1),
  542      format(string(NCS), '~`0t~16r~8+', [NC]),
  543      ha2(Method, Path, HA2),
  544      atomics_to_string([ HA1,
  545                          ServerNonce,
  546                          NCS,
  547                          ClientNonce,
  548                          QOP,
  549                          HA2
  550                        ], ":", ResponseText),
  551      hash(ResponseText, Response)
  552    },
  553    "Digest ",
  554    key_qvalue(username, User),
  555    sep, key_qvalue(realm, Realm),
  556    sep, key_qvalue(nonce, ServerNonce),
  557    sep, key_qvalue(uri, Path),
  558    sep, key_value(qop, QOP),
  559    sep, key_value(nc, NCS),
  560    sep, key_qvalue(cnonce, ClientNonce),
  561    sep, key_qvalue(response, Response),
  562    (   { memberchk(opaque(Opaque), Fields) }
  563    ->  sep, key_qvalue(opaque, Opaque)
  564    ;   ""
  565    ).
  566
  567client_nonce(Nonce) :-
  568    V is random(1<<32),
  569    format(string(Nonce), '~`0t~16r~8|', [V]).
  570
  571ha2(Method, Path, HA2) :-
  572    string_upper(Method, UMethod),
  573    atomics_to_string([UMethod,Path], ":", A2),
  574    hash(A2, HA2).
 http_digest_password_hash(+User, +Realm, +Password, -Hash) is det
Compute the password hash for the HTTP password file. Note that the HTTP digest mechanism does allow us to use a seeded expensive arbitrary hash function. Instead, the hash is defined as the MD5 of the following components:
<user>:<realm>:<password>.

The inexpensive MD5 algorithm makes the hash sensitive to brute force attacks while the lack of seeding make the hashes sensitive for rainbow table attacks, although the value is somewhat limited because the realm and user are part of the hash.

  592http_digest_password_hash(User, Realm, Password, HA1) :-
  593    atomics_to_string([User,Realm,Password], ":", A1),
  594    hash(A1, HA1).
  595
  596
  597                 /*******************************
  598                 *   PLUGIN FOR HTTP_DISPATCH   *
  599                 *******************************/
  600
  601:- multifile
  602    http:authenticate/3.
 http:authenticate(+Digest, +Request, -Fields)
Plugin for library(http_dispatch) to perform basic HTTP authentication. Note that we keep the authentication details cached to avoid a `nonce-replay' error in the case that the application tries to verify multiple times.

This predicate throws http_reply(authorise(digest(Digest)))

Arguments:
Digest- is a term digest(File, Realm, Options)
Request- is the HTTP request
Fields- describes the authenticated user with the option user(User) and with the option user_details(Fields) if the password file contains additional fields after the user and password.
  620http:authenticate(digest(File, Realm), Request, Details) :-
  621    http:authenticate(digest(File, Realm, []), Request, Details).
  622http:authenticate(digest(File, Realm, Options), Request, Details) :-
  623    current_output(CGI),
  624    cgi_property(CGI, id(Id)),
  625    (   nb_current('$http_digest_user', Id-Details)
  626    ->  true
  627    ;   authenticate(digest(File, Realm, Options), Request, Details),
  628        nb_setval('$http_digest_user', Id-Details)
  629    ).
  630
  631authenticate(digest(File, Realm, Options), Request,
  632             [ user(User)
  633             | Details
  634             ]) :-
  635    (   option(method(Method), Request, get),
  636        http_digest_authenticate(Request, [User|Fields],
  637                                 [ passwd_file(File),
  638                                   stale(Stale),
  639                                   method(Method)
  640                                 ])
  641    ->  (   Stale == false
  642        ->  (   Fields == []
  643            ->  Details = []
  644            ;   Details = [user_details(Fields)]
  645            ),
  646            Ok = true
  647        ;   true
  648        )
  649    ;   true
  650    ),
  651    (   Ok == true
  652    ->  true
  653    ;   add_option(nonce(Nonce-Created), Options, Options1),
  654        add_stale(Stale, Options1, Options2),
  655        phrase(http_digest_challenge(Realm, Options2), DigestCodes),
  656        string_codes(Digest, DigestCodes),
  657        register_nonce(Nonce, Created),
  658        throw(http_reply(authorise(digest(Digest))))
  659    ).
  660
  661add_option(Option, Options0, _) :-
  662    option(Option, Options0),
  663    !.
  664add_option(Option, Options0, [Option|Options0]).
  665
  666add_stale(Stale, Options0, Options) :-
  667    Stale == true,
  668    !,
  669    Options = [stale(true)|Options0].
  670add_stale(_, Options, Options).
  671
  672
  673                 /*******************************
  674                 *     PLUGIN FOT HTTP_OPEN     *
  675                 *******************************/
  676
  677:- multifile
  678    http:authenticate_client/2.  679:- dynamic
  680    client_nonce/4,                 % Authority, Domains, Keep, Time
  681    client_nonce_nc/3,              % Nonce, Count, Time
  682    client_nonce_gc_time/1.         % Time
 http:authenticate_client(+URL, +Action) is semidet
This hooks is called by http_open/3 with the following Action value:
send_auth_header(+AuthData, +Out, +Options)
Called when sending the initial request. AuthData contains the value for the http_open/3 option authorization(AuthData) and Out is a stream on which to write additional HTTP headers.
auth_reponse(+Headers, +OptionsIn, -Options)
Called if the server replies with a 401 code, challenging the client. Our implementation adds a request_header(authorization=Digest) header to Options, causing http_open/3 to retry the request with the additional option.
  699http:authenticate_client(URL, auth_reponse(Headers, OptionsIn, Options)) :-
  700    debug(http(authenticate), "Got 401 with ~p", [Headers]),
  701    memberchk(www_authenticate(Authenticate), Headers),
  702    http_parse_digest_challenge(Authenticate, Fields),
  703    user_password(OptionsIn, User, Password),
  704    !,
  705    uri_components(URL, Components),
  706    uri_data(path, Components, Path),
  707    http_digest_response(Fields, User, Password, Digest,
  708                             [ path(Path)
  709                             | OptionsIn
  710                             ]),
  711    merge_options([ request_header(authorization=Digest)
  712                  ],
  713                  OptionsIn, Options),
  714    keep_digest_credentials(URL, Fields).
  715http:authenticate_client(URL, send_auth_header(Auth, Out, Options)) :-
  716    authorization_data(Auth, User, Password),
  717    uri_components(URL, Components),
  718    uri_data(authority, Components, Authority),
  719    uri_data(path, Components, Path),
  720    digest_credentials(Authority, Path, Nonce, Fields),
  721    !,
  722    next_nonce_count(Nonce, NC),
  723    debug(http(authenticate), "Continue ~p nc=~q", [URL, NC]),
  724    http_digest_response(Fields, User, Password, Digest,
  725                         [ nc(NC),
  726                           path(Path)
  727                         | Options
  728                         ]),
  729    format(Out, 'Authorization: ~w\r\n', [Digest]).
  730http:authenticate_client(URL, send_auth_header(Auth, _Out, _Options)) :-
  731    debug(http(authenticate), "Failed ~p", [URL]),
  732    authorization_data(Auth, _User, _Password).
  733
  734
  735user_password(Options, User, Password) :-
  736    option(authorization(Auth), Options),
  737    authorization_data(Auth, User, Password).
  738
  739authorization_data(digest(User, Password), User, Password).
 digest_credentials(+Authority, +Path, -Nonce, -Fields) is semidet
True if we have digest credentials for Authority on Path with the server nonce Nonce and additional Fields.
  746digest_credentials(Authority, Path, Nonce, Fields) :-
  747    client_nonce(Authority, Domains, Fields, _Created),
  748    in_domain(Path, Domains),
  749    memberchk(nonce(Nonce), Fields),
  750    !.
  751
  752in_domain(Path, Domains) :-
  753    member(Domain, Domains),
  754    sub_atom(Path, 0, _, _, Domain),
  755    !.
  756
  757next_nonce_count(Nonce, NC) :-
  758    with_mutex(http_digest_client,
  759               next_nonce_count_sync(Nonce, NC)).
  760
  761next_nonce_count_sync(Nonce, NC) :-
  762    retract(client_nonce_nc(Nonce, NC0, _)),
  763    !,
  764    NC1 is NC0+1,
  765    get_time(Now),
  766    assert(client_nonce_nc(Nonce, NC1, Now)),
  767    NC = NC1.
  768next_nonce_count_sync(Nonce, 2) :-
  769    get_time(Now),
  770    assert(client_nonce_nc(Nonce, 2, Now)).
 keep_digest_credentials(+URL, +Fields)
Keep the digest credentials for subsequent connections.
  776keep_digest_credentials(URL, Fields) :-
  777    get_time(Now),
  778    uri_components(URL, Components),
  779    uri_data(authority, Components, Authority),
  780    include(keep_field, Fields, Keep),
  781    (   memberchk(domain(Domains), Fields)
  782    ->  true
  783    ;   Domains = [/]
  784    ),
  785    assertz(client_nonce(Authority, Domains, Keep, Now)),
  786    gc_client_nonce.
  787
  788keep_field(realm(_)).
  789keep_field(nonce(_)).
  790keep_field(opaque(_)).
  791
  792gc_client_nonce :-
  793    client_nonce_gc_time(Last),
  794    get_time(Now),
  795    setting(client_nonce_timeout, TimeOut),
  796    Now-Last < TimeOut/4,
  797    !.
  798gc_client_nonce :-
  799    get_time(Now),
  800    retractall(client_nonce_gc_time(_)),
  801    asserta(client_nonce_gc_time(Now)),
  802    setting(client_nonce_timeout, TimeOut),
  803    Before is Now-TimeOut,
  804    forall(client_nonce_expired(Nonce, Before),
  805           forget_client_nonce(Nonce)).
  806
  807client_nonce_expired(Nonce, Before) :-
  808    client_nonce(_Authority, _Domains, Fields, Created),
  809    Created < Before,
  810    memberchk(nonce(Nonce), Fields),
  811    \+ ( client_nonce_nc(Nonce, _, Last),
  812         Last < Before
  813       ).
  814
  815forget_client_nonce(Nonce) :-
  816    client_nonce(_, _, Fields, Created),
  817    memberchk(nonce(Nonce), Fields),
  818    !,
  819    retractall(client_nonce(_, _, Fields, Created)),
  820    retractall(client_nonce_nc(Nonce, _, _))