+22 -58

RECOMMENDATIONS.md

··· 6 6 7 7 This analysis synthesizes recommendations from 40+ HTTP client libraries across 9 programming languages (Python, JavaScript, Go, Rust, Java, PHP, Swift, Haskell, C++) to prioritize enhancements for the OCaml Requests HTTP client library. The recommendations cluster into three key areas: (1) Security & Spec Compliance issues that address vulnerabilities and RFC violations; (2) Feature Enhancements for middleware/interceptor architecture, progress callbacks, retry improvements, and proxy support that are near-universal across mature HTTP clients; (3) Architectural Improvements including connection pool observability and comprehensive timeout configuration. HTTP/2 support and middleware architecture are the most requested feature enhancements, mentioned by over 15 libraries each. 8 8 9 9 + ### Recently Implemented 10 10 + 11 11 + The following features have been implemented and removed from this list: 12 12 + 13 13 + - **HTTP 100-Continue Support** (RFC 9110): Automatic `Expect: 100-continue` for large uploads with configurable threshold and timeout 14 14 + - **Cache-Control Header Parsing** (RFC 9111): Full `Cache_control` module for parsing request/response directives 15 15 + - **Conditional Request Helpers**: `Headers.if_none_match`, `Headers.if_modified_since`, `Response.etag()`, `Response.last_modified()`, and related cache freshness helpers 16 16 + 9 17 10 18 --- 11 19 ··· 121 129 **Implementation Notes:** 122 130 Add optional base_url field to session type. In request methods, use Uri.resolve to combine base with relative URL. Handle trailing slash per RFC 3986 - 'http://api.com/v1/' vs 'http://api.com/v1' have different resolution. 123 131 124 124 - ### 7. Add HTTP 100-Continue Support for Large Uploads 125 125 - 126 126 - Implement Expect: 100-continue protocol to allow servers to reject requests before uploading large bodies. Saves bandwidth for requests that will be rejected based on headers alone (auth failures, quota exceeded). 127 127 - 128 128 - **RFC References:** 129 129 - - RFC 9110 Section 10.1.1 (Expect) 130 130 - - RFC 9110 Section 15.2.1 (100 Continue) 131 131 - 132 132 - **Cross-Language Consensus:** 5 libraries 133 133 - **Source Libraries:** php/guzzle, haskell/http-streams, rust/curl-rust, cpp/webcc, go/req 134 134 - 135 135 - **Affected Files:** 136 136 - - `lib/http_client.ml` 137 137 - - `lib/requests.ml` 138 138 - - `lib/body.ml` 139 139 - 140 140 - **Implementation Notes:** 141 141 - For bodies above threshold (1MB), add Expect: 100-continue header. Send headers, wait for 100 Continue or error response with timeout, then send body. Make threshold and behavior configurable. 142 142 - 143 143 - ### 8. Add Brotli Compression Support 132 132 + ### 7. Add Brotli Compression Support 144 133 145 134 Extend automatic decompression to support Brotli (br) content encoding. Brotli provides 15-25% better compression than gzip and is widely supported by CDNs and modern web servers. 146 135 ··· 157 146 **Implementation Notes:** 158 147 Add 'br' to Accept-Encoding header. Use decompress library's Brotli support (if available) or add brotli OCaml binding. Handle Content-Encoding: br in decompress_body function. 159 148 160 160 - ### 9. Add EventListener/Callback System for Observability 149 149 + ### 8. Add EventListener/Callback System for Observability 161 150 162 151 Implement lifecycle callbacks for HTTP operations: request start/end, DNS resolution, connection events, header/body progress, errors. Enables APM integration, distributed tracing, and custom monitoring without log parsing. 163 152 ··· 172 161 **Implementation Notes:** 173 162 Define event_listener record type with optional callbacks: on_request_start, on_dns_start/end, on_connect_start/end, on_tls_start/end, on_headers_received, on_body_progress, on_request_end, on_error. Invoke at appropriate points in request lifecycle. 174 163 175 175 - ### 10. Add Certificate Pinning Support 164 164 + ### 9. Add Certificate Pinning Support 176 165 177 166 Implement certificate pinning to constrain which TLS certificates are trusted. Protects against CA compromise and MITM attacks by pinning expected certificate public keys per domain. 178 167 ··· 195 184 196 185 ## Architectural Improvements 197 186 198 198 - ### 11. Add Separate Write Timeout Configuration 187 187 + ### 10. Add Separate Write Timeout Configuration 199 188 200 189 Add dedicated write timeout distinct from read timeout. Write stalls indicate different issues than read stalls (client bandwidth vs server processing). Important for detecting upload problems. 201 190 ··· 211 200 **Implementation Notes:** 212 201 Add write_timeout field to Timeout.t (default 5s vs 30s read). Apply during Flow.copy_string and body send operations. Shorter write timeout catches stalled uploads faster. 213 202 214 214 - ### 12. Add Response Body Caching for Multiple Access 203 203 + ### 11. Add Response Body Caching for Multiple Access 215 204 216 205 Cache response body after first read to allow multiple accesses via text(), json(), body(). Currently calling text() then json() fails because the flow is consumed. Match user expectations from other libraries. 217 206 ··· 225 214 **Implementation Notes:** 226 215 Add mutable cached_body field to Response.t. On first text()/body() call, consume flow and store string. Subsequent calls return cached value. Add consume_body() for explicit flow access when streaming is needed. 227 216 228 228 - ### 13. Add Connection Pool Statistics and Monitoring 217 217 + ### 12. Add Connection Pool Statistics and Monitoring 229 218 230 219 Expose connection pool metrics: active connections, idle connections, connection reuse rate, pool efficiency. Essential for performance tuning and diagnosing connection-related issues. 231 220 ··· 239 228 **Implementation Notes:** 240 229 Add pool_stats() function to session that exposes Conpool.stats. Include metrics: connections_created, connections_reused, connections_idle, connections_active, pool_hits, pool_misses. Add to existing statistics record. 241 230 242 242 - ### 14. Add Retry Budget to Prevent Retry Storms 231 231 + ### 13. Add Retry Budget to Prevent Retry Storms 243 232 244 233 Implement token bucket-based retry budget limiting percentage of extra load retries can generate. Prevents cascading failures where retries overwhelm degraded systems. 245 234 ··· 259 248 260 249 ## Feature Enhancements 261 250 262 262 - ### 15. Add HTTP/2 Protocol Support 251 251 + ### 14. Add HTTP/2 Protocol Support 263 252 264 253 Implement HTTP/2 protocol with multiplexed streams, header compression (HPACK), and optional server push. Provides significant performance improvements for applications making concurrent requests to the same host. 265 254 ··· 277 266 **Implementation Notes:** 278 267 Integrate h2 OCaml library for HTTP/2 framing. Add ALPN negotiation during TLS handshake. Support automatic protocol selection (prefer HTTP/2, fallback to HTTP/1.1). Add http_version config option. 279 268 280 280 - ### 16. Add Unix Domain Socket Support 269 269 + ### 15. Add Unix Domain Socket Support 281 270 282 271 Support connecting via Unix domain sockets for communication with local services like Docker daemon, systemd, and other local APIs without TCP overhead. 283 272 ··· 297 286 298 287 ## Feature Enhancements 299 288 300 300 - ### 17. Add Response Caching with RFC 7234 Compliance 289 289 + ### 16. Add Disk-Based Response Caching 301 290 302 302 - Implement disk-based HTTP response caching following RFC 7234 semantics. Respect Cache-Control headers, support conditional requests with ETags, and provide cache statistics. 291 291 + Implement disk-based HTTP response caching with LRU eviction and configurable size limits. The Cache-Control header parsing infrastructure is already in place via the `Cache_control` module. 303 292 304 293 **RFC References:** 305 294 - RFC 7234 (HTTP Caching) ··· 313 302 - `lib/requests.mli` 314 303 315 304 **Implementation Notes:** 316 316 - Add optional cache parameter to session. Implement LRU disk cache with configurable size. Parse Cache-Control headers. Support If-None-Match and If-Modified-Since. Handle 304 Not Modified responses. 305 305 + Add optional cache parameter to session. Implement LRU disk cache with configurable size. The library already provides `Cache_control.parse_response` for parsing Cache-Control headers and `Response.is_cacheable`, `Response.freshness_lifetime`, etc. for determining cacheability. Integrate with existing conditional request helpers (`Headers.if_none_match`, `Headers.if_modified_since`) to handle 304 Not Modified responses. 317 306 318 307 319 308 --- 320 309 321 310 ## Architectural Improvements 322 311 323 323 - ### 18. Add Request ID Correlation for Logging 312 312 + ### 17. Add Request ID Correlation for Logging 324 313 325 314 Assign unique IDs to requests and include in all related log messages. Enables tracing request lifecycle through retries, redirects, and errors in concurrent environments. 326 315 ··· 338 327 339 328 --- 340 329 341 341 - ## Feature Enhancements 342 342 - 343 343 - ### 19. Add Conditional Request Helpers (ETag/Last-Modified) 344 344 - 345 345 - Add convenience methods for HTTP caching headers: Response.etag(), Response.last_modified(), and request helpers for If-None-Match, If-Modified-Since. Simplifies implementing efficient caching patterns. 346 346 - 347 347 - **RFC References:** 348 348 - - RFC 9110 Section 8.8.3 (ETag) 349 349 - - RFC 9110 Section 8.8.2 (Last-Modified) 350 350 - 351 351 - **Cross-Language Consensus:** 3 libraries 352 352 - **Source Libraries:** java/http-request, python/requests, javascript/axios 353 353 - 354 354 - **Affected Files:** 355 355 - - `lib/response.ml` 356 356 - - `lib/response.mli` 357 357 - - `lib/headers.ml` 358 358 - - `lib/requests.ml` 359 359 - 360 360 - **Implementation Notes:** 361 361 - Add Response.etag() and Response.last_modified() helpers to extract headers. Add Headers.if_none_match and Headers.if_modified_since constructors. Parse date headers using Ptime. 362 362 - 363 363 - 364 364 - --- 365 365 - 366 330 ## Architectural Improvements 367 331 368 368 - ### 20. Add HTTPError Body Population for Debugging 332 332 + ### 18. Add HTTPError Body Population for Debugging 369 333 370 334 Automatically capture response body preview (first 1024 bytes) in HTTPError exceptions. Server error responses often contain detailed error messages useful for debugging. 371 335

+95

lib/body.ml

