anil.recoil.org / ocaml-requests
A batteries included HTTP/1.1 client in OCaml
fork atom

Fix HTTP specification compliance issues

Same-origin check (RFC 6454):
- Include port in origin comparison, not just scheme and host
- http://example.com:80 and http://example.com:8080 are now different origins

Digest authentication (RFC 7616):
- Reject unknown algorithms instead of silent MD5 fallback
- Implement -sess algorithm variants (MD5-sess, SHA-256-sess)
with proper session key derivation: HA1 = hash(hash(u:r:p):nonce:cnonce)

HTTP methods (RFC 9110):
- Add request_body_semantics function with Body_required/Optional/Forbidden
- DELETE, OPTIONS, GET now correctly have Body_optional semantics
- Deprecate has_request_body in favor of the more accurate new function

Status codes:
- 501 Not Implemented and 505 HTTP Version Not Supported are no longer
marked as retryable (they indicate permanent conditions)

HTTP/2 (RFC 9113):
- Add SETTINGS_NO_RFC7540_PRIORITIES (0x09) to disable deprecated priorities
- Validate :protocol pseudo-header requires CONNECT method (RFC 8441)

Co-Authored-By: Claude Opus 4.5 <noreply@anthropic.com>

anil.recoil.org 1de09665 05b39128

