RFC compliance fixes for HTTP specifications · anil.recoil.org/ocaml-requests@474faaa

+119

SPEC-TODO.md

··· 1 + # HTTP RFC Specification Compliance TODO 2 + 3 + This document tracks RFC compliance issues identified in the ocaml-requests library. 4 + Generated from comprehensive analysis against RFC 9110, 9111, 9112, 7235, 7617, 7616, 6750, 2818, and 8446. 5 + 6 + ## Summary 7 + 8 + | Priority | Issue | RFC | Status | 9 + |----------|-------|-----|--------| 10 + | High | 303 redirect method change | RFC 9110 Section 15.4.4 | FIXED | 11 + | High | obs-fold header handling | RFC 9112 Section 5.2 | FIXED | 12 + | High | Basic auth username validation | RFC 7617 Section 2 | FIXED | 13 + | Medium | Close-delimited body reading | RFC 9112 Section 6.3 | FIXED | 14 + | Medium | Retry-After HTTP-date format | RFC 9110 Section 10.2.3 | FIXED | 15 + | Medium | 407 proxy auth auto-retry | RFC 7235 Section 3.2 | FIXED | 16 + | Medium | 417 Expectation Failed retry | RFC 9110 Section 10.1.1 | FIXED | 17 + | Low | Asterisk-form OPTIONS | RFC 9112 Section 3.2.4 | FIXED | 18 + | Low | Accept-Language header builder | RFC 9110 Section 12.5.4 | FIXED | 19 + 20 + --- 21 + 22 + ## Completed Fixes 23 + 24 + ### 1. 303 Redirect Method Change (FIXED) 25 + 26 + **RFC Reference:** RFC 9110 Section 15.4.4 27 + 28 + > "A user agent can perform a retrieval request targeting that URI (a GET or HEAD request if using HTTP)" 29 + 30 + **Fix:** Added status code check in `lib/requests.ml` to change POST, PUT, DELETE, PATCH to GET for 303 redirects and strip the request body. 31 + 32 + --- 33 + 34 + ### 2. obs-fold Header Handling (FIXED) 35 + 36 + **RFC Reference:** RFC 9112 Section 5.2 37 + 38 + > "A user agent that receives an obs-fold in a response message... MUST replace each received obs-fold with one or more SP octets prior to interpreting the field value." 39 + 40 + **Fix:** Modified `header_line` function in `lib/http_read.ml` to detect continuation lines (starting with SP/HTAB) and merge them with a single space. 41 + 42 + --- 43 + 44 + ### 3. Basic Auth Username Validation (FIXED) 45 + 46 + **RFC Reference:** RFC 7617 Section 2 47 + 48 + > "a user-id containing a colon character is invalid" 49 + > "The user-id and password MUST NOT contain any control characters" 50 + 51 + **Fix:** Added `validate_basic_auth_credentials` function in `lib/headers.ml` that raises `Invalid_basic_auth` exception for invalid credentials. 52 + 53 + --- 54 + 55 + ### 4. Close-delimited Body Reading (FIXED) 56 + 57 + **RFC Reference:** RFC 9112 Section 6.3, item 8 58 + 59 + > "Otherwise, this is a response message without a declared message body length, so the message body length is determined by the number of octets received prior to the server closing the connection." 60 + 61 + **Fix:** Added `close_delimited_body` function and `Close_delimited_source` streaming module in `lib/http_read.ml` to read until EOF when no Content-Length or Transfer-Encoding present. 62 + 63 + --- 64 + 65 + ### 5. Retry-After HTTP-date Format (FIXED) 66 + 67 + **RFC Reference:** RFC 9110 Section 10.2.3 68 + 69 + > "The Retry-After field value can be either an HTTP-date or a number of seconds" 70 + 71 + **Fix:** Changed `lib/retry.ml` to use `Http_date.parse` instead of `Ptime.of_rfc3339` for parsing HTTP-date format (IMF-fixdate). 72 + 73 + --- 74 + 75 + ### 6. 407 Proxy Auth Auto-Retry (FIXED) 76 + 77 + **RFC Reference:** RFC 7235 Section 3.2 78 + 79 + > "The 407 (Proxy Authentication Required) status code is similar to 401 (Unauthorized), but it indicates that the client needs to authenticate itself in order to use a proxy." 80 + 81 + **Fix:** Extended `handle_digest_auth` in `lib/requests.ml` to handle both 401 and 407 status codes, using Proxy-Authenticate/Proxy-Authorization headers for 407. 82 + 83 + --- 84 + 85 + ### 7. 417 Expectation Failed Retry (FIXED) 86 + 87 + **RFC Reference:** RFC 9110 Section 10.1.1 88 + 89 + > "A client that receives a 417 (Expectation Failed) status code in response to a request containing a 100-continue expectation SHOULD repeat that request without a 100-continue expectation" 90 + 91 + **Fix:** Modified `make_request_100_continue` in `lib/http_client.ml` to automatically retry without the Expect header when receiving 417. 92 + 93 + --- 94 + 95 + ### 8. Asterisk-form OPTIONS Support (FIXED) 96 + 97 + **RFC Reference:** RFC 9112 Section 3.2.4 98 + 99 + > "When a client wishes to request OPTIONS for the server as a whole... the client MUST send only '*' as the request-target" 100 + 101 + **Fix:** Modified `request_line` function in `lib/http_write.ml` to detect path "*" with OPTIONS method and use asterisk-form request target. 102 + 103 + --- 104 + 105 + ### 9. Accept-Language Header Builder (FIXED) 106 + 107 + **RFC Reference:** RFC 9110 Section 12.5.4 108 + 109 + > "The Accept-Language header field can be used by user agents to indicate the set of natural languages that are preferred in the response." 110 + 111 + **Fix:** Added `accept_language` function to `lib/headers.ml` and `lib/headers.mli`. 112 + 113 + --- 114 + 115 + ## Notes 116 + 117 + - The library intentionally does not implement cache storage (RFC 9111) as it provides utilities for applications to build their own caching layer. 118 + - SOCKS5 proxy support is declared but not implemented - this is a feature gap, not a compliance issue. 119 + - SHA-512-256 for Digest auth is not implemented due to complexity of the special initialization vectors required.