··· 279 279 | Stream _ -> failwith "Cannot convert streaming body to string for connection pooling (body must be materialized first)" 280 280 | File _ -> failwith "Cannot convert file body to string for connection pooling (file must be read first)" 281 281 | Multipart _ -> failwith "Cannot convert multipart body to string for connection pooling (must be encoded first)" 282 282 + 283 283 + let is_empty = function 284 284 + | Empty -> true 285 285 + | _ -> false 286 286 + 287 287 + let is_chunked = function 288 288 + | Empty -> false 289 289 + | String _ -> false 290 290 + | Stream { length = Some _; _ } -> false 291 291 + | Stream { length = None; _ } -> true 292 292 + | File _ -> false 293 293 + | Multipart _ -> true 294 294 + 295 295 + module Write = Eio.Buf_write 296 296 + 297 297 + let crlf w = Write.string w "\r\n" 298 298 + 299 299 + (** Copy from a flow source to the writer *) 300 300 + let write_stream w source = 301 301 + let buf = Cstruct.create 8192 in 302 302 + let rec copy () = 303 303 + match Eio.Flow.single_read source buf with 304 304 + | n -> 305 305 + Write.cstruct w (Cstruct.sub buf 0 n); 306 306 + copy () 307 307 + | exception End_of_file -> () 308 308 + in 309 309 + copy () 310 310 + 311 311 + (** Write a chunk with hex size prefix *) 312 312 + let write_chunk w data len = 313 313 + Write.printf w "%x" len; 314 314 + crlf w; 315 315 + Write.cstruct w (Cstruct.sub data 0 len); 316 316 + crlf w 317 317 + 318 318 + (** Copy from a flow source using chunked transfer encoding *) 319 319 + let write_stream_chunked w source = 320 320 + let buf = Cstruct.create 8192 in 321 321 + let rec copy () = 322 322 + match Eio.Flow.single_read source buf with 323 323 + | n -> 324 324 + write_chunk w buf n; 325 325 + copy () 326 326 + | exception End_of_file -> 327 327 + (* Final chunk *) 328 328 + Write.string w "0"; 329 329 + crlf w; 330 330 + crlf w 331 331 + in 332 332 + copy () 333 333 + 334 334 + let write ~sw w = function 335 335 + | Empty -> () 336 336 + | String { content; _ } -> 337 337 + if content <> "" then Write.string w content 338 338 + | Stream { source; _ } -> 339 339 + write_stream w source 340 340 + | File { file; _ } -> 341 341 + let flow = Eio.Path.open_in ~sw file in 342 342 + write_stream w (flow :> Eio.Flow.source_ty Eio.Resource.t) 343 343 + | Multipart _ as body -> 344 344 + (* For multipart, get the flow source and write it *) 345 345 + (match to_flow_source ~sw body with 346 346 + | Some source -> write_stream w source 347 347 + | None -> ()) 348 348 + 349 349 + let write_chunked ~sw w = function 350 350 + | Empty -> 351 351 + (* Empty body with chunked encoding is just final chunk *) 352 352 + Write.string w "0"; 353 353 + crlf w; 354 354 + crlf w 355 355 + | String { content; _ } -> 356 356 + if content <> "" then begin 357 357 + Write.printf w "%x" (String.length content); 358 358 + crlf w; 359 359 + Write.string w content; 360 360 + crlf w 361 361 + end; 362 362 + Write.string w "0"; 363 363 + crlf w; 364 364 + crlf w 365 365 + | Stream { source; _ } -> 366 366 + write_stream_chunked w source 367 367 + | File { file; _ } -> 368 368 + let flow = Eio.Path.open_in ~sw file in 369 369 + write_stream_chunked w (flow :> Eio.Flow.source_ty Eio.Resource.t) 370 370 + | Multipart _ as body -> 371 371 + (match to_flow_source ~sw body with 372 372 + | Some source -> write_stream_chunked w source 373 373 + | None -> 374 374 + Write.string w "0"; 375 375 + crlf w; 376 376 + crlf w) 282 377 end

+15

lib/body.mli

