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, _, _)). 821