+34

lib/headers.ml

··· 25 25 26 26 exception Invalid_header of { name: string; reason: string } 27 27 28 + (** {1 Basic Auth Credential Validation} 29 + 30 + Per RFC 7617 Section 2: 31 + - Username must not contain a colon character 32 + - Neither username nor password may contain control characters (0x00-0x1F, 0x7F) *) 33 + 34 + exception Invalid_basic_auth of { reason: string } 35 + 36 + let contains_control_chars s = 37 + String.exists (fun c -> 38 + let code = Char.code c in 39 + code <= 0x1F || code = 0x7F 40 + ) s 41 + 42 + let validate_basic_auth_credentials ~username ~password = 43 + (* RFC 7617 Section 2: "a user-id containing a colon character is invalid" *) 44 + if String.contains username ':' then 45 + raise (Invalid_basic_auth { 46 + reason = "Username contains colon character (RFC 7617 Section 2)" 47 + }); 48 + (* RFC 7617 Section 2: "The user-id and password MUST NOT contain any control characters" *) 49 + if contains_control_chars username then 50 + raise (Invalid_basic_auth { 51 + reason = "Username contains control characters (RFC 7617 Section 2)" 52 + }); 53 + if contains_control_chars password then 54 + raise (Invalid_basic_auth { 55 + reason = "Password contains control characters (RFC 7617 Section 2)" 56 + }) 57 + 28 58 let validate_header_name name = 29 59 if String.contains name '\r' || String.contains name '\n' then 30 60 raise (Invalid_header { ··· 101 131 let accept mime t = 102 132 set "Accept" (Mime.to_string mime) t 103 133 134 + let accept_language lang t = 135 + set "Accept-Language" lang t 136 + 104 137 let authorization value t = 105 138 set "Authorization" value t 106 139 ··· 108 141 set "Authorization" (Printf.sprintf "Bearer %s" token) t 109 142 110 143 let basic ~username ~password t = 144 + validate_basic_auth_credentials ~username ~password; 111 145 let credentials = Printf.sprintf "%s:%s" username password in 112 146 let encoded = Base64.encode_exn credentials in 113 147 set "Authorization" (Printf.sprintf "Basic %s" encoded) t

+21 -1

lib/headers.mli

··· 52 52 (** Raised when a header name or value contains invalid characters (CR/LF) 53 53 that could enable HTTP request smuggling attacks. *) 54 54 55 + exception Invalid_basic_auth of { reason: string } 56 + (** Raised when Basic auth credentials contain invalid characters. 57 + Per {{:https://datatracker.ietf.org/doc/html/rfc7617#section-2}RFC 7617 Section 2}: 58 + - Username must not contain colon characters 59 + - Username and password must not contain control characters (0x00-0x1F, 0x7F) *) 60 + 55 61 (** {1 Manipulation} *) 56 62 57 63 val add : string -> string -> t -> t ··· 100 106 val accept : Mime.t -> t -> t 101 107 (** [accept mime headers] sets the Accept header. *) 102 108 109 + val accept_language : string -> t -> t 110 + (** [accept_language lang headers] sets the Accept-Language header. 111 + Per {{:https://datatracker.ietf.org/doc/html/rfc9110#section-12.5.4}RFC 9110 Section 12.5.4}. 112 + 113 + Examples: 114 + {[ 115 + headers |> Headers.accept_language "en-US" 116 + headers |> Headers.accept_language "en-US, en;q=0.9, de;q=0.8" 117 + headers |> Headers.accept_language "*" 118 + ]} *) 119 + 103 120 val authorization : string -> t -> t 104 121 (** [authorization value headers] sets the Authorization header with a raw value. *) 105 122 ··· 109 126 110 127 val basic : username:string -> password:string -> t -> t 111 128 (** [basic ~username ~password headers] sets the Authorization header with 112 - HTTP Basic authentication (base64-encoded username:password). *) 129 + HTTP Basic authentication (base64-encoded username:password). 130 + 131 + @raise Invalid_basic_auth if the username contains a colon character or if 132 + either username or password contains control characters (RFC 7617 Section 2). *) 113 133 114 134 val user_agent : string -> t -> t 115 135 (** [user_agent ua headers] sets the User-Agent header. *)

+12 -4

lib/http_client.ml

··· 301 301 (status, headers, body) 302 302 303 303 | Rejected (status, resp_headers, resp_body_str) -> 304 - (* Server rejected - return error response without sending body *) 305 - Log.info (fun m -> m "Request rejected with status %d, body not sent (saved %Ld bytes)" 306 - status body_len); 307 - (status, resp_headers, resp_body_str) 304 + (* RFC 9110 Section 10.1.1: If we receive 417 Expectation Failed, retry 305 + without the 100-continue expectation *) 306 + if status = 417 then begin 307 + Log.info (fun m -> m "Received 417 Expectation Failed, retrying without Expect header"); 308 + (* Make a fresh request without Expect: 100-continue *) 309 + make_request ~limits ~sw ~method_ ~uri ~headers ~body flow 310 + end else begin 311 + (* Server rejected with non-417 error - return error response without sending body *) 312 + Log.info (fun m -> m "Request rejected with status %d, body not sent (saved %Ld bytes)" 313 + status body_len); 314 + (status, resp_headers, resp_body_str) 315 + end 308 316 309 317 | Timeout -> 310 318 (* Timeout expired - send body anyway per RFC 9110 *)

+122 -6

lib/http_read.ml

··· 101 101 102 102 (** {1 Header Parsing} *) 103 103 104 - (** Parse a single header line. Returns ("", "") for empty line (end of headers). *) 104 + (** Parse a single header line. Returns ("", "") for empty line (end of headers). 105 + Handles obs-fold (RFC 9112 Section 5.2): continuation lines starting with 106 + whitespace are merged into the previous header value with a single space. *) 105 107 let header_line r = 106 108 let name = Read.take_while is_token_char r in 107 109 if name = "" then begin ··· 116 118 Read.char ':' r; 117 119 Read.skip_while is_ows r; 118 120 let value = Read.line r in 119 - (String.lowercase_ascii name, String.trim value) 121 + (* RFC 9112 Section 5.2: Handle obs-fold (obsolete line folding) 122 + A recipient of an obs-fold MUST replace each obs-fold with one or more 123 + SP octets prior to interpreting the field value. *) 124 + let rec collect_obs_fold acc = 125 + match Read.peek_char r with 126 + | Some (' ' | '\t') -> 127 + (* obs-fold: continuation line starts with whitespace *) 128 + Log.debug (fun m -> m "Handling obs-fold continuation for header %s" name); 129 + Read.skip_while is_ows r; 130 + let continuation = Read.line r in 131 + (* Replace obs-fold with single space and continue *) 132 + collect_obs_fold (acc ^ " " ^ String.trim continuation) 133 + | _ -> acc 134 + in 135 + let full_value = collect_obs_fold value in 136 + (String.lowercase_ascii name, String.trim full_value) 120 137 end 121 138 122 139 (** Parse all headers with size and count limits *) ··· 152 169 loop [] 0 153 170 154 171 (** {1 Body Parsing} *) 172 + 173 + (** Read body until connection close (close-delimited message). 174 + Per RFC 9112 Section 6.3 item 8: When no Transfer-Encoding or Content-Length 175 + is present, the body length is determined by reading until connection close. *) 176 + let close_delimited_body ~limits r = 177 + let max_body = Response_limits.max_response_body_size limits in 178 + Log.debug (fun m -> m "Reading close-delimited body (until EOF)"); 179 + 180 + let buf = Buffer.create 8192 in 181 + let bytes_read = ref 0L in 182 + 183 + let rec read_until_eof () = 184 + (* Check size limit *) 185 + if !bytes_read > max_body then 186 + raise (Error.err (Error.Body_too_large { 187 + limit = max_body; 188 + actual = Some !bytes_read 189 + })); 190 + 191 + (* Try to read a chunk - at_end_of_input returns true when EOF reached *) 192 + if Read.at_end_of_input r then 193 + Buffer.contents buf 194 + else begin 195 + (* Read up to 8KB at a time *) 196 + let chunk = Read.take_while (fun _ -> true) r in 197 + let chunk_len = String.length chunk in 198 + if chunk_len > 0 then begin 199 + Buffer.add_string buf chunk; 200 + bytes_read := Int64.add !bytes_read (Int64.of_int chunk_len); 201 + read_until_eof () 202 + end else 203 + (* No more data available *) 204 + Buffer.contents buf 205 + end 206 + in 207 + read_until_eof () 155 208 156 209 (** Read a fixed-length body with size limit checking *) 157 210 let fixed_body ~limits ~length r = ··· 374 427 let ops = Eio.Flow.Pi.source (module Chunked_body_source) in 375 428 Eio.Resource.T (t, ops) 376 429 430 + (** A flow source that reads until connection close (close-delimited). 431 + Per RFC 9112 Section 6.3 item 8: When no Transfer-Encoding or Content-Length 432 + is present, the body length is determined by reading until connection close. *) 433 + module Close_delimited_source = struct 434 + type t = { 435 + buf_read : Read.t; 436 + mutable total_read : int64; 437 + max_body_size : int64; 438 + mutable eof : bool; 439 + } 440 + 441 + let single_read t dst = 442 + if t.eof then raise End_of_file; 443 + 444 + (* Check size limit *) 445 + if t.total_read > t.max_body_size then 446 + raise (Error.err (Error.Body_too_large { 447 + limit = t.max_body_size; 448 + actual = Some t.total_read 449 + })); 450 + 451 + if Read.at_end_of_input t.buf_read then begin 452 + t.eof <- true; 453 + raise End_of_file 454 + end; 455 + 456 + let to_read = min (Cstruct.length dst) 8192 in 457 + (* Try to ensure data is available, but don't fail on EOF *) 458 + (try Read.ensure t.buf_read 1 with End_of_file -> 459 + t.eof <- true; 460 + raise End_of_file); 461 + 462 + let src = Read.peek t.buf_read in 463 + let available = Cstruct.length src in 464 + if available = 0 then begin 465 + t.eof <- true; 466 + raise End_of_file 467 + end; 468 + 469 + let actual = min to_read available in 470 + Cstruct.blit src 0 dst 0 actual; 471 + Read.consume t.buf_read actual; 472 + t.total_read <- Int64.add t.total_read (Int64.of_int actual); 473 + actual 474 + 475 + let read_methods = [] 476 + end 477 + 478 + let close_delimited_body_stream ~limits buf_read = 479 + let t = { 480 + Close_delimited_source.buf_read; 481 + total_read = 0L; 482 + max_body_size = Response_limits.max_response_body_size limits; 483 + eof = false; 484 + } in 485 + let ops = Eio.Flow.Pi.source (module Close_delimited_source) in 486 + Eio.Resource.T (t, ops) 487 + 377 488 (** {1 High-level Response Parsing} *) 378 489 379 490 (** Check if response should have no body per ··· 441 552 Log.warn (fun m -> m "Unsupported transfer-encoding: %s, assuming no body" te); 442 553 "" 443 554 | None -> 444 - Log.debug (fun m -> m "No body indicated"); 445 - "") 555 + (* RFC 9112 Section 6.3 item 8: If no Transfer-Encoding or Content-Length, 556 + the body length is determined by reading until connection close. 557 + This is common for HTTP/1.0 responses. *) 558 + Log.debug (fun m -> m "No length indicators, reading until connection close"); 559 + close_delimited_body ~limits r) 446 560 in 447 561 (version, status, hdrs, body) 448 562 ··· 485 599 Log.warn (fun m -> m "Unsupported transfer-encoding: %s, assuming no body" te); 486 600 `None 487 601 | None -> 488 - Log.debug (fun m -> m "No body indicated"); 489 - `None) 602 + (* RFC 9112 Section 6.3 item 8: If no Transfer-Encoding or Content-Length, 603 + the body length is determined by reading until connection close. *) 604 + Log.debug (fun m -> m "Creating close-delimited body stream"); 605 + `Stream (close_delimited_body_stream ~limits r)) 490 606 in 491 607 492 608 { http_version = version; status; headers = hdrs; body }

+13 -6

lib/http_write.ml

··· 26 26 27 27 let request_line w ~method_ ~uri = 28 28 let path = Uri.path uri in 29 - let path = if path = "" then "/" else path in 30 - let query = Uri.query uri in 31 - let path_with_query = 32 - if query = [] then path 33 - else path ^ "?" ^ (Uri.encoded_of_query query) 29 + (* RFC 9112 Section 3.2.4: asterisk-form for server-wide OPTIONS requests. 30 + When path is "*", use asterisk-form instead of origin-form. 31 + Example: OPTIONS * HTTP/1.1 *) 32 + let request_target = 33 + if path = "*" && method_ = "OPTIONS" then 34 + "*" 35 + else begin 36 + let path = if path = "" then "/" else path in 37 + let query = Uri.query uri in 38 + if query = [] then path 39 + else path ^ "?" ^ (Uri.encoded_of_query query) 40 + end 34 41 in 35 42 Write.string w method_; 36 43 sp w; 37 - Write.string w path_with_query; 44 + Write.string w request_target; 38 45 Write.string w " HTTP/1.1"; 39 46 crlf w 40 47

+50 -17

lib/requests.ml

··· 425 425 let response = 426 426 427 427 (* Execute request with redirect handling 428 - headers_for_request: the headers to use for this specific request (may have auth stripped) *) 429 - let rec make_with_redirects ~headers_for_request url_to_fetch redirects_left = 428 + headers_for_request: the headers to use for this specific request (may have auth stripped) 429 + ~method_: the HTTP method for this request (may be changed by 303 redirect) 430 + ~body: the request body (may be stripped by 303 redirect) *) 431 + let rec make_with_redirects ~headers_for_request ~method_ ~body url_to_fetch redirects_left = 430 432 let uri_to_fetch = Uri.of_string url_to_fetch in 431 433 432 434 (* Parse the redirect URL to get correct host and port *) ··· 501 503 ~clock:t.clock 502 504 ~sw:t.sw 503 505 ~method_ ~uri:uri_to_fetch 504 - ~headers:headers_with_cookies ~body:request_body 506 + ~headers:headers_with_cookies ~body 505 507 ~auto_decompress:t.auto_decompress flow 506 508 ) 507 509 ··· 515 517 (* Write request using absolute-URI form *) 516 518 Http_write.write_and_flush flow (fun w -> 517 519 Http_write.request_via_proxy w ~sw:t.sw ~method_ ~uri:uri_to_fetch 518 - ~headers:headers_with_cookies ~body:request_body 520 + ~headers:headers_with_cookies ~body 519 521 ~proxy_auth:proxy.Proxy.auth 520 522 ); 521 523 (* Read response *) ··· 551 553 ~clock:t.clock 552 554 ~sw:t.sw 553 555 ~method_ ~uri:uri_to_fetch 554 - ~headers:headers_with_cookies ~body:request_body 556 + ~headers:headers_with_cookies ~body 555 557 ~auto_decompress:t.auto_decompress tunnel_flow 556 558 557 559 | true, _, None -> ··· 562 564 ~clock:t.clock 563 565 ~sw:t.sw 564 566 ~method_ ~uri:uri_to_fetch 565 - ~headers:headers_with_cookies ~body:request_body 567 + ~headers:headers_with_cookies ~body 566 568 ~auto_decompress:t.auto_decompress flow 567 569 ) 568 570 in ··· 630 632 Redirect.strip_sensitive_headers headers_for_request 631 633 end 632 634 in 633 - make_with_redirects ~headers_for_request:headers_for_redirect absolute_location (redirects_left - 1) 635 + (* RFC 9110 Section 15.4.4: For 303 See Other, change method to GET 636 + "A user agent can perform a retrieval request targeting that URI 637 + (a GET or HEAD request if using HTTP)" *) 638 + let redirect_method, redirect_body = 639 + if status = 303 then begin 640 + match method_ with 641 + | `POST | `PUT | `DELETE | `PATCH -> 642 + Log.debug (fun m -> m "303 redirect: changing %s to GET and stripping body" 643 + (Method.to_string method_)); 644 + (`GET, Body.empty) 645 + | _ -> (method_, body) 646 + end else 647 + (method_, body) 648 + in 649 + make_with_redirects ~headers_for_request:headers_for_redirect 650 + ~method_:redirect_method ~body:redirect_body 651 + absolute_location (redirects_left - 1) 634 652 end else 635 653 (status, resp_headers, response_body_str, url_to_fetch) 636 654 in 637 655 638 656 let max_redir = Option.value max_redirects ~default:t.max_redirects in 639 657 let final_status, final_headers, final_body_str, final_url = 640 - make_with_redirects ~headers_for_request:base_headers url max_redir 658 + make_with_redirects ~headers_for_request:base_headers 659 + ~method_ ~body:request_body url max_redir 641 660 in 642 661 643 662 let elapsed = Unix.gettimeofday () -. start_time in ··· 676 695 677 696 response 678 697 679 - (* Helper to handle Digest authentication 401 challenge *) 698 + (* Helper to handle Digest authentication challenges (401 and 407). 699 + Per RFC 7235: 401 uses WWW-Authenticate/Authorization headers, 700 + 407 uses Proxy-Authenticate/Proxy-Authorization headers. *) 680 701 let handle_digest_auth (T t as wrapped_t) ~headers ~body ~auth ~timeout ~follow_redirects ~max_redirects ~method_ ~url response = 681 - (* Check if we got a 401 and have Digest auth configured *) 702 + let status = Response.status_code response in 682 703 let auth_to_use = match auth with Some a -> a | None -> Option.value t.auth ~default:Auth.none in 683 - if Response.status_code response = 401 && Auth.is_digest auth_to_use then begin 704 + (* Handle both 401 Unauthorized and 407 Proxy Authentication Required *) 705 + let is_auth_challenge = (status = 401 || status = 407) && Auth.is_digest auth_to_use in 706 + if is_auth_challenge then begin 684 707 match Auth.get_digest_credentials auth_to_use with 685 708 | Some (username, password) -> 686 - (match Response.header "www-authenticate" response with 709 + (* RFC 7235: 401 uses WWW-Authenticate, 407 uses Proxy-Authenticate *) 710 + let challenge_header = if status = 401 then "www-authenticate" else "proxy-authenticate" in 711 + let auth_header_name = if status = 401 then "Authorization" else "Proxy-Authorization" in 712 + (match Response.header challenge_header response with 687 713 | Some www_auth -> 688 714 (match Auth.parse_www_authenticate www_auth with 689 715 | Some challenge -> 690 - Log.info (fun m -> m "Received Digest challenge, retrying with authentication"); 716 + Log.info (fun m -> m "Received %s challenge (status %d), retrying with authentication" 717 + (if status = 401 then "Digest" else "Proxy Digest") status); 691 718 let uri = Uri.of_string url in 692 719 let uri_path = Uri.path uri in 693 720 let uri_path = if uri_path = "" then "/" else uri_path in 694 721 (* Apply digest auth to headers with nonce counter for replay protection *) 695 722 let base_headers = Option.value headers ~default:Headers.empty in 696 - let auth_headers = Auth.apply_digest 723 + (* Build the Authorization/Proxy-Authorization value manually *) 724 + let auth_value = Auth.apply_digest 697 725 ~nonce_counter:t.nonce_counter 698 726 ~username ~password 699 727 ~method_:(Method.to_string method_) 700 728 ~uri:uri_path 701 729 ~challenge 702 - base_headers 730 + Headers.empty 731 + in 732 + (* Get the auth value and set it on the correct header name *) 733 + let auth_headers = match Headers.get "Authorization" auth_value with 734 + | Some v -> Headers.set auth_header_name v base_headers 735 + | None -> base_headers 703 736 in 704 737 (* Retry with Digest auth - use Auth.none to prevent double-application *) 705 738 make_request_internal wrapped_t ~headers:auth_headers ?body ~auth:Auth.none ?timeout 706 739 ?follow_redirects ?max_redirects ~method_ url 707 740 | None -> 708 - Log.warn (fun m -> m "Could not parse Digest challenge from WWW-Authenticate"); 741 + Log.warn (fun m -> m "Could not parse Digest challenge from %s" challenge_header); 709 742 response) 710 743 | None -> 711 - Log.warn (fun m -> m "401 response has no WWW-Authenticate header"); 744 + Log.warn (fun m -> m "%d response has no %s header" status challenge_header); 712 745 response) 713 746 | None -> response 714 747 end else

+4 -4

lib/retry.ml

··· 130 130 Log.debug (fun m -> m "Retry-After is %d seconds" seconds); 131 131 Some (float_of_int seconds) 132 132 | None -> 133 - (* Try to parse as HTTP date (RFC 3339 format) *) 134 - match Ptime.of_rfc3339 value with 135 - | Ok (time, _tz_offset, _tz_string) -> 133 + (* Try to parse as HTTP-date (IMF-fixdate per RFC 9110 Section 5.6.7) *) 134 + match Http_date.parse value with 135 + | Some time -> 136 136 let now = Unix.time () in 137 137 let target = Ptime.to_float_s time in 138 138 let delay = max 0.0 (target -. now) in 139 139 Log.debug (fun m -> m "Retry-After is HTTP date, delay=%.2f seconds" delay); 140 140 Some delay 141 - | Error _ -> 141 + | None -> 142 142 Log.warn (fun m -> m "Failed to parse Retry-After header: %s" value); 143 143 None 144 144 in