A batteries included HTTP/1.1 client in OCaml

more

+265 -148
+46
lib/expect_continue.ml
··· 1 + (*--------------------------------------------------------------------------- 2 + Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved. 3 + SPDX-License-Identifier: ISC 4 + ---------------------------------------------------------------------------*) 5 + 6 + (** HTTP 100-Continue configuration 7 + 8 + Configuration for the HTTP 100-Continue protocol, which allows clients 9 + to check if the server will accept a request before sending a large body. 10 + Per RFC 9110 Section 10.1.1 (Expect) and Section 15.2.1 (100 Continue). *) 11 + 12 + type t = { 13 + enabled : bool; 14 + threshold : int64; 15 + timeout : float; 16 + } 17 + 18 + let default = { 19 + enabled = true; 20 + threshold = 1_048_576L; (* 1MB *) 21 + timeout = 1.0; (* 1 second *) 22 + } 23 + 24 + let make ?(enabled = true) ?(threshold = 1_048_576L) ?(timeout = 1.0) () = 25 + { enabled; threshold; timeout } 26 + 27 + let disabled = { enabled = false; threshold = 0L; timeout = 0.0 } 28 + 29 + let enabled t = t.enabled 30 + let threshold t = t.threshold 31 + let timeout t = t.timeout 32 + 33 + let should_use t body_size = 34 + t.enabled && body_size >= t.threshold 35 + 36 + let pp fmt t = 37 + Format.fprintf fmt "@[<v 2>Expect_continue {@ \ 38 + enabled: %b@ \ 39 + threshold: %Ld bytes@ \ 40 + timeout: %.2fs@ \ 41 + }@]" 42 + t.enabled 43 + t.threshold 44 + t.timeout 45 + 46 + let to_string t = Format.asprintf "%a" pp t
+49
lib/expect_continue.mli
··· 1 + (*--------------------------------------------------------------------------- 2 + Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved. 3 + SPDX-License-Identifier: ISC 4 + ---------------------------------------------------------------------------*) 5 + 6 + (** HTTP 100-Continue configuration 7 + 8 + Configuration for the HTTP 100-Continue protocol, which allows clients 9 + to check if the server will accept a request before sending a large body. 10 + Per RFC 9110 Section 10.1.1 (Expect) and Section 15.2.1 (100 Continue). *) 11 + 12 + type t 13 + (** Abstract type representing HTTP 100-Continue configuration. *) 14 + 15 + val default : t 16 + (** Default configuration: 17 + - enabled: true 18 + - threshold: 1MB 19 + - timeout: 1.0s *) 20 + 21 + val make : 22 + ?enabled:bool -> 23 + ?threshold:int64 -> 24 + ?timeout:float -> 25 + unit -> t 26 + (** Create custom 100-Continue configuration. All parameters are optional 27 + and default to the values in {!default}. *) 28 + 29 + val disabled : t 30 + (** Configuration with 100-Continue disabled. *) 31 + 32 + val enabled : t -> bool 33 + (** Whether 100-continue is enabled. *) 34 + 35 + val threshold : t -> int64 36 + (** Body size threshold in bytes to trigger 100-continue. *) 37 + 38 + val timeout : t -> float 39 + (** Timeout in seconds to wait for 100 response. *) 40 + 41 + val should_use : t -> int64 -> bool 42 + (** [should_use t body_size] returns [true] if 100-continue should be used 43 + for a request with the given [body_size]. *) 44 + 45 + val pp : Format.formatter -> t -> unit 46 + (** Pretty-printer for 100-Continue configuration. *) 47 + 48 + val to_string : t -> string 49 + (** Convert configuration to a human-readable string. *)
+17 -18
lib/http_client.ml
··· 9 9 {!Http_read} for response parsing, leveraging Eio's Buf_write and Buf_read 10 10 for efficient I/O. 11 11 12 - Types are imported from {!Http_types} and re-exported for API convenience. *) 12 + Types are imported from domain-specific modules ({!Response_limits}, 13 + {!Expect_continue}) and re-exported for API convenience. *) 13 14 14 15 let src = Logs.Src.create "requests.http_client" ~doc:"Low-level HTTP client" 15 16 module Log = (val Logs.src_log src : Logs.LOG) 16 17 17 18 (** {1 Types} 18 19 19 - Re-exported from {!Http_types} for API convenience. 20 - We open Http_types to bring record field names into scope. *) 21 - 22 - open Http_types 20 + Re-exported from domain-specific modules for API convenience. *) 23 21 24 - type limits = Http_types.limits 25 - let default_limits = Http_types.default_limits 22 + type limits = Response_limits.t 23 + let default_limits = Response_limits.default 26 24 27 - type expect_100_config = Http_types.expect_100_config 28 - let default_expect_100_config = Http_types.default_expect_100_config 25 + type expect_100_config = Expect_continue.t 26 + let default_expect_100_config = Expect_continue.default 29 27 30 28 (** {1 Decompression Support} *) 31 29 ··· 119 117 let check_decompression_limits ~limits ~compressed_size decompressed = 120 118 let decompressed_size = Int64.of_int (String.length decompressed) in 121 119 let compressed_size_i64 = Int64.of_int compressed_size in 120 + let max_decompressed = Response_limits.max_decompressed_size limits in 122 121 123 122 (* Check absolute size *) 124 - if decompressed_size > limits.max_decompressed_size then begin 123 + if decompressed_size > max_decompressed then begin 125 124 let ratio = Int64.to_float decompressed_size /. Int64.to_float compressed_size_i64 in 126 125 raise (Error.err (Error.Decompression_bomb { 127 - limit = limits.max_decompressed_size; 126 + limit = max_decompressed; 128 127 ratio 129 128 })) 130 129 end; ··· 132 131 (* Check ratio - only if compressed size is > 0 to avoid division by zero *) 133 132 if compressed_size > 0 then begin 134 133 let ratio = Int64.to_float decompressed_size /. Int64.to_float compressed_size_i64 in 135 - if ratio > limits.max_compression_ratio then 134 + if ratio > Response_limits.max_compression_ratio limits then 136 135 raise (Error.err (Error.Decompression_bomb { 137 - limit = limits.max_decompressed_size; 136 + limit = max_decompressed; 138 137 ratio 139 138 })) 140 139 end; ··· 281 280 282 281 (* Determine if we should use 100-continue *) 283 282 let use_100_continue = 284 - expect_100.enabled && 285 - body_len >= expect_100.threshold && 283 + Expect_continue.enabled expect_100 && 284 + body_len >= Expect_continue.threshold expect_100 && 286 285 body_len > 0L && 287 286 not (Headers.mem "expect" headers) (* Don't override explicit Expect header *) 288 287 in ··· 290 289 if not use_100_continue then begin 291 290 (* Standard request without 100-continue *) 292 291 Log.debug (fun m -> m "100-continue not used (body_len=%Ld, threshold=%Ld, enabled=%b)" 293 - body_len expect_100.threshold expect_100.enabled); 292 + body_len (Expect_continue.threshold expect_100) (Expect_continue.enabled expect_100)); 294 293 make_request ~limits ~sw ~method_ ~uri ~headers ~body flow 295 294 end else begin 296 295 Log.info (fun m -> m "Using 100-continue for large body (%Ld bytes)" body_len); ··· 311 310 (* Wait for 100 Continue or error response with timeout *) 312 311 let result = 313 312 try 314 - Eio.Time.with_timeout_exn clock expect_100.timeout (fun () -> 315 - wait_for_100_continue ~limits ~timeout:expect_100.timeout flow 313 + Eio.Time.with_timeout_exn clock (Expect_continue.timeout expect_100) (fun () -> 314 + wait_for_100_continue ~limits ~timeout:(Expect_continue.timeout expect_100) flow 316 315 ) 317 316 with Eio.Time.Timeout -> 318 317 Log.debug (fun m -> m "100-continue timeout expired, sending body anyway");
+21 -18
lib/http_read.ml
··· 13 13 14 14 module Read = Eio.Buf_read 15 15 16 - (** Import limits from Http_types - the single source of truth. 17 - We open Http_types to bring record field names into scope. *) 18 - open Http_types 19 - type limits = Http_types.limits 16 + (** Import limits from Response_limits module. *) 17 + type limits = Response_limits.t 20 18 21 19 (** {1 Character Predicates} *) 22 20 ··· 109 107 110 108 (** Parse all headers with size and count limits *) 111 109 let headers ~limits r = 110 + let max_count = Response_limits.max_header_count limits in 111 + let max_size = Response_limits.max_header_size limits in 112 112 let rec loop acc count = 113 113 (* Check header count limit *) 114 - if count >= limits.max_header_count then 114 + if count >= max_count then 115 115 raise (Error.err (Error.Headers_too_large { 116 - limit = limits.max_header_count; 116 + limit = max_count; 117 117 actual = count + 1 118 118 })); 119 119 ··· 126 126 end else begin 127 127 (* Check header line size limit *) 128 128 let line_len = String.length name + String.length value + 2 in 129 - if line_len > limits.max_header_size then 129 + if line_len > max_size then 130 130 raise (Error.err (Error.Headers_too_large { 131 - limit = limits.max_header_size; 131 + limit = max_size; 132 132 actual = line_len 133 133 })); 134 134 ··· 141 141 142 142 (** Read a fixed-length body with size limit checking *) 143 143 let fixed_body ~limits ~length r = 144 + let max_body = Response_limits.max_response_body_size limits in 144 145 (* Check size limit before allocating *) 145 - if length > limits.max_response_body_size then 146 + if length > max_body then 146 147 raise (Error.err (Error.Body_too_large { 147 - limit = limits.max_response_body_size; 148 + limit = max_body; 148 149 actual = Some length 149 150 })); 150 151 ··· 203 204 (** Read a chunked transfer-encoded body with size limit checking *) 204 205 let chunked_body ~limits r = 205 206 Log.debug (fun m -> m "Reading chunked body"); 207 + let max_body = Response_limits.max_response_body_size limits in 206 208 let buf = Buffer.create 4096 in 207 209 let total_size = ref 0L in 208 210 ··· 217 219 end else begin 218 220 (* Check size limit before reading chunk *) 219 221 let new_total = Int64.add !total_size (Int64.of_int size) in 220 - if new_total > limits.max_response_body_size then 222 + if new_total > max_body then 221 223 raise (Error.err (Error.Body_too_large { 222 - limit = limits.max_response_body_size; 224 + limit = max_body; 223 225 actual = Some new_total 224 226 })); 225 227 ··· 260 262 end 261 263 262 264 let fixed_body_stream ~limits ~length buf_read = 265 + let max_body = Response_limits.max_response_body_size limits in 263 266 (* Check size limit *) 264 - if length > limits.max_response_body_size then 267 + if length > max_body then 265 268 raise (Error.err (Error.Body_too_large { 266 - limit = limits.max_response_body_size; 269 + limit = max_body; 267 270 actual = Some length 268 271 })); 269 272 ··· 283 286 buf_read : Read.t; 284 287 mutable state : state; 285 288 mutable total_read : int64; 286 - limits : limits; 289 + max_body_size : int64; 287 290 } 288 291 289 292 let read_chunk_size t = ··· 315 318 end else begin 316 319 (* Check size limit *) 317 320 let new_total = Int64.add t.total_read (Int64.of_int size) in 318 - if new_total > t.limits.max_response_body_size then 321 + if new_total > t.max_body_size then 319 322 raise (Error.err (Error.Body_too_large { 320 - limit = t.limits.max_response_body_size; 323 + limit = t.max_body_size; 321 324 actual = Some new_total 322 325 })); 323 326 t.state <- Reading_chunk size; ··· 352 355 Chunked_body_source.buf_read; 353 356 state = Reading_size; 354 357 total_read = 0L; 355 - limits 358 + max_body_size = Response_limits.max_response_body_size limits; 356 359 } in 357 360 let ops = Eio.Flow.Pi.source (module Chunked_body_source) in 358 361 Eio.Resource.T (t, ops)
+3 -3
lib/http_read.mli
··· 16 16 17 17 (** {1 Response Limits} 18 18 19 - This module uses {!Http_types.limits} from the shared types module. *) 19 + This module uses {!Response_limits.t} for size limit configuration. *) 20 20 21 - type limits = Http_types.limits 22 - (** Alias for {!Http_types.limits}. See {!Http_types} for field documentation. *) 21 + type limits = Response_limits.t 22 + (** Alias for {!Response_limits.t}. See {!Response_limits} for documentation. *) 23 23 24 24 (** {1 Low-level Parsers} *) 25 25
-48
lib/http_types.ml
··· 1 - (*--------------------------------------------------------------------------- 2 - Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved. 3 - SPDX-License-Identifier: ISC 4 - ---------------------------------------------------------------------------*) 5 - 6 - (** Shared types for HTTP protocol handling 7 - 8 - This module contains type definitions used across the HTTP client modules. 9 - It serves as the single source of truth for types shared between 10 - {!Http_read}, {!Http_write}, and {!Http_client}. *) 11 - 12 - (** {1 Response Limits} 13 - 14 - Per Recommendation #2: Configurable limits for response body size, 15 - header count, and header length to prevent DoS attacks. *) 16 - 17 - type limits = { 18 - max_response_body_size: int64; (** Maximum response body size in bytes (default: 100MB) *) 19 - max_header_size: int; (** Maximum size of a single header line (default: 16KB) *) 20 - max_header_count: int; (** Maximum number of headers (default: 100) *) 21 - max_decompressed_size: int64; (** Maximum decompressed size (default: 100MB) *) 22 - max_compression_ratio: float; (** Maximum compression ratio allowed (default: 100:1) *) 23 - } 24 - 25 - let default_limits = { 26 - max_response_body_size = 104_857_600L; (* 100MB *) 27 - max_header_size = 16_384; (* 16KB *) 28 - max_header_count = 100; 29 - max_decompressed_size = 104_857_600L; (* 100MB *) 30 - max_compression_ratio = 100.0; (* 100:1 *) 31 - } 32 - 33 - (** {1 HTTP 100-Continue Configuration} 34 - 35 - Per Recommendation #7: HTTP 100-Continue Support for Large Uploads. 36 - RFC 9110 Section 10.1.1 (Expect) and Section 15.2.1 (100 Continue) *) 37 - 38 - type expect_100_config = { 39 - enabled : bool; (** Whether to use 100-continue at all *) 40 - threshold : int64; (** Body size threshold to trigger 100-continue (default: 1MB) *) 41 - timeout : float; (** Timeout to wait for 100 response (default: 1.0s) *) 42 - } 43 - 44 - let default_expect_100_config = { 45 - enabled = true; 46 - threshold = 1_048_576L; (* 1MB *) 47 - timeout = 1.0; (* 1 second *) 48 - }
-50
lib/http_types.mli
··· 1 - (*--------------------------------------------------------------------------- 2 - Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved. 3 - SPDX-License-Identifier: ISC 4 - ---------------------------------------------------------------------------*) 5 - 6 - (** Shared types for HTTP protocol handling 7 - 8 - This module contains type definitions used across the HTTP client modules. 9 - It serves as the single source of truth for types shared between 10 - {!Http_read}, {!Http_write}, and {!Http_client}. *) 11 - 12 - (** {1 Response Limits} 13 - 14 - Configurable limits for response body size, header count, and header length 15 - to prevent DoS attacks. *) 16 - 17 - type limits = { 18 - max_response_body_size: int64; (** Maximum response body size in bytes *) 19 - max_header_size: int; (** Maximum size of a single header line *) 20 - max_header_count: int; (** Maximum number of headers *) 21 - max_decompressed_size: int64; (** Maximum decompressed size *) 22 - max_compression_ratio: float; (** Maximum compression ratio allowed *) 23 - } 24 - (** Response size limits to prevent resource exhaustion. *) 25 - 26 - val default_limits : limits 27 - (** Default limits: 28 - - max_response_body_size: 100MB 29 - - max_header_size: 16KB 30 - - max_header_count: 100 31 - - max_decompressed_size: 100MB 32 - - max_compression_ratio: 100:1 *) 33 - 34 - (** {1 HTTP 100-Continue Configuration} 35 - 36 - Configuration for the HTTP 100-Continue protocol, which allows clients 37 - to check if the server will accept a request before sending a large body. *) 38 - 39 - type expect_100_config = { 40 - enabled : bool; (** Whether to use 100-continue at all *) 41 - threshold : int64; (** Body size threshold to trigger 100-continue *) 42 - timeout : float; (** Timeout to wait for 100 response in seconds *) 43 - } 44 - (** Configuration for HTTP 100-Continue support. *) 45 - 46 - val default_expect_100_config : expect_100_config 47 - (** Default configuration: 48 - - enabled: true 49 - - threshold: 1MB 50 - - timeout: 1.0s *)
+6 -5
lib/one.ml
··· 214 214 ~timeout ~verify_tls ~tls_config ~min_tls_version in 215 215 216 216 (* Build expect_100 config *) 217 - let expect_100_config = Http_types.{ 218 - enabled = expect_100_continue; 219 - threshold = expect_100_continue_threshold; 220 - timeout = Option.bind timeout Timeout.expect_100_continue |> Option.value ~default:1.0; 221 - } in 217 + let expect_100_config = Expect_continue.make 218 + ~enabled:expect_100_continue 219 + ~threshold:expect_100_continue_threshold 220 + ~timeout:(Option.bind timeout Timeout.expect_100_continue |> Option.value ~default:1.0) 221 + () 222 + in 222 223 223 224 (* Make HTTP request using low-level client with 100-continue and optional auto-decompression *) 224 225 let status, resp_headers, response_body_str =
+9 -6
lib/requests.ml
··· 21 21 module Error = Error 22 22 module Retry = Retry 23 23 module Cache_control = Cache_control 24 + module Response_limits = Response_limits 25 + module Expect_continue = Expect_continue 24 26 25 27 (** Minimum TLS version configuration. 26 28 Per Recommendation #6: Allow enforcing minimum TLS version. *) ··· 58 60 persist_cookies : bool; 59 61 xdg : Xdge.t option; 60 62 auto_decompress : bool; 61 - expect_100_continue : Http_client.expect_100_config; (** 100-continue configuration *) 63 + expect_100_continue : Expect_continue.t; (** 100-continue configuration *) 62 64 63 65 (* Statistics - mutable but NOTE: when sessions are derived via record update 64 66 syntax ({t with field = value}), these are copied not shared. Each derived ··· 177 179 in 178 180 179 181 (* Build expect_100_continue configuration *) 180 - let expect_100_config = Http_types.{ 181 - enabled = expect_100_continue; 182 - threshold = expect_100_continue_threshold; 183 - timeout = Timeout.expect_100_continue timeout |> Option.value ~default:1.0; 184 - } in 182 + let expect_100_config = Expect_continue.make 183 + ~enabled:expect_100_continue 184 + ~threshold:expect_100_continue_threshold 185 + ~timeout:(Timeout.expect_100_continue timeout |> Option.value ~default:1.0) 186 + () 187 + in 185 188 186 189 T { 187 190 sw;
+6
lib/requests.mli
··· 708 708 (** HTTP Cache-Control header parsing (RFC 9111) *) 709 709 module Cache_control = Cache_control 710 710 711 + (** HTTP response size limits for DoS prevention *) 712 + module Response_limits = Response_limits 713 + 714 + (** HTTP 100-Continue configuration for large uploads *) 715 + module Expect_continue = Expect_continue 716 + 711 717 (** {2 Logging} *) 712 718 713 719 (** Log source for the requests library.
+57
lib/response_limits.ml
··· 1 + (*--------------------------------------------------------------------------- 2 + Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved. 3 + SPDX-License-Identifier: ISC 4 + ---------------------------------------------------------------------------*) 5 + 6 + (** Response limits for HTTP protocol handling 7 + 8 + Configurable limits for response body size, header count, and header length 9 + to prevent DoS attacks. *) 10 + 11 + type t = { 12 + max_response_body_size: int64; 13 + max_header_size: int; 14 + max_header_count: int; 15 + max_decompressed_size: int64; 16 + max_compression_ratio: float; 17 + } 18 + 19 + let default = { 20 + max_response_body_size = 104_857_600L; (* 100MB *) 21 + max_header_size = 16_384; (* 16KB *) 22 + max_header_count = 100; 23 + max_decompressed_size = 104_857_600L; (* 100MB *) 24 + max_compression_ratio = 100.0; (* 100:1 *) 25 + } 26 + 27 + let make 28 + ?(max_response_body_size = 104_857_600L) 29 + ?(max_header_size = 16_384) 30 + ?(max_header_count = 100) 31 + ?(max_decompressed_size = 104_857_600L) 32 + ?(max_compression_ratio = 100.0) 33 + () = 34 + { max_response_body_size; max_header_size; max_header_count; 35 + max_decompressed_size; max_compression_ratio } 36 + 37 + let max_response_body_size t = t.max_response_body_size 38 + let max_header_size t = t.max_header_size 39 + let max_header_count t = t.max_header_count 40 + let max_decompressed_size t = t.max_decompressed_size 41 + let max_compression_ratio t = t.max_compression_ratio 42 + 43 + let pp fmt t = 44 + Format.fprintf fmt "@[<v 2>Response_limits {@ \ 45 + max_response_body_size: %Ld bytes@ \ 46 + max_header_size: %d bytes@ \ 47 + max_header_count: %d@ \ 48 + max_decompressed_size: %Ld bytes@ \ 49 + max_compression_ratio: %.1f:1@ \ 50 + }@]" 51 + t.max_response_body_size 52 + t.max_header_size 53 + t.max_header_count 54 + t.max_decompressed_size 55 + t.max_compression_ratio 56 + 57 + let to_string t = Format.asprintf "%a" pp t
+51
lib/response_limits.mli
··· 1 + (*--------------------------------------------------------------------------- 2 + Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved. 3 + SPDX-License-Identifier: ISC 4 + ---------------------------------------------------------------------------*) 5 + 6 + (** Response limits for HTTP protocol handling 7 + 8 + Configurable limits for response body size, header count, and header length 9 + to prevent DoS attacks. *) 10 + 11 + type t 12 + (** Abstract type representing HTTP response limits. *) 13 + 14 + val default : t 15 + (** Default limits: 16 + - max_response_body_size: 100MB 17 + - max_header_size: 16KB 18 + - max_header_count: 100 19 + - max_decompressed_size: 100MB 20 + - max_compression_ratio: 100:1 *) 21 + 22 + val make : 23 + ?max_response_body_size:int64 -> 24 + ?max_header_size:int -> 25 + ?max_header_count:int -> 26 + ?max_decompressed_size:int64 -> 27 + ?max_compression_ratio:float -> 28 + unit -> t 29 + (** Create custom response limits. All parameters are optional and default 30 + to the values in {!default}. *) 31 + 32 + val max_response_body_size : t -> int64 33 + (** Maximum response body size in bytes. *) 34 + 35 + val max_header_size : t -> int 36 + (** Maximum size of a single header line in bytes. *) 37 + 38 + val max_header_count : t -> int 39 + (** Maximum number of headers allowed. *) 40 + 41 + val max_decompressed_size : t -> int64 42 + (** Maximum decompressed size in bytes. *) 43 + 44 + val max_compression_ratio : t -> float 45 + (** Maximum compression ratio allowed (e.g., 100.0 means 100:1). *) 46 + 47 + val pp : Format.formatter -> t -> unit 48 + (** Pretty-printer for response limits. *) 49 + 50 + val to_string : t -> string 51 + (** Convert response limits to a human-readable string. *)