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)).   55
   56
   57/** <module> HTTP Digest authentication
   58
   59This library implements HTTP  _Digest   Authentication_  as per RFC2617.
   60Unlike  _Basic  Authentication_,  digest  authentication   is  based  on
   61challenge-reponse and therefore does not need  to send the password over
   62the (insecure) connection. In addition, it   provides  a count mechanism
   63that ensure that old  credentials  cannot   be  reused,  which  prevents
   64attackers  from  using  old  credentials  with  a  new  request.  Digest
   65authentication have the following advantages and disadvantages:
   66
   67  - Advantages
   68    - Authentication without exchanging the password
   69    - No re-use of authentication data
   70  - Disadvantages
   71    - An extra round trip is needed for the first authentication
   72    - Server-side storage of the password is the MD5 hash of the
   73      user, _realm_ and password.  As MD5 hashes are quick to
   74      compute, one needs strong passwords.  This fixed algorithm
   75      also allows for _rainbow table_ attacks, although their
   76      value is limited because you need to precompute the rainbow
   77      table for every server (_realm_) and user.
   78    - The connection is sensitive to man-in-the-middle attack,
   79      where the attacker can both change the request and response.
   80    - Both client and server need to keep an administration of
   81      issued _nonce_ values and associated _nonce count_ values.
   82
   83And, of course, the connection  itself   remains  insecure. Digest based
   84authentication is a viable alternative if HTTPS is not a good option and
   85security of the data itself is not an issue.
   86
   87This library acts as plugin   for library(http/http_dispatch), where the
   88registered handler (http_handler/3) can be  given   the  option below to
   89initiate digest authentication.
   90
   91  - authentication(digest(PasswdFile, Realm))
   92
   93Above, `PasswdFile` is a file containing lines  of the from below, where
   94PasswordHash is computed  using   http_digest_password_hash/4.  See also
   95library(http/http_authenticate),       http_read_passwd_file/2       and
   96http_write_passwd_file/2.
   97
   98  ==
   99  User ":" PasswordHash (":" Extra)*
  100  ==
  101
  102This library also  hooks  into   library(http/http_open)  if  the option
  103authorization(digest(User, Password)) is given.
  104
  105@see https://tools.ietf.org/html/rfc2617
  106*/
  107
  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
  123
  124%!  register_nonce(+Nonce, +Created) is det.
  125%
  126%   Register a nonce created by the  server.   We  need  to do so to
  127%   ensure the client uses our nonce  and that the connection should
  128%   not considered timed out.
  129
  130register_nonce(Nonce64, Created) :-
  131    broadcast(http_digest(nonce(Nonce64, Created))),
  132    assertz(nonce(Nonce64, Created)),
  133    gc_nonce.
  134
  135%!  nonce_ok(+Nonce, +NC, -Stale) is semidet.
  136%
  137%   True if Nonce at nonce-count NC   is  acceptable. That means the
  138%   nonce has not timed out and we   have not seen the same sequence
  139%   number  before.  Note  that  requests   may  be  concurrent  and
  140%   therefore NC values may not come in order.
  141
  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, _)).
  177
  178%!  gc_nonce
  179%
  180%   Garbage collect server nonce.
  181
  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)).
  226
  227
  228
  229%!  private_key(-PrivateKey) is det.
  230%
  231%   Return our private key.
  232
  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)).
  246
  247%!  our_nonce(+Nonce, -Stamp:string) is semidet.
  248%
  249%   True if we created Nonce at time Stamp.
  250%
  251%   @arg  Stamp  is  the  stamp  as  created  by  nonce//1:  a  time
  252%   stamp*1000+sequence number.
  253
  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                 *******************************/
  265
  266%!  http_digest_challenge(+Realm, +Options)//
  267%
  268%   Generate the content for  a   401  =|WWW-Authenticate:  Digest|=
  269%   header field.
  270
  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).
  312
  313%!  nonce(+Options)
  314%
  315%   Compute the server _nonce_ value.  Note   that  we  should never
  316%   generate the same nonce twice for   the  same client. The client
  317%   _may_ issue multiple requests without   an  authorization header
  318%   for resources appearing on a page. As long as we return distinct
  319%   nonce values, this is ok. If we do not, the server will reuse NC
  320%   counters on the same nonce, which will break the authentication.
  321
  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, []).
  369
  370%!  http_digest_authenticate(+Request, -User, -UserFields, +Options)
  371%
  372%   Validate the client reponse from the Request header. On success,
  373%   User is the validated user and  UserFields are additional fields
  374%   from the password file. Options include:
  375%
  376%     - passwd_file(+File)
  377%     Validate passwords agains the given password file.  The
  378%     file is read using http_current_user/3 from
  379%     library(http/http_authenticate).
  380%     - stale(-Stale)
  381%     The request may succeed on a timed-out server nonce.  In
  382%     that case, Stale is unified with `true`.
  383
  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]).
  427
  428%!  parse_digest_request(-Fields)//
  429%
  430%   Parse a digest request into a list of Name(Value) terms.
  431
  432parse_digest_request(Fields) -->
  433    "Digest", whites,
  434    digest_values(Fields).
  435
  436%!  parse_digest_reponse(-ResponseValues)//
  437
  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                 *******************************/
  498
  499%!  http_parse_digest_challenge(+Challenge, -Fields) is det.
  500%
  501%   Parse the value of an HTTP =|WWW-Authenticate|= header into
  502%   a list of Name(Value) terms.
  503
  504http_parse_digest_challenge(Challenge, Fields) :-
  505    string_codes(Challenge, ReqCodes),
  506    phrase(parse_digest_request(Fields), ReqCodes).
  507
  508%!  http_digest_response(+Challenge, +User, +Password, -Reply, +Options)
  509%
  510%   Formulate a reply to a digest authentication request.  Options:
  511%
  512%     - path(+Path)
  513%     The request URI send along with the authentication.  Defaults
  514%     to `/`
  515%     - method(+Method)
  516%     The HTTP method.  Defaults to `'GET'`
  517%     - nc(+Integer)
  518%     The nonce-count as an integer.  This is formatted as an
  519%     8 hex-digit string.
  520%
  521%   @arg    Challenge is a list Name(Value), normally from
  522%           http_parse_digest_challenge/2.  Must contain
  523%           `realm` and  `nonce`.  Optionally contains
  524%           `opaque`.
  525%   @arg    User is the user we want to authenticated
  526%   @arg    Password is the user's password
  527%   @arg    Options provides additional options
  528
  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).
  575
  576%!  http_digest_password_hash(+User, +Realm, +Password, -Hash) is det.
  577%
  578%   Compute the password hash for the HTTP password file.  Note that
  579%   the HTTP digest mechanism does allow us to use a seeded expensive
  580%   arbitrary hash function.  Instead, the hash is defined as the MD5
  581%   of the following components:
  582%
  583%     ==
  584%     <user>:<realm>:<password>.
  585%     ==
  586%
  587%   The inexpensive MD5 algorithm makes the hash sensitive to brute
  588%   force attacks while the lack of seeding make the hashes sensitive
  589%   for _rainbow table_ attacks, although the value is somewhat limited
  590%   because the _realm_ and _user_ are part of the hash.
  591
  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.  603
  604%!  http:authenticate(+Digest, +Request, -Fields)
  605%
  606%   Plugin  for  library(http_dispatch)  to    perform   basic  HTTP
  607%   authentication.  Note that we keep the authentication details
  608%   cached to avoid a `nonce-replay' error in the case that the
  609%   application tries to verify multiple times.
  610%
  611%   This predicate throws http_reply(authorise(digest(Digest)))
  612%
  613%   @arg    Digest is a term digest(File, Realm, Options)
  614%   @arg    Request is the HTTP request
  615%   @arg    Fields describes the authenticated user with the option
  616%           user(User) and with the option user_details(Fields) if
  617%           the password file contains additional fields after the
  618%           user and password.
  619
  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
  683
  684%!  http:authenticate_client(+URL, +Action) is semidet.
  685%
  686%   This hooks is called by http_open/3 with the following Action
  687%   value:
  688%
  689%     - send_auth_header(+AuthData, +Out, +Options)
  690%     Called when sending the initial request.  AuthData contains
  691%     the value for the http_open/3 option authorization(AuthData)
  692%     and Out is a stream on which to write additional HTTP headers.
  693%     - auth_reponse(+Headers, +OptionsIn, -Options)
  694%     Called if the server replies with a 401 code, challenging the
  695%     client.  Our implementation adds a
  696%     request_header(authorization=Digest) header to Options, causing
  697%     http_open/3 to retry the request with the additional option.
  698
  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).
  740
  741%!  digest_credentials(+Authority, +Path, -Nonce, -Fields) is semidet.
  742%
  743%   True if we have digest credentials for Authority on Path with the
  744%   server _nonce_ Nonce and additional Fields.
  745
  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)).
  771
  772%!  keep_digest_credentials(+URL, +Fields)
  773%
  774%   Keep the digest credentials for subsequent connections.
  775
  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, _, _))