··· 151 151 (** [to_string body] converts the body to a string for HTTP/1.1 requests. 152 152 Only works for materialized bodies (String type). 153 153 Raises Failure for streaming/file/multipart bodies. *) 154 154 + 155 155 + val is_empty : t -> bool 156 156 + (** [is_empty body] returns true if the body is empty. *) 157 157 + 158 158 + val is_chunked : t -> bool 159 159 + (** [is_chunked body] returns true if the body should use chunked transfer encoding 160 160 + (i.e., it's a stream without known length or a multipart body). *) 161 161 + 162 162 + val write : sw:Eio.Switch.t -> Eio.Buf_write.t -> t -> unit 163 163 + (** [write ~sw w body] writes the body content to the buffer writer. 164 164 + Uses the switch to manage resources like file handles. *) 165 165 + 166 166 + val write_chunked : sw:Eio.Switch.t -> Eio.Buf_write.t -> t -> unit 167 167 + (** [write_chunked ~sw w body] writes the body content using HTTP chunked 168 168 + transfer encoding. Each chunk is prefixed with its hex size. *) 154 169 end

+79 -370

lib/http_client.ml

··· 3 3 SPDX-License-Identifier: ISC 4 4 ---------------------------------------------------------------------------*) 5 5 6 6 - (** Low-level HTTP/1.1 client over raw TCP connections for connection pooling *) 6 6 + (** Low-level HTTP/1.1 client over raw TCP connections for connection pooling 7 7 + 8 8 + This module orchestrates {!Http_write} for request serialization and 9 9 + {!Http_read} for response parsing, leveraging Eio's Buf_write and Buf_read 10 10 + for efficient I/O. 11 11 + 12 12 + Types are imported from {!Http_types} and re-exported for API convenience. *) 7 13 8 14 let src = Logs.Src.create "requests.http_client" ~doc:"Low-level HTTP client" 9 15 module Log = (val Logs.src_log src : Logs.LOG) 10 16 11 11 - (** {1 Response Limits Configuration} 17 17 + (** {1 Types} 12 18 13 13 - Per Recommendation #2: Configurable limits for response body size, 14 14 - header count, and header length to prevent DoS attacks. *) 19 19 + Re-exported from {!Http_types} for API convenience. 20 20 + We open Http_types to bring record field names into scope. *) 15 21 16 16 - type limits = { 17 17 - max_response_body_size: int64; (** Maximum response body size in bytes *) 18 18 - max_header_size: int; (** Maximum size of a single header line *) 19 19 - max_header_count: int; (** Maximum number of headers *) 20 20 - max_decompressed_size: int64; (** Maximum decompressed size *) 21 21 - max_compression_ratio: float; (** Maximum compression ratio allowed *) 22 22 - } 22 22 + open Http_types 23 23 + 24 24 + type limits = Http_types.limits 25 25 + let default_limits = Http_types.default_limits 23 26 24 24 - let default_limits = { 25 25 - max_response_body_size = 104_857_600L; (* 100MB *) 26 26 - max_header_size = 16_384; (* 16KB *) 27 27 - max_header_count = 100; 28 28 - max_decompressed_size = 104_857_600L; (* 100MB *) 29 29 - max_compression_ratio = 100.0; (* 100:1 *) 30 30 - } 27 27 + type expect_100_config = Http_types.expect_100_config 28 28 + let default_expect_100_config = Http_types.default_expect_100_config 31 29 32 30 (** {1 Decompression Support} *) 33 31 ··· 167 165 Log.warn (fun m -> m "Unknown Content-Encoding '%s', returning raw body" other); 168 166 body 169 167 170 170 - (** {1 HTTP 100-Continue Configuration} 171 171 - 172 172 - Per Recommendation #7: HTTP 100-Continue Support for Large Uploads. 173 173 - RFC 9110 Section 10.1.1 (Expect) and Section 15.2.1 (100 Continue) *) 174 174 - 175 175 - type expect_100_config = { 176 176 - enabled : bool; (** Whether to use 100-continue at all *) 177 177 - threshold : int64; (** Body size threshold to trigger 100-continue (default: 1MB) *) 178 178 - timeout : float; (** Timeout to wait for 100 response (default: 1.0s) *) 179 179 - } 180 180 - 181 181 - let default_expect_100_config = { 182 182 - enabled = true; 183 183 - threshold = 1_048_576L; (* 1MB *) 184 184 - timeout = 1.0; (* 1 second *) 185 185 - } 186 186 - 187 187 - (** {1 Request Building} *) 188 188 - 189 189 - (** Build HTTP/1.1 request headers only (no body), for 100-continue flow *) 190 190 - let build_request_headers ~method_ ~uri ~headers ~content_length = 191 191 - let path = Uri.path uri in 192 192 - let path = if path = "" then "/" else path in 193 193 - let query = Uri.query uri in 194 194 - let path_with_query = 195 195 - if query = [] then path 196 196 - else path ^ "?" ^ (Uri.encoded_of_query query) 197 197 - in 198 198 - 199 199 - let host = match Uri.host uri with 200 200 - | Some h -> h 201 201 - | None -> raise (Error.err (Error.Invalid_url { 202 202 - url = Uri.to_string uri; 203 203 - reason = "URI must have a host" 204 204 - })) 205 205 - in 206 206 - 207 207 - (* RFC 7230: default ports should be omitted from Host header *) 208 208 - let port = match Uri.port uri, Uri.scheme uri with 209 209 - | Some p, Some "https" when p <> 443 -> ":" ^ string_of_int p 210 210 - | Some p, Some "http" when p <> 80 -> ":" ^ string_of_int p 211 211 - | Some p, _ -> ":" ^ string_of_int p 212 212 - | None, _ -> "" 213 213 - in 214 214 - 215 215 - (* Build request line *) 216 216 - let request_line = Printf.sprintf "%s %s HTTP/1.1\r\n" method_ path_with_query in 217 217 - 218 218 - (* Ensure Host header is present *) 219 219 - let headers = if not (Headers.mem "host" headers) then 220 220 - Headers.add "host" (host ^ port) headers 221 221 - else headers in 222 222 - 223 223 - (* Ensure Connection header for keep-alive *) 224 224 - let headers = if not (Headers.mem "connection" headers) then 225 225 - Headers.add "connection" "keep-alive" headers 226 226 - else headers in 227 227 - 228 228 - (* Add Content-Length if we have a body length *) 229 229 - let headers = match content_length with 230 230 - | Some len when len > 0L && not (Headers.mem "content-length" headers) -> 231 231 - Headers.add "content-length" (Int64.to_string len) headers 232 232 - | _ -> headers 233 233 - in 234 234 - 235 235 - (* Build headers section *) 236 236 - let headers_str = 237 237 - Headers.to_list headers 238 238 - |> List.map (fun (k, v) -> Printf.sprintf "%s: %s\r\n" k v) 239 239 - |> String.concat "" 240 240 - in 241 241 - 242 242 - request_line ^ headers_str ^ "\r\n" 243 243 - 244 244 - (** Build HTTP/1.1 request as a string *) 245 245 - let build_request ~method_ ~uri ~headers ~body_str = 246 246 - let path = Uri.path uri in 247 247 - let path = if path = "" then "/" else path in 248 248 - let query = Uri.query uri in 249 249 - let path_with_query = 250 250 - if query = [] then path 251 251 - else path ^ "?" ^ (Uri.encoded_of_query query) 252 252 - in 253 253 - 254 254 - let host = match Uri.host uri with 255 255 - | Some h -> h 256 256 - | None -> raise (Error.err (Error.Invalid_url { 257 257 - url = Uri.to_string uri; 258 258 - reason = "URI must have a host" 259 259 - })) 260 260 - in 261 261 - 262 262 - (* RFC 7230: default ports should be omitted from Host header *) 263 263 - let port = match Uri.port uri, Uri.scheme uri with 264 264 - | Some p, Some "https" when p <> 443 -> ":" ^ string_of_int p 265 265 - | Some p, Some "http" when p <> 80 -> ":" ^ string_of_int p 266 266 - | Some p, _ -> ":" ^ string_of_int p 267 267 - | None, _ -> "" 268 268 - in 269 269 - 270 270 - (* Build request line *) 271 271 - let request_line = Printf.sprintf "%s %s HTTP/1.1\r\n" method_ path_with_query in 272 272 - 273 273 - (* Ensure Host header is present *) 274 274 - let headers = if not (Headers.mem "host" headers) then 275 275 - Headers.add "host" (host ^ port) headers 276 276 - else headers in 277 277 - 278 278 - (* Ensure Connection header for keep-alive *) 279 279 - let headers = if not (Headers.mem "connection" headers) then 280 280 - Headers.add "connection" "keep-alive" headers 281 281 - else headers in 282 282 - 283 283 - (* Add Content-Length if we have a body *) 284 284 - let headers = 285 285 - if body_str <> "" && not (Headers.mem "content-length" headers) then 286 286 - let len = String.length body_str in 287 287 - Headers.add "content-length" (string_of_int len) headers 288 288 - else headers 289 289 - in 290 290 - 291 291 - (* Build headers section *) 292 292 - let headers_str = 293 293 - Headers.to_list headers 294 294 - |> List.map (fun (k, v) -> Printf.sprintf "%s: %s\r\n" k v) 295 295 - |> String.concat "" 296 296 - in 297 297 - 298 298 - request_line ^ headers_str ^ "\r\n" ^ body_str 299 299 - 300 300 - (** {1 Response Parsing} *) 301 301 - 302 302 - (** Parse HTTP response status line *) 303 303 - let parse_status_line line = 304 304 - match String.split_on_char ' ' line with 305 305 - | "HTTP/1.1" :: code :: _ | "HTTP/1.0" :: code :: _ -> 306 306 - (try int_of_string code 307 307 - with _ -> raise (Error.err (Error.Invalid_request { 308 308 - reason = "Invalid status code: " ^ code 309 309 - }))) 310 310 - | _ -> raise (Error.err (Error.Invalid_request { 311 311 - reason = "Invalid status line: " ^ line 312 312 - })) 313 313 - 314 314 - (** Parse HTTP headers from buffer reader with limits 315 315 - 316 316 - Per Recommendation #2: Enforce header count and size limits *) 317 317 - let parse_headers ~limits buf_read = 318 318 - let rec read_headers acc count = 319 319 - let line = Eio.Buf_read.line buf_read in 320 320 - 321 321 - (* Check for end of headers *) 322 322 - if line = "" then List.rev acc 323 323 - else begin 324 324 - (* Check header count limit *) 325 325 - if count >= limits.max_header_count then 326 326 - raise (Error.err (Error.Headers_too_large { 327 327 - limit = limits.max_header_count; 328 328 - actual = count + 1 329 329 - })); 330 330 - 331 331 - (* Check header line size limit *) 332 332 - if String.length line > limits.max_header_size then 333 333 - raise (Error.err (Error.Headers_too_large { 334 334 - limit = limits.max_header_size; 335 335 - actual = String.length line 336 336 - })); 337 337 - 338 338 - match String.index_opt line ':' with 339 339 - | None -> read_headers acc (count + 1) 340 340 - | Some idx -> 341 341 - let name = String.sub line 0 idx |> String.trim |> String.lowercase_ascii in 342 342 - let value = String.sub line (idx + 1) (String.length line - idx - 1) |> String.trim in 343 343 - read_headers ((name, value) :: acc) (count + 1) 344 344 - end 345 345 - in 346 346 - read_headers [] 0 |> Headers.of_list 347 347 - 348 348 - (** Read body with Content-Length and size limit 349 349 - 350 350 - Per Recommendation #26: Validate Content-Length matches actual body size 351 351 - Per Recommendation #2: Enforce body size limits *) 352 352 - let read_fixed_body ~limits buf_read length = 353 353 - (* Check size limit before allocating *) 354 354 - if length > limits.max_response_body_size then 355 355 - raise (Error.err (Error.Body_too_large { 356 356 - limit = limits.max_response_body_size; 357 357 - actual = Some length 358 358 - })); 359 359 - 360 360 - let buf = Buffer.create (Int64.to_int length) in 361 361 - let bytes_read = ref 0L in 362 362 - 363 363 - let rec read_n remaining = 364 364 - if remaining > 0L then begin 365 365 - let to_read = min 8192 (Int64.to_int remaining) in 366 366 - let chunk = Eio.Buf_read.take to_read buf_read in 367 367 - let chunk_len = String.length chunk in 368 368 - 369 369 - if chunk_len = 0 then 370 370 - (* Connection closed prematurely - Content-Length mismatch *) 371 371 - raise (Error.err (Error.Content_length_mismatch { 372 372 - expected = length; 373 373 - actual = !bytes_read 374 374 - })) 375 375 - else begin 376 376 - Buffer.add_string buf chunk; 377 377 - bytes_read := Int64.add !bytes_read (Int64.of_int chunk_len); 378 378 - read_n (Int64.sub remaining (Int64.of_int chunk_len)) 379 379 - end 380 380 - end 381 381 - in 382 382 - read_n length; 383 383 - Buffer.contents buf 384 384 - 385 385 - (** Read chunked body with size limit 386 386 - 387 387 - Per Recommendation #2: Enforce body size limits *) 388 388 - let read_chunked_body ~limits buf_read = 389 389 - let buf = Buffer.create 4096 in 390 390 - let total_size = ref 0L in 391 391 - 392 392 - let rec read_chunks () = 393 393 - let size_line = Eio.Buf_read.line buf_read in 394 394 - (* Parse hex chunk size, ignore extensions after ';' *) 395 395 - let size_str = match String.index_opt size_line ';' with 396 396 - | Some idx -> String.sub size_line 0 idx 397 397 - | None -> size_line 398 398 - in 399 399 - let chunk_size = int_of_string ("0x" ^ size_str) in 400 400 - 401 401 - if chunk_size = 0 then begin 402 402 - (* Read trailing headers (if any) until empty line *) 403 403 - let rec skip_trailers () = 404 404 - let line = Eio.Buf_read.line buf_read in 405 405 - if line <> "" then skip_trailers () 406 406 - in 407 407 - skip_trailers () 408 408 - end else begin 409 409 - (* Check size limit before reading chunk *) 410 410 - let new_total = Int64.add !total_size (Int64.of_int chunk_size) in 411 411 - if new_total > limits.max_response_body_size then 412 412 - raise (Error.err (Error.Body_too_large { 413 413 - limit = limits.max_response_body_size; 414 414 - actual = Some new_total 415 415 - })); 416 416 - 417 417 - let chunk = Eio.Buf_read.take chunk_size buf_read in 418 418 - Buffer.add_string buf chunk; 419 419 - total_size := new_total; 420 420 - let _crlf = Eio.Buf_read.line buf_read in (* Read trailing CRLF *) 421 421 - read_chunks () 422 422 - end 423 423 - in 424 424 - read_chunks (); 425 425 - Buffer.contents buf 426 426 - 427 168 (** {1 Request Execution} *) 428 169 429 429 - (** Make HTTP request over a pooled connection *) 430 430 - let make_request ?(limits=default_limits) ~method_ ~uri ~headers ~body_str flow = 431 431 - Log.debug (fun m -> m "Making %s request to %s" method_ (Uri.to_string uri)); 432 432 - 433 433 - (* Build and send request *) 434 434 - let request_str = build_request ~method_ ~uri ~headers ~body_str in 435 435 - Eio.Flow.copy_string request_str flow; 436 436 - 437 437 - (* Read and parse response *) 438 438 - let buf_read = Eio.Buf_read.of_flow flow ~max_size:max_int in 439 439 - 440 440 - (* Parse status line *) 441 441 - let status_line = Eio.Buf_read.line buf_read in 442 442 - let status = parse_status_line status_line in 443 443 - 444 444 - Log.debug (fun m -> m "Received response status: %d" status); 445 445 - 446 446 - (* Parse headers with limits *) 447 447 - let resp_headers = parse_headers ~limits buf_read in 448 448 - 449 449 - (* Determine how to read body *) 450 450 - let transfer_encoding = Headers.get "transfer-encoding" resp_headers in 451 451 - let content_length = Headers.get "content-length" resp_headers |> Option.map Int64.of_string in 170 170 + (** Make HTTP request over a pooled connection using Buf_write/Buf_read *) 171 171 + let make_request ?(limits=default_limits) ~sw ~method_ ~uri ~headers ~body flow = 172 172 + Log.debug (fun m -> m "Making %s request to %s" (Method.to_string method_) (Uri.to_string uri)); 452 173 453 453 - let body_str = match transfer_encoding, content_length with 454 454 - | Some te, _ when String.lowercase_ascii te |> String.trim = "chunked" -> 455 455 - Log.debug (fun m -> m "Reading chunked response body"); 456 456 - read_chunked_body ~limits buf_read 457 457 - | _, Some len -> 458 458 - Log.debug (fun m -> m "Reading fixed-length response body (%Ld bytes)" len); 459 459 - read_fixed_body ~limits buf_read len 460 460 - | Some other_te, None -> 461 461 - Log.warn (fun m -> m "Unsupported transfer-encoding: %s, assuming no body" other_te); 462 462 - "" 463 463 - | None, None -> 464 464 - Log.debug (fun m -> m "No body indicated"); 465 465 - "" 466 466 - in 174 174 + (* Write request using Buf_write - use write_and_flush to avoid nested switch issues *) 175 175 + Http_write.write_and_flush flow (fun w -> 176 176 + Http_write.request w ~sw ~method_ ~uri ~headers ~body 177 177 + ); 467 178 468 468 - (status, resp_headers, body_str) 179 179 + (* Read response using Buf_read *) 180 180 + let buf_read = Http_read.of_flow flow ~max_size:max_int in 181 181 + Http_read.response ~limits buf_read 469 182 470 183 (** Make HTTP request with optional auto-decompression *) 471 471 - let make_request_decompress ?(limits=default_limits) ~method_ ~uri ~headers ~body_str ~auto_decompress flow = 472 472 - let (status, resp_headers, body_str) = make_request ~limits ~method_ ~uri ~headers ~body_str flow in 184 184 + let make_request_decompress ?(limits=default_limits) ~sw ~method_ ~uri ~headers ~body ~auto_decompress flow = 185 185 + let (status, resp_headers, body_str) = make_request ~limits ~sw ~method_ ~uri ~headers ~body flow in 473 186 if auto_decompress then 474 187 let body_str = match Headers.get "content-encoding" resp_headers with 475 188 | Some encoding -> decompress_body ~limits ~content_encoding:encoding body_str ··· 505 218 506 219 (** Wait for 100 Continue or error response with timeout. 507 220 Returns Continue, Rejected, or Timeout. *) 508 508 - let wait_for_100_continue ~timeout flow = 509 509 - Log.debug (fun m -> m "Waiting for 100 Continue response (timeout: %.2fs)" timeout); 221 221 + let wait_for_100_continue ~limits ~timeout:_ flow = 222 222 + Log.debug (fun m -> m "Waiting for 100 Continue response"); 510 223 511 511 - (* We need to peek at the response without consuming it fully *) 512 512 - let buf_read = Eio.Buf_read.of_flow flow ~max_size:max_int in 224 224 + let buf_read = Http_read.of_flow flow ~max_size:max_int in 513 225 514 514 - (* Try to read status line with timeout *) 515 226 try 516 516 - (* Peek at available data - if server responds quickly, we'll see it *) 517 517 - let status_line = Eio.Buf_read.line buf_read in 518 518 - let status = parse_status_line status_line in 227 227 + let status = Http_read.status_line buf_read in 519 228 520 229 Log.debug (fun m -> m "Received response status %d while waiting for 100 Continue" status); 521 230 522 231 if status = 100 then begin 523 232 (* 100 Continue - read any headers (usually none) and return Continue *) 524 524 - let _ = parse_headers ~limits:default_limits buf_read in 233 233 + let _ = Http_read.headers ~limits buf_read in 525 234 Log.info (fun m -> m "Received 100 Continue, proceeding with body"); 526 235 Continue 527 236 end else begin 528 237 (* Error response - server rejected based on headers *) 529 238 Log.info (fun m -> m "Server rejected request with status %d before body sent" status); 530 530 - let resp_headers = parse_headers ~limits:default_limits buf_read in 239 239 + let resp_headers = Http_read.headers ~limits buf_read in 531 240 let transfer_encoding = Headers.get "transfer-encoding" resp_headers in 532 241 let content_length = Headers.get "content-length" resp_headers |> Option.map Int64.of_string in 533 242 let body_str = match transfer_encoding, content_length with 534 243 | Some te, _ when String.lowercase_ascii te |> String.trim = "chunked" -> 535 535 - read_chunked_body ~limits:default_limits buf_read 536 536 - | _, Some len -> read_fixed_body ~limits:default_limits buf_read len 244 244 + Http_read.chunked_body ~limits buf_read 245 245 + | _, Some len -> Http_read.fixed_body ~limits ~length:len buf_read 537 246 | _ -> "" 538 247 in 539 248 Rejected (status, resp_headers, body_str) ··· 562 271 ?(limits=default_limits) 563 272 ?(expect_100=default_expect_100_config) 564 273 ~clock 274 274 + ~sw 565 275 ~method_ 566 276 ~uri 567 277 ~headers 568 568 - ~body_str 278 278 + ~body 569 279 flow = 570 570 - let body_len = Int64.of_int (String.length body_str) in 280 280 + let body_len = Body.content_length body |> Option.value ~default:0L in 571 281 572 282 (* Determine if we should use 100-continue *) 573 283 let use_100_continue = 574 284 expect_100.enabled && 575 285 body_len >= expect_100.threshold && 576 576 - body_str <> "" && 286 286 + body_len > 0L && 577 287 not (Headers.mem "expect" headers) (* Don't override explicit Expect header *) 578 288 in 579 289 ··· 581 291 (* Standard request without 100-continue *) 582 292 Log.debug (fun m -> m "100-continue not used (body_len=%Ld, threshold=%Ld, enabled=%b)" 583 293 body_len expect_100.threshold expect_100.enabled); 584 584 - make_request ~limits ~method_ ~uri ~headers ~body_str flow 294 294 + make_request ~limits ~sw ~method_ ~uri ~headers ~body flow 585 295 end else begin 586 296 Log.info (fun m -> m "Using 100-continue for large body (%Ld bytes)" body_len); 587 297 588 588 - (* Add Expect: 100-continue header *) 298 298 + (* Add Expect: 100-continue header and Content-Type if present *) 589 299 let headers_with_expect = Headers.expect_100_continue headers in 590 590 - 591 591 - (* Build and send headers only *) 592 592 - let headers_str = build_request_headers 593 593 - ~method_ ~uri ~headers:headers_with_expect 594 594 - ~content_length:(Some body_len) 300 300 + let headers_with_expect = match Body.content_type body with 301 301 + | Some mime -> Headers.add "content-type" (Mime.to_string mime) headers_with_expect 302 302 + | None -> headers_with_expect 595 303 in 596 596 - Log.debug (fun m -> m "Sending request headers with Expect: 100-continue"); 597 597 - Eio.Flow.copy_string headers_str flow; 304 304 + 305 305 + (* Send headers only using Buf_write *) 306 306 + Http_write.write_and_flush flow (fun w -> 307 307 + Http_write.request_headers_only w ~method_ ~uri 308 308 + ~headers:headers_with_expect ~content_length:(Some body_len) 309 309 + ); 598 310 599 311 (* Wait for 100 Continue or error response with timeout *) 600 312 let result = 601 313 try 602 314 Eio.Time.with_timeout_exn clock expect_100.timeout (fun () -> 603 603 - wait_for_100_continue ~timeout:expect_100.timeout flow 315 315 + wait_for_100_continue ~limits ~timeout:expect_100.timeout flow 604 316 ) 605 317 with Eio.Time.Timeout -> 606 318 Log.debug (fun m -> m "100-continue timeout expired, sending body anyway"); ··· 611 323 | Continue -> 612 324 (* Server said continue - send body and read final response *) 613 325 Log.debug (fun m -> m "Sending body after 100 Continue"); 614 614 - Eio.Flow.copy_string body_str flow; 326 326 + 327 327 + (* Write body *) 328 328 + Http_write.write_and_flush flow (fun w -> 329 329 + if Body.Private.is_empty body then 330 330 + () 331 331 + else if Body.Private.is_chunked body then 332 332 + Body.Private.write_chunked ~sw w body 333 333 + else 334 334 + Body.Private.write ~sw w body 335 335 + ); 615 336 616 337 (* Read final response *) 617 617 - let buf_read = Eio.Buf_read.of_flow flow ~max_size:max_int in 618 618 - let status_line = Eio.Buf_read.line buf_read in 619 619 - let status = parse_status_line status_line in 620 620 - let resp_headers = parse_headers ~limits buf_read in 621 621 - let transfer_encoding = Headers.get "transfer-encoding" resp_headers in 622 622 - let content_length = Headers.get "content-length" resp_headers |> Option.map Int64.of_string in 623 623 - let resp_body_str = match transfer_encoding, content_length with 624 624 - | Some te, _ when String.lowercase_ascii te |> String.trim = "chunked" -> 625 625 - read_chunked_body ~limits buf_read 626 626 - | _, Some len -> read_fixed_body ~limits buf_read len 627 627 - | _ -> "" 628 628 - in 629 629 - (status, resp_headers, resp_body_str) 338 338 + let buf_read = Http_read.of_flow flow ~max_size:max_int in 339 339 + Http_read.response ~limits buf_read 630 340 631 341 | Rejected (status, resp_headers, resp_body_str) -> 632 342 (* Server rejected - return error response without sending body *) ··· 637 347 | Timeout -> 638 348 (* Timeout expired - send body anyway per RFC 9110 *) 639 349 Log.debug (fun m -> m "Sending body after timeout"); 640 640 - Eio.Flow.copy_string body_str flow; 350 350 + 351 351 + (* Write body *) 352 352 + Http_write.write_and_flush flow (fun w -> 353 353 + if Body.Private.is_empty body then 354 354 + () 355 355 + else if Body.Private.is_chunked body then 356 356 + Body.Private.write_chunked ~sw w body 357 357 + else 358 358 + Body.Private.write ~sw w body 359 359 + ); 641 360 642 361 (* Read response *) 643 643 - let buf_read = Eio.Buf_read.of_flow flow ~max_size:max_int in 644 644 - let status_line = Eio.Buf_read.line buf_read in 645 645 - let status = parse_status_line status_line in 646 646 - let resp_headers = parse_headers ~limits buf_read in 647 647 - let transfer_encoding = Headers.get "transfer-encoding" resp_headers in 648 648 - let content_length = Headers.get "content-length" resp_headers |> Option.map Int64.of_string in 649 649 - let resp_body_str = match transfer_encoding, content_length with 650 650 - | Some te, _ when String.lowercase_ascii te |> String.trim = "chunked" -> 651 651 - read_chunked_body ~limits buf_read 652 652 - | _, Some len -> read_fixed_body ~limits buf_read len 653 653 - | _ -> "" 654 654 - in 655 655 - (status, resp_headers, resp_body_str) 362 362 + let buf_read = Http_read.of_flow flow ~max_size:max_int in 363 363 + Http_read.response ~limits buf_read 656 364 end 657 365 658 366 (** Make HTTP request with 100-continue support and optional auto-decompression *) ··· 660 368 ?(limits=default_limits) 661 369 ?(expect_100=default_expect_100_config) 662 370 ~clock 371 371 + ~sw 663 372 ~method_ 664 373 ~uri 665 374 ~headers 666 666 - ~body_str 375 375 + ~body 667 376 ~auto_decompress 668 377 flow = 669 378 let (status, resp_headers, body_str) = 670 670 - make_request_100_continue ~limits ~expect_100 ~clock ~method_ ~uri ~headers ~body_str flow 379 379 + make_request_100_continue ~limits ~expect_100 ~clock ~sw ~method_ ~uri ~headers ~body flow 671 380 in 672 381 if auto_decompress then 673 382 let body_str = match Headers.get "content-encoding" resp_headers with

+425

lib/http_read.ml

··· 1 1 + (*--------------------------------------------------------------------------- 2 2 + Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved. 3 3 + SPDX-License-Identifier: ISC 4 4 + ---------------------------------------------------------------------------*) 5 5 + 6 6 + (** HTTP response parsing using Eio.Buf_read combinators 7 7 + 8 8 + This module provides efficient HTTP/1.1 response parsing using Eio's 9 9 + buffered read API with parser combinators for clean, composable parsing. *) 10 10 + 11 11 + let src = Logs.Src.create "requests.http_read" ~doc:"HTTP response parsing" 12 12 + module Log = (val Logs.src_log src : Logs.LOG) 13 13 + 14 14 + module Read = Eio.Buf_read 15 15 + 16 16 + (** Import limits from Http_types - the single source of truth. 17 17 + We open Http_types to bring record field names into scope. *) 18 18 + open Http_types 19 19 + type limits = Http_types.limits 20 20 + 21 21 + (** {1 Character Predicates} *) 22 22 + 23 23 + (** HTTP version characters: letters, digits, slash, dot *) 24 24 + let is_version_char = function 25 25 + | 'A'..'Z' | 'a'..'z' | '0'..'9' | '/' | '.' -> true 26 26 + | _ -> false 27 27 + 28 28 + (** HTTP status code digits *) 29 29 + let is_digit = function 30 30 + | '0'..'9' -> true 31 31 + | _ -> false 32 32 + 33 33 + (** RFC 9110 token characters for header names *) 34 34 + let is_token_char = function 35 35 + | 'A'..'Z' | 'a'..'z' | '0'..'9' -> true 36 36 + | '!' | '#' | '$' | '%' | '&' | '\'' | '*' | '+' | '-' | '.' -> true 37 37 + | '^' | '_' | '`' | '|' | '~' -> true 38 38 + | _ -> false 39 39 + 40 40 + (** Hex digits for chunk size *) 41 41 + let is_hex_digit = function 42 42 + | '0'..'9' | 'a'..'f' | 'A'..'F' -> true 43 43 + | _ -> false 44 44 + 45 45 + (** Optional whitespace *) 46 46 + let is_ows = function 47 47 + | ' ' | '\t' -> true 48 48 + | _ -> false 49 49 + 50 50 + (** {1 Low-level Parsers} *) 51 51 + 52 52 + let sp = Read.char ' ' 53 53 + 54 54 + let http_version r = 55 55 + Read.take_while is_version_char r 56 56 + 57 57 + let status_code r = 58 58 + let code_str = Read.take_while is_digit r in 59 59 + if String.length code_str <> 3 then 60 60 + raise (Error.err (Error.Invalid_request { 61 61 + reason = "Invalid status code: " ^ code_str 62 62 + })); 63 63 + try int_of_string code_str 64 64 + with _ -> 65 65 + raise (Error.err (Error.Invalid_request { 66 66 + reason = "Invalid status code: " ^ code_str 67 67 + })) 68 68 + 69 69 + let reason_phrase r = 70 70 + Read.line r 71 71 + 72 72 + (** {1 Status Line Parser} *) 73 73 + 74 74 + let status_line r = 75 75 + let version = http_version r in 76 76 + (* Validate HTTP version *) 77 77 + (match version with 78 78 + | "HTTP/1.1" | "HTTP/1.0" -> () 79 79 + | _ -> 80 80 + raise (Error.err (Error.Invalid_request { 81 81 + reason = "Invalid HTTP version: " ^ version 82 82 + }))); 83 83 + sp r; 84 84 + let code = status_code r in 85 85 + sp r; 86 86 + let _reason = reason_phrase r in 87 87 + Log.debug (fun m -> m "Parsed status line: %s %d" version code); 88 88 + code 89 89 + 90 90 + (** {1 Header Parsing} *) 91 91 + 92 92 + (** Parse a single header line. Returns ("", "") for empty line (end of headers). *) 93 93 + let header_line r = 94 94 + let name = Read.take_while is_token_char r in 95 95 + if name = "" then begin 96 96 + (* Empty line - end of headers. Consume the CRLF. *) 97 97 + let line = Read.line r in 98 98 + if line <> "" then 99 99 + raise (Error.err (Error.Invalid_request { 100 100 + reason = "Expected empty line but got: " ^ line 101 101 + })); 102 102 + ("", "") 103 103 + end else begin 104 104 + Read.char ':' r; 105 105 + Read.skip_while is_ows r; 106 106 + let value = Read.line r in 107 107 + (String.lowercase_ascii name, String.trim value) 108 108 + end 109 109 + 110 110 + (** Parse all headers with size and count limits *) 111 111 + let headers ~limits r = 112 112 + let rec loop acc count = 113 113 + (* Check header count limit *) 114 114 + if count >= limits.max_header_count then 115 115 + raise (Error.err (Error.Headers_too_large { 116 116 + limit = limits.max_header_count; 117 117 + actual = count + 1 118 118 + })); 119 119 + 120 120 + let (name, value) = header_line r in 121 121 + 122 122 + if name = "" then begin 123 123 + (* End of headers *) 124 124 + Log.debug (fun m -> m "Parsed %d headers" count); 125 125 + Headers.of_list (List.rev acc) 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 129 + if line_len > limits.max_header_size then 130 130 + raise (Error.err (Error.Headers_too_large { 131 131 + limit = limits.max_header_size; 132 132 + actual = line_len 133 133 + })); 134 134 + 135 135 + loop ((name, value) :: acc) (count + 1) 136 136 + end 137 137 + in 138 138 + loop [] 0 139 139 + 140 140 + (** {1 Body Parsing} *) 141 141 + 142 142 + (** Read a fixed-length body with size limit checking *) 143 143 + let fixed_body ~limits ~length r = 144 144 + (* Check size limit before allocating *) 145 145 + if length > limits.max_response_body_size then 146 146 + raise (Error.err (Error.Body_too_large { 147 147 + limit = limits.max_response_body_size; 148 148 + actual = Some length 149 149 + })); 150 150 + 151 151 + Log.debug (fun m -> m "Reading fixed-length body: %Ld bytes" length); 152 152 + 153 153 + let len_int = Int64.to_int length in 154 154 + let buf = Buffer.create len_int in 155 155 + let bytes_read = ref 0L in 156 156 + 157 157 + let rec read_n remaining = 158 158 + if remaining > 0L then begin 159 159 + let to_read = min 8192 (Int64.to_int remaining) in 160 160 + let chunk = Read.take to_read r in 161 161 + let chunk_len = String.length chunk in 162 162 + 163 163 + if chunk_len = 0 then 164 164 + (* Connection closed prematurely - Content-Length mismatch *) 165 165 + raise (Error.err (Error.Content_length_mismatch { 166 166 + expected = length; 167 167 + actual = !bytes_read 168 168 + })) 169 169 + else begin 170 170 + Buffer.add_string buf chunk; 171 171 + bytes_read := Int64.add !bytes_read (Int64.of_int chunk_len); 172 172 + read_n (Int64.sub remaining (Int64.of_int chunk_len)) 173 173 + end 174 174 + end 175 175 + in 176 176 + read_n length; 177 177 + Buffer.contents buf 178 178 + 179 179 + (** Parse chunk size line (hex size with optional extensions) *) 180 180 + let chunk_size r = 181 181 + let hex_str = Read.take_while is_hex_digit r in 182 182 + if hex_str = "" then 183 183 + raise (Error.err (Error.Invalid_request { 184 184 + reason = "Empty chunk size" 185 185 + })); 186 186 + (* Skip any chunk extensions (after semicolon) *) 187 187 + Read.skip_while (fun c -> c <> '\r' && c <> '\n') r; 188 188 + let _ = Read.line r in (* Consume CRLF *) 189 189 + try int_of_string ("0x" ^ hex_str) 190 190 + with _ -> 191 191 + raise (Error.err (Error.Invalid_request { 192 192 + reason = "Invalid chunk size: " ^ hex_str 193 193 + })) 194 194 + 195 195 + (** Skip trailer headers after final chunk *) 196 196 + let skip_trailers r = 197 197 + let rec loop () = 198 198 + let line = Read.line r in 199 199 + if line <> "" then loop () 200 200 + in 201 201 + loop () 202 202 + 203 203 + (** Read a chunked transfer-encoded body with size limit checking *) 204 204 + let chunked_body ~limits r = 205 205 + Log.debug (fun m -> m "Reading chunked body"); 206 206 + let buf = Buffer.create 4096 in 207 207 + let total_size = ref 0L in 208 208 + 209 209 + let rec read_chunks () = 210 210 + let size = chunk_size r in 211 211 + 212 212 + if size = 0 then begin 213 213 + (* Final chunk - skip trailers *) 214 214 + skip_trailers r; 215 215 + Log.debug (fun m -> m "Chunked body complete: %Ld bytes" !total_size); 216 216 + Buffer.contents buf 217 217 + end else begin 218 218 + (* Check size limit before reading chunk *) 219 219 + let new_total = Int64.add !total_size (Int64.of_int size) in 220 220 + if new_total > limits.max_response_body_size then 221 221 + raise (Error.err (Error.Body_too_large { 222 222 + limit = limits.max_response_body_size; 223 223 + actual = Some new_total 224 224 + })); 225 225 + 226 226 + let chunk = Read.take size r in 227 227 + Buffer.add_string buf chunk; 228 228 + total_size := new_total; 229 229 + let _ = Read.line r in (* Consume trailing CRLF *) 230 230 + read_chunks () 231 231 + end 232 232 + in 233 233 + read_chunks () 234 234 + 235 235 + (** {1 Streaming Body Sources} *) 236 236 + 237 237 + (** A flow source that reads from a Buf_read with a fixed length limit *) 238 238 + module Fixed_body_source = struct 239 239 + type t = { 240 240 + buf_read : Read.t; 241 241 + mutable remaining : int64; 242 242 + } 243 243 + 244 244 + let single_read t dst = 245 245 + if t.remaining <= 0L then raise End_of_file; 246 246 + 247 247 + let to_read = min (Cstruct.length dst) (Int64.to_int (min t.remaining 8192L)) in 248 248 + 249 249 + (* Ensure data is available *) 250 250 + Read.ensure t.buf_read to_read; 251 251 + let src = Read.peek t.buf_read in 252 252 + let actual = min to_read (Cstruct.length src) in 253 253 + 254 254 + Cstruct.blit src 0 dst 0 actual; 255 255 + Read.consume t.buf_read actual; 256 256 + t.remaining <- Int64.sub t.remaining (Int64.of_int actual); 257 257 + actual 258 258 + 259 259 + let read_methods = [] 260 260 + end 261 261 + 262 262 + let fixed_body_stream ~limits ~length buf_read = 263 263 + (* Check size limit *) 264 264 + if length > limits.max_response_body_size then 265 265 + raise (Error.err (Error.Body_too_large { 266 266 + limit = limits.max_response_body_size; 267 267 + actual = Some length 268 268 + })); 269 269 + 270 270 + let t = { Fixed_body_source.buf_read; remaining = length } in 271 271 + let ops = Eio.Flow.Pi.source (module Fixed_body_source) in 272 272 + Eio.Resource.T (t, ops) 273 273 + 274 274 + (** A flow source that reads chunked transfer encoding from a Buf_read *) 275 275 + module Chunked_body_source = struct 276 276 + type state = 277 277 + | Reading_size 278 278 + | Reading_chunk of int 279 279 + | Reading_chunk_end 280 280 + | Done 281 281 + 282 282 + type t = { 283 283 + buf_read : Read.t; 284 284 + mutable state : state; 285 285 + mutable total_read : int64; 286 286 + limits : limits; 287 287 + } 288 288 + 289 289 + let read_chunk_size t = 290 290 + let hex_str = Read.take_while is_hex_digit t.buf_read in 291 291 + if hex_str = "" then 0 292 292 + else begin 293 293 + (* Skip extensions and CRLF *) 294 294 + Read.skip_while (fun c -> c <> '\r' && c <> '\n') t.buf_read; 295 295 + let _ = Read.line t.buf_read in 296 296 + try int_of_string ("0x" ^ hex_str) 297 297 + with _ -> 0 298 298 + end 299 299 + 300 300 + let single_read t dst = 301 301 + let rec aux () = 302 302 + match t.state with 303 303 + | Done -> raise End_of_file 304 304 + | Reading_size -> 305 305 + let size = read_chunk_size t in 306 306 + if size = 0 then begin 307 307 + (* Skip trailers *) 308 308 + let rec skip () = 309 309 + let line = Read.line t.buf_read in 310 310 + if line <> "" then skip () 311 311 + in 312 312 + skip (); 313 313 + t.state <- Done; 314 314 + raise End_of_file 315 315 + end else begin 316 316 + (* Check size limit *) 317 317 + let new_total = Int64.add t.total_read (Int64.of_int size) in 318 318 + if new_total > t.limits.max_response_body_size then 319 319 + raise (Error.err (Error.Body_too_large { 320 320 + limit = t.limits.max_response_body_size; 321 321 + actual = Some new_total 322 322 + })); 323 323 + t.state <- Reading_chunk size; 324 324 + aux () 325 325 + end 326 326 + | Reading_chunk remaining -> 327 327 + let to_read = min (Cstruct.length dst) remaining in 328 328 + Read.ensure t.buf_read to_read; 329 329 + let src = Read.peek t.buf_read in 330 330 + let actual = min to_read (Cstruct.length src) in 331 331 + Cstruct.blit src 0 dst 0 actual; 332 332 + Read.consume t.buf_read actual; 333 333 + t.total_read <- Int64.add t.total_read (Int64.of_int actual); 334 334 + let new_remaining = remaining - actual in 335 335 + if new_remaining = 0 then 336 336 + t.state <- Reading_chunk_end 337 337 + else 338 338 + t.state <- Reading_chunk new_remaining; 339 339 + actual 340 340 + | Reading_chunk_end -> 341 341 + let _ = Read.line t.buf_read in (* Consume trailing CRLF *) 342 342 + t.state <- Reading_size; 343 343 + aux () 344 344 + in 345 345 + aux () 346 346 + 347 347 + let read_methods = [] 348 348 + end 349 349 + 350 350 + let chunked_body_stream ~limits buf_read = 351 351 + let t = { 352 352 + Chunked_body_source.buf_read; 353 353 + state = Reading_size; 354 354 + total_read = 0L; 355 355 + limits 356 356 + } in 357 357 + let ops = Eio.Flow.Pi.source (module Chunked_body_source) in 358 358 + Eio.Resource.T (t, ops) 359 359 + 360 360 + (** {1 High-level Response Parsing} *) 361 361 + 362 362 + (** Parse complete response (status + headers + body) to string *) 363 363 + let response ~limits r = 364 364 + let status = status_line r in 365 365 + let hdrs = headers ~limits r in 366 366 + 367 367 + (* Determine how to read body *) 368 368 + let transfer_encoding = Headers.get "transfer-encoding" hdrs in 369 369 + let content_length = Headers.get "content-length" hdrs |> Option.map Int64.of_string in 370 370 + 371 371 + let body = match transfer_encoding, content_length with 372 372 + | Some te, _ when String.lowercase_ascii te |> String.trim = "chunked" -> 373 373 + Log.debug (fun m -> m "Reading chunked response body"); 374 374 + chunked_body ~limits r 375 375 + | _, Some len -> 376 376 + Log.debug (fun m -> m "Reading fixed-length response body (%Ld bytes)" len); 377 377 + fixed_body ~limits ~length:len r 378 378 + | Some other_te, None -> 379 379 + Log.warn (fun m -> m "Unsupported transfer-encoding: %s, assuming no body" other_te); 380 380 + "" 381 381 + | None, None -> 382 382 + Log.debug (fun m -> m "No body indicated"); 383 383 + "" 384 384 + in 385 385 + 386 386 + (status, hdrs, body) 387 387 + 388 388 + (** Response with streaming body *) 389 389 + type stream_response = { 390 390 + status : int; 391 391 + headers : Headers.t; 392 392 + body : [ `String of string 393 393 + | `Stream of Eio.Flow.source_ty Eio.Resource.t 394 394 + | `None ] 395 395 + } 396 396 + 397 397 + let response_stream ~limits r = 398 398 + let status = status_line r in 399 399 + let hdrs = headers ~limits r in 400 400 + 401 401 + (* Determine body type *) 402 402 + let transfer_encoding = Headers.get "transfer-encoding" hdrs in 403 403 + let content_length = Headers.get "content-length" hdrs |> Option.map Int64.of_string in 404 404 + 405 405 + let body = match transfer_encoding, content_length with 406 406 + | Some te, _ when String.lowercase_ascii te |> String.trim = "chunked" -> 407 407 + Log.debug (fun m -> m "Creating chunked body stream"); 408 408 + `Stream (chunked_body_stream ~limits r) 409 409 + | _, Some len -> 410 410 + Log.debug (fun m -> m "Creating fixed-length body stream (%Ld bytes)" len); 411 411 + `Stream (fixed_body_stream ~limits ~length:len r) 412 412 + | Some other_te, None -> 413 413 + Log.warn (fun m -> m "Unsupported transfer-encoding: %s, assuming no body" other_te); 414 414 + `None 415 415 + | None, None -> 416 416 + Log.debug (fun m -> m "No body indicated"); 417 417 + `None 418 418 + in 419 419 + 420 420 + { status; headers = hdrs; body } 421 421 + 422 422 + (** {1 Convenience Functions} *) 423 423 + 424 424 + let of_flow ?initial_size ~max_size flow = 425 425 + Read.of_flow ?initial_size ~max_size flow

+106

lib/http_read.mli

··· 1 1 + (*--------------------------------------------------------------------------- 2 2 + Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved. 3 3 + SPDX-License-Identifier: ISC 4 4 + ---------------------------------------------------------------------------*) 5 5 + 6 6 + (** HTTP response parsing using Eio.Buf_read combinators 7 7 + 8 8 + This module provides efficient HTTP/1.1 response parsing using Eio's 9 9 + buffered read API with parser combinators for clean, composable parsing. 10 10 + 11 11 + Example: 12 12 + {[ 13 13 + let buf_read = Http_read.of_flow ~max_size:max_int flow in 14 14 + let (status, headers, body) = Http_read.response ~limits buf_read 15 15 + ]} *) 16 16 + 17 17 + (** {1 Response Limits} 18 18 + 19 19 + This module uses {!Http_types.limits} from the shared types module. *) 20 20 + 21 21 + type limits = Http_types.limits 22 22 + (** Alias for {!Http_types.limits}. See {!Http_types} for field documentation. *) 23 23 + 24 24 + (** {1 Low-level Parsers} *) 25 25 + 26 26 + val http_version : Eio.Buf_read.t -> string 27 27 + (** [http_version r] parses HTTP version string (e.g., "HTTP/1.1"). *) 28 28 + 29 29 + val status_code : Eio.Buf_read.t -> int 30 30 + (** [status_code r] parses a 3-digit HTTP status code. 31 31 + @raise Error.t if the status code is invalid. *) 32 32 + 33 33 + val status_line : Eio.Buf_read.t -> int 34 34 + (** [status_line r] parses a complete HTTP status line and returns the status code. 35 35 + Validates that the HTTP version is 1.0 or 1.1. 36 36 + @raise Error.t if the status line is invalid. *) 37 37 + 38 38 + (** {1 Header Parsing} *) 39 39 + 40 40 + val header_line : Eio.Buf_read.t -> string * string 41 41 + (** [header_line r] parses a single header line. 42 42 + Returns [(name, value)] where name is lowercase. 43 43 + Returns [("", "")] for the empty line that terminates headers. *) 44 44 + 45 45 + val headers : limits:limits -> Eio.Buf_read.t -> Headers.t 46 46 + (** [headers ~limits r] parses all headers until the terminating blank line. 47 47 + Enforces header count and size limits. 48 48 + @raise Error.Headers_too_large if limits are exceeded. *) 49 49 + 50 50 + (** {1 Body Parsing} *) 51 51 + 52 52 + val fixed_body : limits:limits -> length:int64 -> Eio.Buf_read.t -> string 53 53 + (** [fixed_body ~limits ~length r] reads exactly [length] bytes as the body. 54 54 + @raise Error.Body_too_large if length exceeds limit. 55 55 + @raise Error.Content_length_mismatch if EOF occurs before all bytes read. *) 56 56 + 57 57 + val chunked_body : limits:limits -> Eio.Buf_read.t -> string 58 58 + (** [chunked_body ~limits r] reads a chunked transfer-encoded body. 59 59 + Handles chunk sizes, extensions, and trailers. 60 60 + @raise Error.Body_too_large if total body size exceeds limit. *) 61 61 + 62 62 + (** {1 Streaming Body Sources} *) 63 63 + 64 64 + val fixed_body_stream : limits:limits -> length:int64 -> 65 65 + Eio.Buf_read.t -> Eio.Flow.source_ty Eio.Resource.t 66 66 + (** [fixed_body_stream ~limits ~length r] creates a flow source that reads 67 67 + [length] bytes from [r]. Useful for large bodies to avoid loading 68 68 + everything into memory at once. *) 69 69 + 70 70 + val chunked_body_stream : limits:limits -> 71 71 + Eio.Buf_read.t -> Eio.Flow.source_ty Eio.Resource.t 72 72 + (** [chunked_body_stream ~limits r] creates a flow source that reads 73 73 + chunked transfer-encoded data from [r]. Decodes chunks on-the-fly. *) 74 74 + 75 75 + (** {1 High-level Response Parsing} *) 76 76 + 77 77 + val response : limits:limits -> Eio.Buf_read.t -> int * Headers.t * string 78 78 + (** [response ~limits r] parses a complete HTTP response including: 79 79 + - Status line (returns status code) 80 80 + - Headers 81 81 + - Body (based on Transfer-Encoding or Content-Length) 82 82 + 83 83 + This reads the entire body into memory. For large responses, 84 84 + use {!response_stream} instead. *) 85 85 + 86 86 + (** {1 Streaming Response} *) 87 87 + 88 88 + type stream_response = { 89 89 + status : int; 90 90 + headers : Headers.t; 91 91 + body : [ `String of string 92 92 + | `Stream of Eio.Flow.source_ty Eio.Resource.t 93 93 + | `None ] 94 94 + } 95 95 + (** A parsed response with optional streaming body. *) 96 96 + 97 97 + val response_stream : limits:limits -> Eio.Buf_read.t -> stream_response 98 98 + (** [response_stream ~limits r] parses status line and headers, then 99 99 + returns a streaming body source instead of reading the body into memory. 100 100 + Use this for large responses. *) 101 101 + 102 102 + (** {1 Convenience Functions} *) 103 103 + 104 104 + val of_flow : ?initial_size:int -> max_size:int -> _ Eio.Flow.source -> Eio.Buf_read.t 105 105 + (** [of_flow ~max_size flow] creates a buffered reader from [flow]. 106 106 + This is a thin wrapper around {!Eio.Buf_read.of_flow}. *)

+48

lib/http_types.ml

··· 1 1 + (*--------------------------------------------------------------------------- 2 2 + Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved. 3 3 + SPDX-License-Identifier: ISC 4 4 + ---------------------------------------------------------------------------*) 5 5 + 6 6 + (** Shared types for HTTP protocol handling 7 7 + 8 8 + This module contains type definitions used across the HTTP client modules. 9 9 + It serves as the single source of truth for types shared between 10 10 + {!Http_read}, {!Http_write}, and {!Http_client}. *) 11 11 + 12 12 + (** {1 Response Limits} 13 13 + 14 14 + Per Recommendation #2: Configurable limits for response body size, 15 15 + header count, and header length to prevent DoS attacks. *) 16 16 + 17 17 + type limits = { 18 18 + max_response_body_size: int64; (** Maximum response body size in bytes (default: 100MB) *) 19 19 + max_header_size: int; (** Maximum size of a single header line (default: 16KB) *) 20 20 + max_header_count: int; (** Maximum number of headers (default: 100) *) 21 21 + max_decompressed_size: int64; (** Maximum decompressed size (default: 100MB) *) 22 22 + max_compression_ratio: float; (** Maximum compression ratio allowed (default: 100:1) *) 23 23 + } 24 24 + 25 25 + let default_limits = { 26 26 + max_response_body_size = 104_857_600L; (* 100MB *) 27 27 + max_header_size = 16_384; (* 16KB *) 28 28 + max_header_count = 100; 29 29 + max_decompressed_size = 104_857_600L; (* 100MB *) 30 30 + max_compression_ratio = 100.0; (* 100:1 *) 31 31 + } 32 32 + 33 33 + (** {1 HTTP 100-Continue Configuration} 34 34 + 35 35 + Per Recommendation #7: HTTP 100-Continue Support for Large Uploads. 36 36 + RFC 9110 Section 10.1.1 (Expect) and Section 15.2.1 (100 Continue) *) 37 37 + 38 38 + type expect_100_config = { 39 39 + enabled : bool; (** Whether to use 100-continue at all *) 40 40 + threshold : int64; (** Body size threshold to trigger 100-continue (default: 1MB) *) 41 41 + timeout : float; (** Timeout to wait for 100 response (default: 1.0s) *) 42 42 + } 43 43 + 44 44 + let default_expect_100_config = { 45 45 + enabled = true; 46 46 + threshold = 1_048_576L; (* 1MB *) 47 47 + timeout = 1.0; (* 1 second *) 48 48 + }

+50

lib/http_types.mli

··· 1 1 + (*--------------------------------------------------------------------------- 2 2 + Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved. 3 3 + SPDX-License-Identifier: ISC 4 4 + ---------------------------------------------------------------------------*) 5 5 + 6 6 + (** Shared types for HTTP protocol handling 7 7 + 8 8 + This module contains type definitions used across the HTTP client modules. 9 9 + It serves as the single source of truth for types shared between 10 10 + {!Http_read}, {!Http_write}, and {!Http_client}. *) 11 11 + 12 12 + (** {1 Response Limits} 13 13 + 14 14 + Configurable limits for response body size, header count, and header length 15 15 + to prevent DoS attacks. *) 16 16 + 17 17 + type limits = { 18 18 + max_response_body_size: int64; (** Maximum response body size in bytes *) 19 19 + max_header_size: int; (** Maximum size of a single header line *) 20 20 + max_header_count: int; (** Maximum number of headers *) 21 21 + max_decompressed_size: int64; (** Maximum decompressed size *) 22 22 + max_compression_ratio: float; (** Maximum compression ratio allowed *) 23 23 + } 24 24 + (** Response size limits to prevent resource exhaustion. *) 25 25 + 26 26 + val default_limits : limits 27 27 + (** Default limits: 28 28 + - max_response_body_size: 100MB 29 29 + - max_header_size: 16KB 30 30 + - max_header_count: 100 31 31 + - max_decompressed_size: 100MB 32 32 + - max_compression_ratio: 100:1 *) 33 33 + 34 34 + (** {1 HTTP 100-Continue Configuration} 35 35 + 36 36 + Configuration for the HTTP 100-Continue protocol, which allows clients 37 37 + to check if the server will accept a request before sending a large body. *) 38 38 + 39 39 + type expect_100_config = { 40 40 + enabled : bool; (** Whether to use 100-continue at all *) 41 41 + threshold : int64; (** Body size threshold to trigger 100-continue *) 42 42 + timeout : float; (** Timeout to wait for 100 response in seconds *) 43 43 + } 44 44 + (** Configuration for HTTP 100-Continue support. *) 45 45 + 46 46 + val default_expect_100_config : expect_100_config 47 47 + (** Default configuration: 48 48 + - enabled: true 49 49 + - threshold: 1MB 50 50 + - timeout: 1.0s *)

+189

lib/http_write.ml

··· 1 1 + (*--------------------------------------------------------------------------- 2 2 + Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved. 3 3 + SPDX-License-Identifier: ISC 4 4 + ---------------------------------------------------------------------------*) 5 5 + 6 6 + (** HTTP request serialization using Eio.Buf_write 7 7 + 8 8 + This module provides efficient HTTP/1.1 request serialization using Eio's 9 9 + buffered write API. It avoids intermediate string allocations by writing 10 10 + directly to the output buffer. *) 11 11 + 12 12 + let src = Logs.Src.create "requests.http_write" ~doc:"HTTP request serialization" 13 13 + module Log = (val Logs.src_log src : Logs.LOG) 14 14 + 15 15 + module Write = Eio.Buf_write 16 16 + 17 17 + (** {1 Low-level Writers} *) 18 18 + 19 19 + let crlf w = 20 20 + Write.string w "\r\n" 21 21 + 22 22 + let sp w = 23 23 + Write.char w ' ' 24 24 + 25 25 + (** {1 Request Line} *) 26 26 + 27 27 + let request_line w ~method_ ~uri = 28 28 + let path = Uri.path uri in 29 29 + let path = if path = "" then "/" else path in 30 30 + let query = Uri.query uri in 31 31 + let path_with_query = 32 32 + if query = [] then path 33 33 + else path ^ "?" ^ (Uri.encoded_of_query query) 34 34 + in 35 35 + Write.string w method_; 36 36 + sp w; 37 37 + Write.string w path_with_query; 38 38 + Write.string w " HTTP/1.1"; 39 39 + crlf w 40 40 + 41 41 + (** {1 Header Writing} *) 42 42 + 43 43 + let header w ~name ~value = 44 44 + Write.string w name; 45 45 + Write.string w ": "; 46 46 + Write.string w value; 47 47 + crlf w 48 48 + 49 49 + let headers w hdrs = 50 50 + Headers.to_list hdrs 51 51 + |> List.iter (fun (name, value) -> header w ~name ~value); 52 52 + crlf w 53 53 + 54 54 + (** Build Host header value from URI *) 55 55 + let host_value uri = 56 56 + let host = match Uri.host uri with 57 57 + | Some h -> h 58 58 + | None -> raise (Error.err (Error.Invalid_url { 59 59 + url = Uri.to_string uri; 60 60 + reason = "URI must have a host" 61 61 + })) 62 62 + in 63 63 + (* RFC 7230: default ports should be omitted from Host header *) 64 64 + match Uri.port uri, Uri.scheme uri with 65 65 + | Some p, Some "https" when p <> 443 -> host ^ ":" ^ string_of_int p 66 66 + | Some p, Some "http" when p <> 80 -> host ^ ":" ^ string_of_int p 67 67 + | Some p, _ -> host ^ ":" ^ string_of_int p 68 68 + | None, _ -> host 69 69 + 70 70 + let request_headers w ~method_ ~uri ~headers:hdrs ~content_length = 71 71 + (* Write request line *) 72 72 + request_line w ~method_ ~uri; 73 73 + 74 74 + (* Ensure Host header is present *) 75 75 + let hdrs = if not (Headers.mem "host" hdrs) then 76 76 + Headers.add "host" (host_value uri) hdrs 77 77 + else hdrs in 78 78 + 79 79 + (* Ensure Connection header for keep-alive *) 80 80 + let hdrs = if not (Headers.mem "connection" hdrs) then 81 81 + Headers.add "connection" "keep-alive" hdrs 82 82 + else hdrs in 83 83 + 84 84 + (* Add Content-Length if we have a body length *) 85 85 + let hdrs = match content_length with 86 86 + | Some len when len > 0L && not (Headers.mem "content-length" hdrs) -> 87 87 + Headers.add "content-length" (Int64.to_string len) hdrs 88 88 + | _ -> hdrs 89 89 + in 90 90 + 91 91 + (* Write all headers *) 92 92 + headers w hdrs 93 93 + 94 94 + (** {1 Body Writing} *) 95 95 + 96 96 + let body_string w s = 97 97 + if s <> "" then 98 98 + Write.string w s 99 99 + 100 100 + (** Copy from a flow source to the writer, chunk by chunk *) 101 101 + let body_stream w source = 102 102 + let buf = Cstruct.create 8192 in 103 103 + let rec copy () = 104 104 + match Eio.Flow.single_read source buf with 105 105 + | n -> 106 106 + Write.cstruct w (Cstruct.sub buf 0 n); 107 107 + copy () 108 108 + | exception End_of_file -> () 109 109 + in 110 110 + copy () 111 111 + 112 112 + (** Write body using chunked transfer encoding *) 113 113 + let body_chunked w source = 114 114 + let buf = Cstruct.create 8192 in 115 115 + let rec copy () = 116 116 + match Eio.Flow.single_read source buf with 117 117 + | n -> 118 118 + (* Write chunk size in hex *) 119 119 + Write.printf w "%x" n; 120 120 + crlf w; 121 121 + (* Write chunk data *) 122 122 + Write.cstruct w (Cstruct.sub buf 0 n); 123 123 + crlf w; 124 124 + copy () 125 125 + | exception End_of_file -> 126 126 + (* Write final chunk *) 127 127 + Write.string w "0"; 128 128 + crlf w; 129 129 + crlf w 130 130 + in 131 131 + copy () 132 132 + 133 133 + (** {1 High-level Request Writing} *) 134 134 + 135 135 + let request w ~sw ~method_ ~uri ~headers:hdrs ~body = 136 136 + let method_str = Method.to_string method_ in 137 137 + 138 138 + (* Get content type and length from body *) 139 139 + let content_type = Body.content_type body in 140 140 + let content_length = Body.content_length body in 141 141 + 142 142 + (* Add Content-Type header if body has one *) 143 143 + let hdrs = match content_type with 144 144 + | Some mime when not (Headers.mem "content-type" hdrs) -> 145 145 + Headers.add "content-type" (Mime.to_string mime) hdrs 146 146 + | _ -> hdrs 147 147 + in 148 148 + 149 149 + (* Determine if we need chunked encoding *) 150 150 + let use_chunked = Body.Private.is_chunked body in 151 151 + 152 152 + let hdrs = if use_chunked && not (Headers.mem "transfer-encoding" hdrs) then 153 153 + Headers.add "transfer-encoding" "chunked" hdrs 154 154 + else hdrs in 155 155 + 156 156 + (* Write request line and headers *) 157 157 + request_headers w ~method_:method_str ~uri ~headers:hdrs ~content_length; 158 158 + 159 159 + (* Write body *) 160 160 + if Body.Private.is_empty body then 161 161 + () 162 162 + else if use_chunked then 163 163 + Body.Private.write_chunked ~sw w body 164 164 + else 165 165 + Body.Private.write ~sw w body 166 166 + 167 167 + (** {1 Headers-Only Writing (for 100-continue)} *) 168 168 + 169 169 + let request_headers_only w ~method_ ~uri ~headers:hdrs ~content_length = 170 170 + let method_str = Method.to_string method_ in 171 171 + request_headers w ~method_:method_str ~uri ~headers:hdrs ~content_length 172 172 + 173 173 + (** {1 Convenience Wrappers} *) 174 174 + 175 175 + let with_flow ?initial_size flow fn = 176 176 + Write.with_flow ?initial_size flow fn 177 177 + 178 178 + (** Write and flush directly to flow without creating a nested switch. 179 179 + This is a simpler alternative to [with_flow] that avoids potential 180 180 + issues with nested switches in the Eio fiber system. *) 181 181 + let write_and_flush ?(initial_size=0x1000) flow fn = 182 182 + (* Create a writer without attaching to a switch *) 183 183 + let w = Write.create initial_size in 184 184 + (* Execute the writing function *) 185 185 + fn w; 186 186 + (* Serialize to string and copy to flow *) 187 187 + let data = Write.serialize_to_string w in 188 188 + if String.length data > 0 then 189 189 + Eio.Flow.copy_string data flow

+101

lib/http_write.mli

··· 1 1 + (*--------------------------------------------------------------------------- 2 2 + Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved. 3 3 + SPDX-License-Identifier: ISC 4 4 + ---------------------------------------------------------------------------*) 5 5 + 6 6 + (** HTTP request serialization using Eio.Buf_write 7 7 + 8 8 + This module provides efficient HTTP/1.1 request serialization using Eio's 9 9 + buffered write API. It avoids intermediate string allocations by writing 10 10 + directly to the output buffer. 11 11 + 12 12 + Example: 13 13 + {[ 14 14 + Http_write.with_flow flow (fun w -> 15 15 + Http_write.request w ~sw ~method_:`GET ~uri 16 16 + ~headers:Headers.empty ~body:Body.empty 17 17 + ) 18 18 + ]} *) 19 19 + 20 20 + (** {1 Low-level Writers} *) 21 21 + 22 22 + val crlf : Eio.Buf_write.t -> unit 23 23 + (** [crlf w] writes a CRLF line terminator ("\r\n") to [w]. *) 24 24 + 25 25 + val request_line : Eio.Buf_write.t -> method_:string -> uri:Uri.t -> unit 26 26 + (** [request_line w ~method_ ~uri] writes an HTTP request line. 27 27 + For example: "GET /path?query HTTP/1.1\r\n" *) 28 28 + 29 29 + val header : Eio.Buf_write.t -> name:string -> value:string -> unit 30 30 + (** [header w ~name ~value] writes a single header line. 31 31 + For example: "Content-Type: application/json\r\n" *) 32 32 + 33 33 + val headers : Eio.Buf_write.t -> Headers.t -> unit 34 34 + (** [headers w hdrs] writes all headers from [hdrs], followed by 35 35 + a blank line (CRLF) to terminate the headers section. *) 36 36 + 37 37 + (** {1 Request Headers} *) 38 38 + 39 39 + val request_headers : Eio.Buf_write.t -> method_:string -> uri:Uri.t -> 40 40 + headers:Headers.t -> content_length:int64 option -> unit 41 41 + (** [request_headers w ~method_ ~uri ~headers ~content_length] writes a complete 42 42 + HTTP request header section, including: 43 43 + - Request line (method, path, HTTP/1.1) 44 44 + - Host header (extracted from URI if not present) 45 45 + - Connection: keep-alive (if not present) 46 46 + - Content-Length (if [content_length] provided and > 0) 47 47 + - All headers from [headers] 48 48 + - Terminating blank line *) 49 49 + 50 50 + val request_headers_only : Eio.Buf_write.t -> method_:Method.t -> uri:Uri.t -> 51 51 + headers:Headers.t -> content_length:int64 option -> unit 52 52 + (** [request_headers_only] is like {!request_headers} but takes a [Method.t] 53 53 + instead of a string. Used for 100-continue flow where headers are sent first. *) 54 54 + 55 55 + (** {1 Body Writing} *) 56 56 + 57 57 + val body_string : Eio.Buf_write.t -> string -> unit 58 58 + (** [body_string w s] writes string [s] as the request body. 59 59 + Does nothing if [s] is empty. *) 60 60 + 61 61 + val body_stream : Eio.Buf_write.t -> Eio.Flow.source_ty Eio.Resource.t -> unit 62 62 + (** [body_stream w source] copies data from [source] to [w] until EOF. 63 63 + Uses 8KB chunks for efficiency. The caller must ensure Content-Length 64 64 + is set correctly in headers. *) 65 65 + 66 66 + val body_chunked : Eio.Buf_write.t -> Eio.Flow.source_ty Eio.Resource.t -> unit 67 67 + (** [body_chunked w source] writes data from [source] using HTTP chunked 68 68 + transfer encoding. Each chunk is prefixed with its size in hex, 69 69 + followed by CRLF, the data, and another CRLF. Ends with "0\r\n\r\n". *) 70 70 + 71 71 + (** {1 High-level Request Writing} *) 72 72 + 73 73 + val request : Eio.Buf_write.t -> sw:Eio.Switch.t -> method_:Method.t -> 74 74 + uri:Uri.t -> headers:Headers.t -> body:Body.t -> unit 75 75 + (** [request w ~sw ~method_ ~uri ~headers ~body] writes a complete HTTP request 76 76 + including headers and body. Automatically handles: 77 77 + - Content-Type header from body 78 78 + - Content-Length header for sized bodies 79 79 + - Transfer-Encoding: chunked for unsized streams 80 80 + - Multipart body encoding *) 81 81 + 82 82 + (** {1 Convenience Wrappers} *) 83 83 + 84 84 + val with_flow : ?initial_size:int -> _ Eio.Flow.sink -> 85 85 + (Eio.Buf_write.t -> 'a) -> 'a 86 86 + (** [with_flow flow fn] runs [fn writer] where [writer] is a buffer that 87 87 + flushes to [flow]. Data is automatically flushed when [fn] returns. 88 88 + 89 89 + This is a thin wrapper around {!Eio.Buf_write.with_flow}. 90 90 + 91 91 + {b Note:} This function creates an internal switch and may cause issues 92 92 + with nested fibers. Consider using {!write_and_flush} instead. *) 93 93 + 94 94 + val write_and_flush : ?initial_size:int -> _ Eio.Flow.sink -> 95 95 + (Eio.Buf_write.t -> unit) -> unit 96 96 + (** [write_and_flush flow fn] runs [fn writer] where [writer] is a buffer, 97 97 + then serializes all written data to a string and copies it to [flow]. 98 98 + 99 99 + Unlike {!with_flow}, this does not create a nested switch and is safe 100 100 + to use in complex fiber hierarchies. The tradeoff is that the entire 101 101 + request is buffered in memory before being written. *)

+6 -5

lib/one.ml

··· 198 198 headers 199 199 in 200 200 201 201 - (* Convert body to string for sending *) 202 202 - let request_body_str = Option.fold ~none:"" ~some:Body.Private.to_string body in 201 201 + (* Get request body, defaulting to empty *) 202 202 + let request_body = Option.value ~default:Body.empty body in 203 203 204 204 (* Track the original URL for cross-origin redirect detection *) 205 205 let original_uri = Uri.of_string url in ··· 214 214 ~timeout ~verify_tls ~tls_config ~min_tls_version in 215 215 216 216 (* Build expect_100 config *) 217 217 - let expect_100_config = Http_client.{ 217 217 + let expect_100_config = Http_types.{ 218 218 enabled = expect_100_continue; 219 219 threshold = expect_100_continue_threshold; 220 220 timeout = Option.bind timeout Timeout.expect_100_continue |> Option.value ~default:1.0; ··· 225 225 Http_client.make_request_100_continue_decompress 226 226 ~expect_100:expect_100_config 227 227 ~clock 228 228 - ~method_:method_str ~uri:uri_to_fetch 229 229 - ~headers:headers_for_request ~body_str:request_body_str 228 228 + ~sw 229 229 + ~method_ ~uri:uri_to_fetch 230 230 + ~headers:headers_for_request ~body:request_body 230 231 ~auto_decompress flow 231 232 in 232 233

+6 -8

lib/requests.ml

··· 177 177 in 178 178 179 179 (* Build expect_100_continue configuration *) 180 180 - let expect_100_config = Http_client.{ 180 180 + let expect_100_config = Http_types.{ 181 181 enabled = expect_100_continue; 182 182 threshold = expect_100_continue_threshold; 183 183 timeout = Timeout.expect_100_continue timeout |> Option.value ~default:1.0; ··· 320 320 base_headers 321 321 in 322 322 323 323 - (* Convert body to string for sending *) 324 324 - let request_body_str = match body with 325 325 - | None -> "" 326 326 - | Some b -> Body.Private.to_string b 327 327 - in 323 323 + (* Get request body, defaulting to empty *) 324 324 + let request_body = Option.value ~default:Body.empty body in 328 325 329 326 (* Helper to extract and store cookies from response headers *) 330 327 let extract_cookies_from_headers resp_headers url_str = ··· 421 418 Http_client.make_request_100_continue_decompress 422 419 ~expect_100:t.expect_100_continue 423 420 ~clock:t.clock 424 424 - ~method_:method_str ~uri:uri_to_fetch 425 425 - ~headers:headers_with_cookies ~body_str:request_body_str 421 421 + ~sw:t.sw 422 422 + ~method_ ~uri:uri_to_fetch 423 423 + ~headers:headers_with_cookies ~body:request_body 426 424 ~auto_decompress:t.auto_decompress flow 427 425 ) 428 426 in

+4

test/dune

··· 6 6 (name test_simple) 7 7 (libraries conpool eio_main logs logs.fmt)) 8 8 9 9 + (executable 10 10 + (name test_one) 11 11 + (libraries requests eio_main logs logs.fmt mirage-crypto-rng.unix)) 12 12 + 9 13 (cram 10 14 (deps %{bin:ocurl}))

+11

test/test_one.ml

··· 1 1 + (* Test using One module directly without connection pooling *) 2 2 + let () = 3 3 + Eio_main.run @@ fun env -> 4 4 + Mirage_crypto_rng_unix.use_default (); 5 5 + Eio.Switch.run @@ fun sw -> 6 6 + try 7 7 + let response = Requests.simple_get ~sw env "https://opam.ocaml.org" in 8 8 + Printf.printf "Status: %d\n%!" (Requests.Response.status_code response) 9 9 + with e -> 10 10 + Printf.printf "Exception: %s\n%!" (Printexc.to_string e); 11 11 + Printexc.print_backtrace stdout

+14

test/test_simple_head.ml

··· 1 1 + (* Simple test to isolate the issue - tests One module directly *) 2 2 + let () = 3 3 + Logs.set_level (Some Logs.Debug); 4 4 + Logs.set_reporter (Logs_fmt.reporter ()); 5 5 + Eio_main.run @@ fun env -> 6 6 + Mirage_crypto_rng_unix.use_default (); 7 7 + Eio.Switch.run @@ fun sw -> 8 8 + Printf.printf "Making simple_head request...\n%!"; 9 9 + try 10 10 + let response = Requests.simple_head ~sw env "https://opam.ocaml.org" in 11 11 + Printf.printf "Status: %d\n%!" (Requests.Response.status_code response) 12 12 + with e -> 13 13 + Printf.printf "Exception: %s\n%!" (Printexc.to_string e); 14 14 + Printexc.print_backtrace stdout