+98 -11
unified split
+6
lib/core/headers.ml
··· 530 530 (* CONNECT requests don't require :scheme and :path *) 531 531 let is_connect = get_pseudo "method" t = Some "CONNECT" in 532 532 533 + (* :protocol is only valid with CONNECT (RFC 8441 extended CONNECT) *) 534 + let has_protocol = mem_pseudo "protocol" t in 535 + 533 536 if not has_method then 534 537 Error (Missing_pseudo "method") 538 + else if has_protocol && not is_connect then 539 + (* :protocol pseudo-header requires :method to be CONNECT *) 540 + Error (Invalid_pseudo "protocol (requires CONNECT method)") 535 541 else if not is_connect && not has_scheme then 536 542 Error (Missing_pseudo "scheme") 537 543 else if not is_connect && not has_path then
+14
lib/core/method.ml
··· 54 54 | `GET | `HEAD | `PUT | `DELETE | `OPTIONS | `TRACE -> true 55 55 | `POST | `PATCH | `CONNECT | `Other _ -> false 56 56 57 + type body_semantics = 58 + | Body_required 59 + | Body_optional 60 + | Body_forbidden 61 + 62 + let request_body_semantics = function 63 + | `POST | `PUT | `PATCH -> Body_required 64 + | `DELETE | `OPTIONS -> Body_optional 65 + | `GET -> Body_optional (* RFC 9110 Section 9.3.1: GET body has no defined semantics *) 66 + | `HEAD -> Body_forbidden (* RFC 9110 Section 9.3.2: identical to GET but no body in response *) 67 + | `TRACE -> Body_forbidden (* RFC 9110 Section 9.3.8: MUST NOT send body *) 68 + | `CONNECT -> Body_forbidden (* RFC 9110 Section 9.3.6: no body in CONNECT request *) 69 + | `Other _ -> Body_optional (* Unknown methods - allow body for flexibility *) 70 + 57 71 let has_request_body = function 58 72 | `POST | `PUT | `PATCH -> true 59 73 | `GET | `HEAD | `DELETE | `OPTIONS | `CONNECT | `TRACE -> false
+15 -1
lib/core/method.mli
··· 58 58 (** Returns true for idempotent methods (GET, HEAD, PUT, DELETE, OPTIONS, TRACE). 59 59 Idempotent methods can be called multiple times with the same result. *) 60 60 61 + (** Request body semantics per RFC 9110 Section 9.3 *) 62 + type body_semantics = 63 + | Body_required (** Method requires a body (POST, PUT, PATCH) *) 64 + | Body_optional (** Method MAY have a body (DELETE, OPTIONS, GET) *) 65 + | Body_forbidden (** Method MUST NOT have a body (HEAD, TRACE, CONNECT) *) 66 + 67 + val request_body_semantics : t -> body_semantics 68 + (** Returns the request body semantics for a method per RFC 9110. 69 + 70 + - {!Body_required}: POST, PUT, PATCH - body is expected 71 + - {!Body_optional}: DELETE, OPTIONS, GET - body allowed but has no defined semantics 72 + - {!Body_forbidden}: HEAD, TRACE, CONNECT - body MUST NOT be sent *) 73 + 61 74 val has_request_body : t -> bool 62 - (** Returns true for methods that typically have a request body (POST, PUT, PATCH) *) 75 + (** Returns true for methods that typically have a request body (POST, PUT, PATCH). 76 + @deprecated Use {!request_body_semantics} for more accurate RFC 9110 semantics. *) 63 77 64 78 val is_cacheable : t -> bool 65 79 (** Returns true for methods whose responses are cacheable by default (GET, HEAD, POST).
+4 -1
lib/core/status.ml
··· 353 353 | `Bad_gateway 354 354 | `Service_unavailable 355 355 | `Gateway_timeout -> true 356 - | _ -> is_server_error t (* All 5xx errors are generally retryable *) 356 + (* 501 and 505 indicate permanent conditions that won't be fixed by retrying *) 357 + | `Not_implemented -> false (* 501: Server doesn't support the functionality *) 358 + | `Http_version_not_supported -> false (* 505: Protocol version not supported *) 359 + | _ -> is_server_error t (* Other 5xx errors are generally retryable *) 357 360 358 361 let should_retry_on_different_host t = 359 362 match t with
+21 -4
lib/features/auth.ml
··· 214 214 reason = "Digest algorithm SHA-512-256 is not supported. Server should offer SHA-256 or MD5." 215 215 })) 216 216 | other -> 217 - Log.warn (fun m -> m "Unknown digest algorithm '%s', defaulting to MD5" other); 218 - Digestif.MD5.(to_hex (digest_string s)) 217 + (* RFC 7616: Unknown algorithms should be rejected to prevent security downgrades. 218 + Silent fallback to MD5 could mask server misconfigurations. *) 219 + Log.err (fun m -> m "Unknown digest algorithm '%s'" other); 220 + raise (Error.err (Error.Authentication_failed { 221 + url = ""; 222 + reason = Printf.sprintf "Unknown digest algorithm '%s'. Supported: MD5, SHA-256, SHA-512." other 223 + })) 219 224 220 225 (** Generate a random client nonce *) 221 226 let generate_cnonce () = ··· 227 232 in 228 233 String.concat "" (List.init (String.length bytes) (fun i -> hex_of_char bytes.[i])) 229 234 235 + (** Check if algorithm is a -sess variant *) 236 + let is_sess_algorithm algorithm = 237 + let alg = String.uppercase_ascii algorithm in 238 + String.ends_with ~suffix:"-SESS" alg 239 + 230 240 (** Compute digest response according to RFC 7616. 231 241 232 242 @param body Optional request body for auth-int qop (body hash included in HA2) *) 233 243 let compute_digest_response ~username ~password ~method_ ~uri ~challenge ~nc ~cnonce ?body () = 234 244 let algorithm = challenge.algorithm in 235 - (* HA1 = hash(username:realm:password) *) 236 - let ha1 = hash_string ~algorithm 245 + (* HA1 calculation differs for -sess algorithms (RFC 7616 Section 3.4.2) *) 246 + let ha1_base = hash_string ~algorithm 237 247 (Printf.sprintf "%s:%s:%s" username challenge.realm password) in 248 + let ha1 = 249 + if is_sess_algorithm algorithm then 250 + (* For -sess: HA1 = hash(hash(username:realm:password):nonce:cnonce) *) 251 + hash_string ~algorithm (Printf.sprintf "%s:%s:%s" ha1_base challenge.nonce cnonce) 252 + else 253 + ha1_base 254 + in 238 255 (* Determine which qop to use *) 239 256 let selected_qop = match challenge.qop with 240 257 | Some qop ->
+24 -5
lib/features/redirect.ml
··· 13 13 14 14 (** {1 Cross-Origin Detection} *) 15 15 16 + (** Get the effective port for a URI, using default ports for http/https. 17 + Per RFC 6454, the port is part of the origin tuple. *) 18 + let effective_port uri = 19 + match Uri.port uri with 20 + | Some p -> p 21 + | None -> 22 + match Uri.scheme uri with 23 + | Some "https" -> 443 24 + | Some "http" | None -> 80 25 + | Some _ -> 80 (* Default for unknown schemes *) 26 + 16 27 (** Check if two URIs have the same origin for security purposes. 28 + Per RFC 6454 (Web Origin), origins are tuples of (scheme, host, port). 17 29 Used to determine if sensitive headers (Authorization, Cookie) should be 18 30 stripped during redirects. Following Python requests behavior: 19 - - Same host and same scheme = same origin 20 - - http -> https upgrade on same host = allowed (more secure) 31 + - Same host, same scheme, same port = same origin 32 + - http -> https upgrade on same host with default ports = allowed (more secure) 21 33 TODO: Support .netrc for re-acquiring auth credentials on new hosts *) 22 34 let same_origin uri1 uri2 = 23 35 let host1 = Uri.host uri1 |> Option.map String.lowercase_ascii in 24 36 let host2 = Uri.host uri2 |> Option.map String.lowercase_ascii in 25 37 let scheme1 = Uri.scheme uri1 |> Option.value ~default:"http" in 26 38 let scheme2 = Uri.scheme uri2 |> Option.value ~default:"http" in 39 + let port1 = effective_port uri1 in 40 + let port2 = effective_port uri2 in 27 41 match host1, host2 with 28 42 | Some h1, Some h2 when String.equal h1 h2 -> 29 - (* Same host - allow same scheme or http->https upgrade *) 30 - String.equal scheme1 scheme2 || 31 - (scheme1 = "http" && scheme2 = "https") 43 + if String.equal scheme1 scheme2 && port1 = port2 then 44 + (* Same scheme, host, and port = same origin *) 45 + true 46 + else if scheme1 = "http" && scheme2 = "https" && port1 = 80 && port2 = 443 then 47 + (* http->https upgrade on default ports is allowed (more secure) *) 48 + true 49 + else 50 + false 32 51 | _ -> false 33 52 34 53 (** {1 Sensitive Header Protection} *)
+5
lib/h2/h2_connection.ml
··· 76 76 (** SETTINGS_MAX_FRAME_SIZE (0x05): Default 16384, max 16777215. *) 77 77 max_header_list_size : int option; 78 78 (** SETTINGS_MAX_HEADER_LIST_SIZE (0x06): No limit by default. *) 79 + no_rfc7540_priorities : bool; 80 + (** SETTINGS_NO_RFC7540_PRIORITIES (0x09): RFC 9113 deprecates RFC 7540 priorities. *) 79 81 } 80 82 81 83 (** Default settings per RFC 9113. *) ··· 86 88 initial_window_size = 65535; 87 89 max_frame_size = 16384; 88 90 max_header_list_size = None; 91 + no_rfc7540_priorities = false; (* RFC 7540 priorities enabled by default for compatibility *) 89 92 } 90 93 91 94 (** Client-appropriate default settings (no push). *) ··· 130 133 Ok { s with max_frame_size = v } 131 134 | H2_frame.Max_header_list_size v -> 132 135 Ok { s with max_header_list_size = Some v } 136 + | H2_frame.No_rfc7540_priorities v -> 137 + Ok { s with no_rfc7540_priorities = v } 133 138 | H2_frame.Unknown_setting _ -> 134 139 (* Unknown settings MUST be ignored per RFC 9113 *) 135 140 Ok s
+2
lib/h2/h2_connection.mli
··· 86 86 (** SETTINGS_MAX_FRAME_SIZE (default 16384, max 16777215). *) 87 87 max_header_list_size : int option; 88 88 (** SETTINGS_MAX_HEADER_LIST_SIZE (no limit by default). *) 89 + no_rfc7540_priorities : bool; 90 + (** SETTINGS_NO_RFC7540_PRIORITIES (RFC 9113 Section 5.3.2, default false). *) 89 91 } 90 92 91 93 val default_settings : settings
+5
lib/h2/h2_frame.ml
··· 217 217 | Initial_window_size of int32 218 218 | Max_frame_size of int 219 219 | Max_header_list_size of int 220 + | No_rfc7540_priorities of bool (** RFC 9113 Section 5.3.2: Deprecate RFC 7540 priorities *) 220 221 | Unknown_setting of int * int32 221 222 222 223 let setting_to_pair = function ··· 226 227 | Initial_window_size n -> (0x4, n) 227 228 | Max_frame_size n -> (0x5, Int32.of_int n) 228 229 | Max_header_list_size n -> (0x6, Int32.of_int n) 230 + | No_rfc7540_priorities b -> (0x9, if b then 1l else 0l) 229 231 | Unknown_setting (id, value) -> (id, value) 230 232 231 233 let setting_of_pair id value = ··· 236 238 | 0x4 -> Initial_window_size value 237 239 | 0x5 -> Max_frame_size (Int32.to_int value) 238 240 | 0x6 -> Max_header_list_size (Int32.to_int value) 241 + | 0x9 -> No_rfc7540_priorities (value <> 0l) 239 242 | _ -> Unknown_setting (id, value) 240 243 241 244 let pp_setting ppf s = ··· 252 255 Format.fprintf ppf "MAX_FRAME_SIZE=%d" n 253 256 | Max_header_list_size n -> 254 257 Format.fprintf ppf "MAX_HEADER_LIST_SIZE=%d" n 258 + | No_rfc7540_priorities b -> 259 + Format.fprintf ppf "NO_RFC7540_PRIORITIES=%b" b 255 260 | Unknown_setting (id, value) -> 256 261 Format.fprintf ppf "UNKNOWN(%d)=%ld" id value 257 262
+1
lib/h2/h2_frame.mli
··· 176 176 | Initial_window_size of int32 (** 0x04 - Initial flow control window *) 177 177 | Max_frame_size of int (** 0x05 - Maximum frame payload size *) 178 178 | Max_header_list_size of int (** 0x06 - Maximum header list size *) 179 + | No_rfc7540_priorities of bool (** 0x09 - RFC 9113: Deprecate RFC 7540 priorities *) 179 180 | Unknown_setting of int * int32 (** Unknown setting (id, value) *) 180 181 181 182 val setting_to_pair : setting -> int * int32
+1
test/test_h2_client.ml
··· 61 61 initial_window_size = 32768; 62 62 max_frame_size = 32768; 63 63 max_header_list_size = Some 16384; 64 + no_rfc7540_priorities = true; (* RFC 9113: Disable deprecated priorities *) 64 65 } in 65 66 let client = H2_client.create ~settings () in 66 67 let conn = H2_client.connection client in