A batteries included HTTP/1.1 client in OCaml

proxy

+1428 -133
+12 -4
bin/ocurl.ml
··· 60 60 (* Logging setup *) 61 61 (* Setup logging using Logs_cli for standard logging options *) 62 62 let setup_log app_name = 63 - let setup style_renderer level verbose_http = 63 + let setup style_renderer level verbose_http_ws = 64 64 Fmt_tty.setup_std_outputs ?style_renderer (); 65 65 Logs.set_level level; 66 66 Logs.set_reporter (Logs_fmt.reporter ()); 67 - Requests.Cmd.setup_log_sources ~verbose_http level 67 + (* Extract value from with_source wrapper *) 68 + Requests.Cmd.setup_log_sources ~verbose_http:verbose_http_ws.Requests.Cmd.value level 68 69 in 69 70 Term.(const setup $ Fmt_cli.style_renderer () $ Logs_cli.level () $ 70 71 Requests.Cmd.verbose_http_term app_name) ··· 301 302 302 303 (* Main entry point *) 303 304 let main method_ urls headers data json_data output include_headers head 304 - auth show_progress persist_cookies verify_tls 305 - timeout follow_redirects max_redirects () = 305 + auth show_progress persist_cookies_ws verify_tls_ws 306 + timeout_ws follow_redirects_ws max_redirects_ws () = 307 + 308 + (* Extract values from with_source wrappers *) 309 + let persist_cookies = persist_cookies_ws.Requests.Cmd.value in 310 + let verify_tls = verify_tls_ws.Requests.Cmd.value in 311 + let timeout = timeout_ws.Requests.Cmd.value in 312 + let follow_redirects = follow_redirects_ws.Requests.Cmd.value in 313 + let max_redirects = max_redirects_ws.Requests.Cmd.value in 306 314 307 315 Eio_main.run @@ fun env -> 308 316 Mirage_crypto_rng_unix.use_default ();
+81
lib/http_write.ml
··· 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 190 + 191 + (** {1 Proxy Request Writing} *) 192 + 193 + (** Write request line using absolute-URI form for proxy requests. 194 + Per RFC 9112 Section 3.2.2 *) 195 + let request_line_absolute w ~method_ ~uri = 196 + Write.string w method_; 197 + sp w; 198 + (* Use full absolute URI *) 199 + Write.string w (Uri.to_string uri); 200 + Write.string w " HTTP/1.1"; 201 + crlf w 202 + 203 + (** Write request headers for proxy request with absolute-URI *) 204 + let request_headers_proxy w ~method_ ~uri ~headers:hdrs ~content_length ~proxy_auth = 205 + (* Write request line with absolute URI *) 206 + request_line_absolute w ~method_ ~uri; 207 + 208 + (* Ensure Host header is present *) 209 + let hdrs = if not (Headers.mem "host" hdrs) then 210 + Headers.add "host" (host_value uri) hdrs 211 + else hdrs in 212 + 213 + (* Ensure Connection header for keep-alive *) 214 + let hdrs = if not (Headers.mem "connection" hdrs) then 215 + Headers.add "connection" "keep-alive" hdrs 216 + else hdrs in 217 + 218 + (* Add Content-Length if we have a body length *) 219 + let hdrs = match content_length with 220 + | Some len when len > 0L && not (Headers.mem "content-length" hdrs) -> 221 + Headers.add "content-length" (Int64.to_string len) hdrs 222 + | _ -> hdrs 223 + in 224 + 225 + (* Add Proxy-Authorization if configured *) 226 + let hdrs = match proxy_auth with 227 + | Some auth -> 228 + let auth_headers = Auth.apply auth Headers.empty in 229 + (match Headers.get "authorization" auth_headers with 230 + | Some value -> Headers.add "proxy-authorization" value hdrs 231 + | None -> hdrs) 232 + | None -> hdrs 233 + in 234 + 235 + (* Write all headers *) 236 + headers w hdrs 237 + 238 + (** Write complete HTTP request via proxy using absolute-URI form *) 239 + let request_via_proxy w ~sw ~method_ ~uri ~headers:hdrs ~body ~proxy_auth = 240 + let method_str = Method.to_string method_ in 241 + 242 + (* Get content type and length from body *) 243 + let content_type = Body.content_type body in 244 + let content_length = Body.content_length body in 245 + 246 + (* Add Content-Type header if body has one *) 247 + let hdrs = match content_type with 248 + | Some mime when not (Headers.mem "content-type" hdrs) -> 249 + Headers.add "content-type" (Mime.to_string mime) hdrs 250 + | _ -> hdrs 251 + in 252 + 253 + (* Determine if we need chunked encoding *) 254 + let use_chunked = Body.Private.is_chunked body in 255 + 256 + let hdrs = if use_chunked && not (Headers.mem "transfer-encoding" hdrs) then 257 + Headers.add "transfer-encoding" "chunked" hdrs 258 + else hdrs in 259 + 260 + (* Write request line and headers *) 261 + request_headers_proxy w ~method_:method_str ~uri ~headers:hdrs 262 + ~content_length ~proxy_auth; 263 + 264 + (* Write body *) 265 + if Body.Private.is_empty body then 266 + () 267 + else if use_chunked then 268 + Body.Private.write_chunked ~sw w body 269 + else 270 + Body.Private.write ~sw w body
+25
lib/http_write.mli
··· 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. *) 102 + 103 + (** {1 Proxy Request Writing} *) 104 + 105 + val request_line_absolute : Eio.Buf_write.t -> method_:string -> uri:Uri.t -> unit 106 + (** [request_line_absolute w ~method_ ~uri] writes an HTTP request line 107 + using absolute-URI form for proxy requests. 108 + Per RFC 9112 Section 3.2.2: "A client MUST send a request-line with 109 + absolute-form as the request-target when making a request to a proxy." 110 + For example: "GET http://www.example.com/path HTTP/1.1\r\n" *) 111 + 112 + val request_via_proxy : Eio.Buf_write.t -> sw:Eio.Switch.t -> method_:Method.t -> 113 + uri:Uri.t -> headers:Headers.t -> body:Body.t -> 114 + proxy_auth:Auth.t option -> unit 115 + (** [request_via_proxy w ~sw ~method_ ~uri ~headers ~body ~proxy_auth] 116 + writes a complete HTTP request using absolute-URI form for proxying. 117 + 118 + Per RFC 9112 Section 3.2.2, when sending a request to a proxy for an 119 + HTTP URL (not HTTPS), the client MUST use the absolute-URI form: 120 + {v 121 + GET http://www.example.com/path HTTP/1.1 122 + Host: www.example.com 123 + Proxy-Authorization: Basic ... 124 + v} 125 + 126 + @param proxy_auth Optional proxy authentication to add as Proxy-Authorization header *)
+102 -27
lib/one.ml
··· 171 171 ?(min_tls_version = TLS_1_2) 172 172 ?(expect_100_continue = true) ?(expect_100_continue_threshold = 1_048_576L) 173 173 ?(allow_insecure_auth = false) 174 + ?proxy 174 175 ~method_ url = 175 176 176 177 let start_time = Unix.gettimeofday () in ··· 218 219 let rec make_with_redirects ~headers_for_request url_to_fetch redirects_left = 219 220 let uri_to_fetch = Uri.of_string url_to_fetch in 220 221 221 - (* Connect to URL (opens new TCP connection) *) 222 - let flow = connect_to_url ~sw ~clock ~net ~url:url_to_fetch 223 - ~timeout ~verify_tls ~tls_config ~min_tls_version in 222 + (* Determine if we should use proxy for this URL *) 223 + let use_proxy = match proxy with 224 + | None -> false 225 + | Some p -> not (Proxy.should_bypass p url_to_fetch) 226 + in 227 + 228 + let is_https = Uri.scheme uri_to_fetch = Some "https" in 224 229 225 230 (* Build expect_100 config *) 226 231 let expect_100_config = Expect_continue.make ··· 230 235 () 231 236 in 232 237 233 - (* Make HTTP request using low-level client with 100-continue and optional auto-decompression *) 238 + (* Connect and make request based on proxy configuration *) 234 239 let status, resp_headers, response_body_str = 235 - Http_client.make_request_100_continue_decompress 236 - ~expect_100:expect_100_config 237 - ~clock 238 - ~sw 239 - ~method_ ~uri:uri_to_fetch 240 - ~headers:headers_for_request ~body:request_body 241 - ~auto_decompress flow 240 + match use_proxy, is_https, proxy with 241 + | false, _, _ -> 242 + (* Direct connection *) 243 + let flow = connect_to_url ~sw ~clock ~net ~url:url_to_fetch 244 + ~timeout ~verify_tls ~tls_config ~min_tls_version in 245 + Http_client.make_request_100_continue_decompress 246 + ~expect_100:expect_100_config 247 + ~clock 248 + ~sw 249 + ~method_ ~uri:uri_to_fetch 250 + ~headers:headers_for_request ~body:request_body 251 + ~auto_decompress flow 252 + 253 + | true, false, Some p -> 254 + (* HTTP via proxy - use absolute-URI form *) 255 + Log.debug (fun m -> m "[One] Routing HTTP request via proxy %s:%d" 256 + p.Proxy.host p.Proxy.port); 257 + let flow = connect_tcp ~sw ~net ~host:p.Proxy.host ~port:p.Proxy.port in 258 + let flow = (flow :> [`Close | `Flow | `R | `Shutdown | `W] Eio.Resource.t) in 259 + (* Write request using absolute-URI form *) 260 + Http_write.write_and_flush flow (fun w -> 261 + Http_write.request_via_proxy w ~sw ~method_ ~uri:uri_to_fetch 262 + ~headers:headers_for_request ~body:request_body 263 + ~proxy_auth:p.Proxy.auth 264 + ); 265 + (* Read response *) 266 + let limits = Response_limits.default in 267 + let buf_read = Http_read.of_flow ~max_size:65536 flow in 268 + let (_version, status, resp_headers, body_str) = 269 + Http_read.response ~limits buf_read in 270 + (* Handle decompression if enabled *) 271 + let body_str = 272 + if auto_decompress then 273 + match Headers.get "content-encoding" resp_headers with 274 + | Some encoding -> 275 + Http_client.decompress_body 276 + ~limits:Response_limits.default 277 + ~content_encoding:encoding body_str 278 + | None -> body_str 279 + else body_str 280 + in 281 + (status, resp_headers, body_str) 282 + 283 + | true, true, Some p -> 284 + (* HTTPS via proxy - establish CONNECT tunnel then TLS *) 285 + Log.debug (fun m -> m "[One] Routing HTTPS request via proxy %s:%d (CONNECT tunnel)" 286 + p.Proxy.host p.Proxy.port); 287 + let target_host = Uri.host uri_to_fetch |> Option.value ~default:"" in 288 + let target_port = Uri.port uri_to_fetch |> Option.value ~default:443 in 289 + (* Establish TLS tunnel through proxy *) 290 + let tunnel_flow = Proxy_tunnel.connect_with_tls 291 + ~sw ~net ~clock 292 + ~proxy:p 293 + ~target_host 294 + ~target_port 295 + ?tls_config 296 + () 297 + in 298 + Http_client.make_request_100_continue_decompress 299 + ~expect_100:expect_100_config 300 + ~clock 301 + ~sw 302 + ~method_ ~uri:uri_to_fetch 303 + ~headers:headers_for_request ~body:request_body 304 + ~auto_decompress tunnel_flow 305 + 306 + | true, _, None -> 307 + (* Should not happen due to use_proxy check *) 308 + let flow = connect_to_url ~sw ~clock ~net ~url:url_to_fetch 309 + ~timeout ~verify_tls ~tls_config ~min_tls_version in 310 + Http_client.make_request_100_continue_decompress 311 + ~expect_100:expect_100_config 312 + ~clock 313 + ~sw 314 + ~method_ ~uri:uri_to_fetch 315 + ~headers:headers_for_request ~body:request_body 316 + ~auto_decompress flow 242 317 in 243 318 244 319 Log.info (fun m -> m "Received response: status=%d" status); ··· 296 371 (* Convenience methods *) 297 372 let get ~sw ~clock ~net ?headers ?auth ?timeout 298 373 ?follow_redirects ?max_redirects ?verify_tls ?tls_config ?min_tls_version 299 - ?allow_insecure_auth url = 374 + ?allow_insecure_auth ?proxy url = 300 375 request ~sw ~clock ~net ?headers ?auth ?timeout 301 376 ?follow_redirects ?max_redirects ?verify_tls ?tls_config ?min_tls_version 302 - ?allow_insecure_auth 377 + ?allow_insecure_auth ?proxy 303 378 ~expect_100_continue:false (* GET has no body *) 304 379 ~method_:`GET url 305 380 306 381 let post ~sw ~clock ~net ?headers ?body ?auth ?timeout 307 382 ?verify_tls ?tls_config ?min_tls_version 308 383 ?expect_100_continue ?expect_100_continue_threshold 309 - ?allow_insecure_auth url = 384 + ?allow_insecure_auth ?proxy url = 310 385 request ~sw ~clock ~net ?headers ?body ?auth ?timeout 311 386 ?verify_tls ?tls_config ?min_tls_version 312 387 ?expect_100_continue ?expect_100_continue_threshold 313 - ?allow_insecure_auth ~method_:`POST url 388 + ?allow_insecure_auth ?proxy ~method_:`POST url 314 389 315 390 let put ~sw ~clock ~net ?headers ?body ?auth ?timeout 316 391 ?verify_tls ?tls_config ?min_tls_version 317 392 ?expect_100_continue ?expect_100_continue_threshold 318 - ?allow_insecure_auth url = 393 + ?allow_insecure_auth ?proxy url = 319 394 request ~sw ~clock ~net ?headers ?body ?auth ?timeout 320 395 ?verify_tls ?tls_config ?min_tls_version 321 396 ?expect_100_continue ?expect_100_continue_threshold 322 - ?allow_insecure_auth ~method_:`PUT url 397 + ?allow_insecure_auth ?proxy ~method_:`PUT url 323 398 324 399 let delete ~sw ~clock ~net ?headers ?auth ?timeout 325 400 ?verify_tls ?tls_config ?min_tls_version 326 - ?allow_insecure_auth url = 401 + ?allow_insecure_auth ?proxy url = 327 402 request ~sw ~clock ~net ?headers ?auth ?timeout 328 403 ?verify_tls ?tls_config ?min_tls_version 329 - ?allow_insecure_auth 404 + ?allow_insecure_auth ?proxy 330 405 ~expect_100_continue:false (* DELETE typically has no body *) 331 406 ~method_:`DELETE url 332 407 333 408 let head ~sw ~clock ~net ?headers ?auth ?timeout 334 409 ?verify_tls ?tls_config ?min_tls_version 335 - ?allow_insecure_auth url = 410 + ?allow_insecure_auth ?proxy url = 336 411 request ~sw ~clock ~net ?headers ?auth ?timeout 337 412 ?verify_tls ?tls_config ?min_tls_version 338 - ?allow_insecure_auth 413 + ?allow_insecure_auth ?proxy 339 414 ~expect_100_continue:false (* HEAD has no body *) 340 415 ~method_:`HEAD url 341 416 342 417 let patch ~sw ~clock ~net ?headers ?body ?auth ?timeout 343 418 ?verify_tls ?tls_config ?min_tls_version 344 419 ?expect_100_continue ?expect_100_continue_threshold 345 - ?allow_insecure_auth url = 420 + ?allow_insecure_auth ?proxy url = 346 421 request ~sw ~clock ~net ?headers ?body ?auth ?timeout 347 422 ?verify_tls ?tls_config ?min_tls_version 348 423 ?expect_100_continue ?expect_100_continue_threshold 349 - ?allow_insecure_auth ~method_:`PATCH url 424 + ?allow_insecure_auth ?proxy ~method_:`PATCH url 350 425 351 426 let upload ~sw ~clock ~net ?headers ?auth ?timeout ?method_ ?mime ?length 352 427 ?on_progress ?verify_tls ?tls_config ?min_tls_version 353 428 ?(expect_100_continue = true) ?expect_100_continue_threshold 354 - ?allow_insecure_auth ~source url = 429 + ?allow_insecure_auth ?proxy ~source url = 355 430 let method_ = Option.value method_ ~default:`POST in 356 431 let mime = Option.value mime ~default:Mime.octet_stream in 357 432 ··· 369 444 let body = Body.of_stream ?length mime tracked_source in 370 445 request ~sw ~clock ~net ?headers ~body ?auth ?timeout 371 446 ?verify_tls ?tls_config ?min_tls_version 372 - ?allow_insecure_auth 447 + ?allow_insecure_auth ?proxy 373 448 ~expect_100_continue ?expect_100_continue_threshold ~method_ url 374 449 375 450 let download ~sw ~clock ~net ?headers ?auth ?timeout ?on_progress 376 - ?verify_tls ?tls_config ?min_tls_version ?allow_insecure_auth url ~sink = 451 + ?verify_tls ?tls_config ?min_tls_version ?allow_insecure_auth ?proxy url ~sink = 377 452 let response = get ~sw ~clock ~net ?headers ?auth ?timeout 378 453 ?verify_tls ?tls_config ?min_tls_version 379 - ?allow_insecure_auth url in 454 + ?allow_insecure_auth ?proxy url in 380 455 381 456 try 382 457 (* Get content length for progress tracking *)
+12
lib/one.mli
··· 76 76 ?expect_100_continue:bool -> 77 77 ?expect_100_continue_threshold:int64 -> 78 78 ?allow_insecure_auth:bool -> 79 + ?proxy:Proxy.config -> 79 80 method_:Method.t -> 80 81 string -> 81 82 Response.t ··· 106 107 @param allow_insecure_auth Allow Basic/Bearer/Digest auth over HTTP (default: false). 107 108 Per RFC 7617 Section 4 and RFC 6750 Section 5.1, these auth methods 108 109 MUST be used over TLS. Set to [true] only for testing environments. 110 + @param proxy HTTP/HTTPS proxy configuration. When set, requests are routed through the proxy. 111 + HTTP requests use absolute-URI form (RFC 9112 Section 3.2.2). 112 + HTTPS requests use CONNECT tunneling (RFC 9110 Section 9.3.6). 109 113 @param method_ HTTP method (GET, POST, etc.) 110 114 @param url URL to request 111 115 *) ··· 123 127 ?tls_config:Tls.Config.client -> 124 128 ?min_tls_version:tls_version -> 125 129 ?allow_insecure_auth:bool -> 130 + ?proxy:Proxy.config -> 126 131 string -> 127 132 Response.t 128 133 (** GET request. See {!request} for parameter details. *) ··· 141 146 ?expect_100_continue:bool -> 142 147 ?expect_100_continue_threshold:int64 -> 143 148 ?allow_insecure_auth:bool -> 149 + ?proxy:Proxy.config -> 144 150 string -> 145 151 Response.t 146 152 (** POST request with 100-continue support. See {!request} for parameter details. *) ··· 159 165 ?expect_100_continue:bool -> 160 166 ?expect_100_continue_threshold:int64 -> 161 167 ?allow_insecure_auth:bool -> 168 + ?proxy:Proxy.config -> 162 169 string -> 163 170 Response.t 164 171 (** PUT request with 100-continue support. See {!request} for parameter details. *) ··· 174 181 ?tls_config:Tls.Config.client -> 175 182 ?min_tls_version:tls_version -> 176 183 ?allow_insecure_auth:bool -> 184 + ?proxy:Proxy.config -> 177 185 string -> 178 186 Response.t 179 187 (** DELETE request. See {!request} for parameter details. *) ··· 189 197 ?tls_config:Tls.Config.client -> 190 198 ?min_tls_version:tls_version -> 191 199 ?allow_insecure_auth:bool -> 200 + ?proxy:Proxy.config -> 192 201 string -> 193 202 Response.t 194 203 (** HEAD request. See {!request} for parameter details. *) ··· 207 216 ?expect_100_continue:bool -> 208 217 ?expect_100_continue_threshold:int64 -> 209 218 ?allow_insecure_auth:bool -> 219 + ?proxy:Proxy.config -> 210 220 string -> 211 221 Response.t 212 222 (** PATCH request with 100-continue support. See {!request} for parameter details. *) ··· 228 238 ?expect_100_continue:bool -> 229 239 ?expect_100_continue_threshold:int64 -> 230 240 ?allow_insecure_auth:bool -> 241 + ?proxy:Proxy.config -> 231 242 source:Eio.Flow.source_ty Eio.Resource.t -> 232 243 string -> 233 244 Response.t ··· 246 257 ?tls_config:Tls.Config.client -> 247 258 ?min_tls_version:tls_version -> 248 259 ?allow_insecure_auth:bool -> 260 + ?proxy:Proxy.config -> 249 261 string -> 250 262 sink:Eio.Flow.sink_ty Eio.Resource.t -> 251 263 unit
+205
lib/proxy.ml
··· 1 + (*--------------------------------------------------------------------------- 2 + Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved. 3 + SPDX-License-Identifier: ISC 4 + ---------------------------------------------------------------------------*) 5 + 6 + (** HTTP Proxy Configuration 7 + 8 + Per RFC 9110 Section 3.7 and Section 7.3.2: 9 + A proxy is a message-forwarding agent chosen by the client, 10 + usually configured via local rules. *) 11 + 12 + let src = Logs.Src.create "requests.proxy" ~doc:"HTTP Proxy Support" 13 + module Log = (val Logs.src_log src : Logs.LOG) 14 + 15 + (** {1 Proxy Types} *) 16 + 17 + type proxy_type = 18 + | HTTP 19 + | SOCKS5 20 + 21 + type config = { 22 + host : string; 23 + port : int; 24 + proxy_type : proxy_type; 25 + auth : Auth.t option; 26 + no_proxy : string list; 27 + } 28 + 29 + (** {1 Configuration Constructors} *) 30 + 31 + let http ?(port = 8080) ?auth ?(no_proxy = []) host = 32 + Log.debug (fun m -> m "Creating HTTP proxy config: %s:%d" host port); 33 + { host; port; proxy_type = HTTP; auth; no_proxy } 34 + 35 + let socks5 ?(port = 1080) ?auth ?(no_proxy = []) host = 36 + Log.debug (fun m -> m "Creating SOCKS5 proxy config: %s:%d" host port); 37 + { host; port; proxy_type = SOCKS5; auth; no_proxy } 38 + 39 + (** {1 Configuration Utilities} *) 40 + 41 + let should_bypass config url = 42 + let uri = Uri.of_string url in 43 + let target_host = Uri.host uri |> Option.value ~default:"" in 44 + let target_host_lower = String.lowercase_ascii target_host in 45 + 46 + let matches_pattern pattern = 47 + let pattern_lower = String.lowercase_ascii (String.trim pattern) in 48 + if String.length pattern_lower = 0 then 49 + false 50 + else if pattern_lower.[0] = '*' then 51 + (* Wildcard pattern: *.example.com matches foo.example.com *) 52 + let suffix = String.sub pattern_lower 1 (String.length pattern_lower - 1) in 53 + String.length target_host_lower >= String.length suffix && 54 + String.sub target_host_lower 55 + (String.length target_host_lower - String.length suffix) 56 + (String.length suffix) = suffix 57 + else if pattern_lower.[0] = '.' then 58 + (* .example.com matches example.com and foo.example.com *) 59 + target_host_lower = String.sub pattern_lower 1 (String.length pattern_lower - 1) || 60 + (String.length target_host_lower > String.length pattern_lower && 61 + String.sub target_host_lower 62 + (String.length target_host_lower - String.length pattern_lower) 63 + (String.length pattern_lower) = pattern_lower) 64 + else 65 + (* Exact match *) 66 + target_host_lower = pattern_lower 67 + in 68 + 69 + let bypassed = List.exists matches_pattern config.no_proxy in 70 + if bypassed then 71 + Log.debug (fun m -> m "URL %s bypasses proxy (matches no_proxy pattern)" 72 + (Error.sanitize_url url)); 73 + bypassed 74 + 75 + let host_port config = (config.host, config.port) 76 + 77 + (** {1 Environment Variable Support} *) 78 + 79 + let get_env key = 80 + try Some (Sys.getenv key) with Not_found -> None 81 + 82 + let get_env_insensitive key = 83 + match get_env key with 84 + | Some v -> Some v 85 + | None -> get_env (String.lowercase_ascii key) 86 + 87 + let parse_no_proxy () = 88 + let no_proxy_str = 89 + match get_env "NO_PROXY" with 90 + | Some v -> v 91 + | None -> 92 + match get_env "no_proxy" with 93 + | Some v -> v 94 + | None -> "" 95 + in 96 + no_proxy_str 97 + |> String.split_on_char ',' 98 + |> List.map String.trim 99 + |> List.filter (fun s -> String.length s > 0) 100 + 101 + let parse_proxy_url url = 102 + let uri = Uri.of_string url in 103 + let host = Uri.host uri |> Option.value ~default:"localhost" in 104 + let port = Uri.port uri |> Option.value ~default:8080 in 105 + let auth = match Uri.userinfo uri with 106 + | Some info -> 107 + (match String.index_opt info ':' with 108 + | Some idx -> 109 + let username = String.sub info 0 idx in 110 + let password = String.sub info (idx + 1) (String.length info - idx - 1) in 111 + Some (Auth.basic ~username ~password) 112 + | None -> 113 + (* Username only, no password *) 114 + Some (Auth.basic ~username:info ~password:"")) 115 + | None -> None 116 + in 117 + (host, port, auth) 118 + 119 + let from_env () = 120 + let no_proxy = parse_no_proxy () in 121 + let proxy_url = 122 + match get_env_insensitive "HTTP_PROXY" with 123 + | Some url -> Some url 124 + | None -> 125 + match get_env_insensitive "HTTPS_PROXY" with 126 + | Some url -> Some url 127 + | None -> get_env_insensitive "ALL_PROXY" 128 + in 129 + match proxy_url with 130 + | Some url -> 131 + let (host, port, auth) = parse_proxy_url url in 132 + Log.info (fun m -> m "Proxy configured from environment: %s:%d" host port); 133 + Some { host; port; proxy_type = HTTP; auth; no_proxy } 134 + | None -> 135 + Log.debug (fun m -> m "No proxy configured in environment"); 136 + None 137 + 138 + let from_env_for_url url = 139 + let uri = Uri.of_string url in 140 + let is_https = Uri.scheme uri = Some "https" in 141 + let no_proxy = parse_no_proxy () in 142 + 143 + (* Check if URL should bypass proxy *) 144 + let target_host = Uri.host uri |> Option.value ~default:"" in 145 + let should_bypass_url = 146 + let target_host_lower = String.lowercase_ascii target_host in 147 + List.exists (fun pattern -> 148 + let pattern_lower = String.lowercase_ascii (String.trim pattern) in 149 + if String.length pattern_lower = 0 then false 150 + else if pattern_lower.[0] = '*' then 151 + let suffix = String.sub pattern_lower 1 (String.length pattern_lower - 1) in 152 + String.length target_host_lower >= String.length suffix && 153 + String.sub target_host_lower 154 + (String.length target_host_lower - String.length suffix) 155 + (String.length suffix) = suffix 156 + else if pattern_lower.[0] = '.' then 157 + target_host_lower = String.sub pattern_lower 1 (String.length pattern_lower - 1) || 158 + (String.length target_host_lower > String.length pattern_lower && 159 + String.sub target_host_lower 160 + (String.length target_host_lower - String.length pattern_lower) 161 + (String.length pattern_lower) = pattern_lower) 162 + else 163 + target_host_lower = pattern_lower 164 + ) no_proxy 165 + in 166 + 167 + if should_bypass_url then begin 168 + Log.debug (fun m -> m "URL %s bypasses proxy (matches NO_PROXY)" 169 + (Error.sanitize_url url)); 170 + None 171 + end 172 + else 173 + let proxy_url = 174 + if is_https then 175 + match get_env_insensitive "HTTPS_PROXY" with 176 + | Some url -> Some url 177 + | None -> get_env_insensitive "ALL_PROXY" 178 + else 179 + match get_env_insensitive "HTTP_PROXY" with 180 + | Some url -> Some url 181 + | None -> get_env_insensitive "ALL_PROXY" 182 + in 183 + match proxy_url with 184 + | Some purl -> 185 + let (host, port, auth) = parse_proxy_url purl in 186 + Log.debug (fun m -> m "Using proxy %s:%d for URL %s" 187 + host port (Error.sanitize_url url)); 188 + Some { host; port; proxy_type = HTTP; auth; no_proxy } 189 + | None -> None 190 + 191 + (** {1 Pretty Printing} *) 192 + 193 + let pp_proxy_type ppf = function 194 + | HTTP -> Format.fprintf ppf "HTTP" 195 + | SOCKS5 -> Format.fprintf ppf "SOCKS5" 196 + 197 + let pp_config ppf config = 198 + Format.fprintf ppf "@[<v>Proxy Configuration:@,"; 199 + Format.fprintf ppf " Type: %a@," pp_proxy_type config.proxy_type; 200 + Format.fprintf ppf " Host: %s@," config.host; 201 + Format.fprintf ppf " Port: %d@," config.port; 202 + Format.fprintf ppf " Auth: %s@," 203 + (if Option.is_some config.auth then "[CONFIGURED]" else "None"); 204 + Format.fprintf ppf " No-proxy: [%s]@]" 205 + (String.concat ", " config.no_proxy)
+128
lib/proxy.mli
··· 1 + (*--------------------------------------------------------------------------- 2 + Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved. 3 + SPDX-License-Identifier: ISC 4 + ---------------------------------------------------------------------------*) 5 + 6 + (** HTTP Proxy Configuration 7 + 8 + Per RFC 9110 Section 3.7 and Section 7.3.2: 9 + A proxy is a message-forwarding agent chosen by the client, 10 + usually configured via local rules. 11 + 12 + {2 Usage} 13 + 14 + Create a proxy configuration: 15 + {[ 16 + let proxy = Proxy.http ~port:8080 "proxy.example.com" 17 + 18 + (* With authentication *) 19 + let proxy = Proxy.http 20 + ~port:8080 21 + ~auth:(Auth.basic ~username:"user" ~password:"pass") 22 + "proxy.example.com" 23 + 24 + (* With bypass list *) 25 + let proxy = Proxy.http 26 + ~no_proxy:["localhost"; "*.internal.example.com"] 27 + "proxy.example.com" 28 + ]} 29 + 30 + Read from environment variables: 31 + {[ 32 + match Proxy.from_env () with 33 + | Some proxy -> (* use proxy *) 34 + | None -> (* no proxy configured *) 35 + ]} *) 36 + 37 + (** Log source for proxy operations *) 38 + val src : Logs.Src.t 39 + 40 + (** {1 Proxy Types} *) 41 + 42 + (** Proxy protocol type *) 43 + type proxy_type = 44 + | HTTP (** HTTP proxy (CONNECT for HTTPS, absolute-URI for HTTP) *) 45 + | SOCKS5 (** SOCKS5 proxy (RFC 1928) - future extension *) 46 + 47 + (** Proxy configuration *) 48 + type config = { 49 + host : string; (** Proxy server hostname *) 50 + port : int; (** Proxy server port (default: 8080) *) 51 + proxy_type : proxy_type; 52 + auth : Auth.t option; (** Proxy authentication (Proxy-Authorization) *) 53 + no_proxy : string list; (** Hosts/patterns to bypass proxy *) 54 + } 55 + 56 + (** {1 Configuration Constructors} *) 57 + 58 + val http : ?port:int -> ?auth:Auth.t -> ?no_proxy:string list -> string -> config 59 + (** [http ?port ?auth ?no_proxy host] creates an HTTP proxy configuration. 60 + 61 + @param port Proxy port (default: 8080) 62 + @param auth Proxy authentication credentials 63 + @param no_proxy List of hosts/patterns to bypass the proxy. 64 + Supports wildcards like [*.example.com] to match [foo.example.com]. 65 + @param host Proxy server hostname *) 66 + 67 + val socks5 : ?port:int -> ?auth:Auth.t -> ?no_proxy:string list -> string -> config 68 + (** [socks5 ?port ?auth ?no_proxy host] creates a SOCKS5 proxy configuration. 69 + 70 + {b Note:} SOCKS5 support is not yet implemented. This function creates 71 + the configuration type for future use. 72 + 73 + @param port Proxy port (default: 1080) 74 + @param auth Proxy authentication credentials 75 + @param no_proxy List of hosts/patterns to bypass the proxy 76 + @param host Proxy server hostname *) 77 + 78 + (** {1 Configuration Utilities} *) 79 + 80 + val should_bypass : config -> string -> bool 81 + (** [should_bypass config url] returns [true] if [url] should bypass 82 + the proxy based on the [no_proxy] list. 83 + 84 + Matching rules: 85 + - Exact hostname match (case-insensitive) 86 + - Wildcard prefix match: [*.example.com] matches [foo.example.com] 87 + - [localhost] and [127.0.0.1] match by default if in no_proxy list *) 88 + 89 + val host_port : config -> string * int 90 + (** [host_port config] returns the proxy host and port as a tuple. *) 91 + 92 + (** {1 Environment Variable Support} *) 93 + 94 + val from_env : unit -> config option 95 + (** [from_env ()] reads proxy configuration from environment variables. 96 + 97 + Checks the following variables (in order of preference): 98 + - [HTTP_PROXY] / [http_proxy] 99 + - [HTTPS_PROXY] / [https_proxy] 100 + - [ALL_PROXY] / [all_proxy] 101 + - [NO_PROXY] / [no_proxy] (comma-separated list of bypass patterns) 102 + 103 + Returns [None] if no proxy is configured. 104 + 105 + URL format: [http://[user:pass@]host[:port]] 106 + 107 + Example environment: 108 + {[ 109 + HTTP_PROXY=http://user:pass@proxy.example.com:8080 110 + NO_PROXY=localhost,*.internal.example.com,.example.org 111 + ]} *) 112 + 113 + val from_env_for_url : string -> config option 114 + (** [from_env_for_url url] reads proxy configuration appropriate for [url]. 115 + 116 + - Uses [HTTPS_PROXY] for HTTPS URLs 117 + - Uses [HTTP_PROXY] for HTTP URLs 118 + - Falls back to [ALL_PROXY] 119 + - Returns [None] if the URL matches [NO_PROXY] patterns *) 120 + 121 + (** {1 Pretty Printing} *) 122 + 123 + val pp_proxy_type : Format.formatter -> proxy_type -> unit 124 + (** Pretty printer for proxy type *) 125 + 126 + val pp_config : Format.formatter -> config -> unit 127 + (** Pretty printer for proxy configuration. 128 + Note: Authentication credentials are redacted. *)
+196
lib/proxy_tunnel.ml
··· 1 + (*--------------------------------------------------------------------------- 2 + Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved. 3 + SPDX-License-Identifier: ISC 4 + ---------------------------------------------------------------------------*) 5 + 6 + (** HTTP CONNECT Tunneling for HTTPS via Proxy 7 + 8 + Per RFC 9110 Section 9.3.6: 9 + The CONNECT method requests that the recipient establish a tunnel 10 + to the destination origin server and, if successful, thereafter restrict 11 + its behavior to blind forwarding of packets in both directions. *) 12 + 13 + let src = Logs.Src.create "requests.proxy_tunnel" ~doc:"HTTPS proxy tunneling" 14 + module Log = (val Logs.src_log src : Logs.LOG) 15 + 16 + module Write = Eio.Buf_write 17 + module Read = Eio.Buf_read 18 + 19 + (** {1 Low-level Functions} *) 20 + 21 + let write_connect_request w ~proxy ~target_host ~target_port = 22 + let target = Printf.sprintf "%s:%d" target_host target_port in 23 + 24 + (* CONNECT request line per RFC 9110 Section 9.3.6 *) 25 + Write.string w "CONNECT "; 26 + Write.string w target; 27 + Write.string w " HTTP/1.1\r\n"; 28 + 29 + (* Host header is required *) 30 + Write.string w "Host: "; 31 + Write.string w target; 32 + Write.string w "\r\n"; 33 + 34 + (* Proxy-Authorization if configured *) 35 + (match proxy.Proxy.auth with 36 + | Some auth -> 37 + (* Apply auth to get the Authorization header, then rename to Proxy-Authorization *) 38 + let headers = Auth.apply auth Headers.empty in 39 + (match Headers.get "authorization" headers with 40 + | Some value -> 41 + Write.string w "Proxy-Authorization: "; 42 + Write.string w value; 43 + Write.string w "\r\n" 44 + | None -> ()) 45 + | None -> ()); 46 + 47 + (* User-Agent for debugging *) 48 + Write.string w "User-Agent: ocaml-requests\r\n"; 49 + 50 + (* End of headers *) 51 + Write.string w "\r\n"; 52 + 53 + Log.debug (fun m -> m "Wrote CONNECT request for %s via %s:%d" 54 + target proxy.Proxy.host proxy.Proxy.port) 55 + 56 + let parse_connect_response r ~proxy ~target = 57 + (* Parse status line - we just need version and status code *) 58 + let version_str = Read.take_while (function 59 + | 'A'..'Z' | 'a'..'z' | '0'..'9' | '/' | '.' -> true 60 + | _ -> false) r 61 + in 62 + Read.char ' ' r; 63 + let status_str = Read.take_while (function '0'..'9' -> true | _ -> false) r in 64 + Read.char ' ' r; 65 + let reason = Read.line r in 66 + 67 + let status = 68 + try int_of_string status_str 69 + with _ -> 70 + raise (Error.err (Error.Proxy_error { 71 + host = proxy.Proxy.host; 72 + reason = Printf.sprintf "Invalid status code in CONNECT response: %s" status_str 73 + })) 74 + in 75 + 76 + Log.debug (fun m -> m "CONNECT response: %s %d %s" version_str status reason); 77 + 78 + (* Read headers until empty line *) 79 + let rec skip_headers () = 80 + let line = Read.line r in 81 + if line <> "" then skip_headers () 82 + in 83 + skip_headers (); 84 + 85 + (* Check for success (2xx) *) 86 + if status < 200 || status >= 300 then 87 + raise (Error.err (Error.Proxy_error { 88 + host = proxy.Proxy.host; 89 + reason = Printf.sprintf "CONNECT to %s failed: %d %s" target status reason 90 + })); 91 + 92 + Log.info (fun m -> m "CONNECT tunnel established to %s via proxy %s:%d" 93 + target proxy.Proxy.host proxy.Proxy.port) 94 + 95 + (** {1 Tunnel Establishment} *) 96 + 97 + let connect ~sw ~net ~proxy ~target_host ~target_port () = 98 + let target = Printf.sprintf "%s:%d" target_host target_port in 99 + 100 + Log.debug (fun m -> m "Establishing CONNECT tunnel to %s via %s:%d" 101 + target proxy.Proxy.host proxy.Proxy.port); 102 + 103 + (* Connect to proxy server *) 104 + let proxy_addr = 105 + let addrs = Eio.Net.getaddrinfo_stream net proxy.Proxy.host 106 + ~service:(string_of_int proxy.Proxy.port) 107 + in 108 + match addrs with 109 + | [] -> 110 + raise (Error.err (Error.Dns_resolution_failed { 111 + hostname = proxy.Proxy.host 112 + })) 113 + | addr :: _ -> addr 114 + in 115 + 116 + let flow = 117 + try 118 + Eio.Net.connect ~sw net proxy_addr 119 + with exn -> 120 + raise (Error.err (Error.Tcp_connect_failed { 121 + host = proxy.Proxy.host; 122 + port = proxy.Proxy.port; 123 + reason = Printexc.to_string exn 124 + })) 125 + in 126 + 127 + Log.debug (fun m -> m "Connected to proxy %s:%d" proxy.Proxy.host proxy.Proxy.port); 128 + 129 + (* Send CONNECT request *) 130 + Http_write.write_and_flush flow (fun w -> 131 + write_connect_request w ~proxy ~target_host ~target_port 132 + ); 133 + 134 + (* Read and validate response *) 135 + let buf_read = Read.of_flow ~max_size:65536 flow in 136 + parse_connect_response buf_read ~proxy ~target; 137 + 138 + (* Return the raw flow - caller is responsible for TLS wrapping *) 139 + (flow :> [`Close | `Flow | `R | `Shutdown | `W] Eio.Resource.t) 140 + 141 + let connect_with_tls ~sw ~net ~clock:_ ~proxy ~target_host ~target_port 142 + ?tls_config () = 143 + (* First establish the tunnel *) 144 + let tunnel_flow = connect ~sw ~net ~proxy ~target_host ~target_port () in 145 + 146 + (* Get or create TLS config *) 147 + let tls_config = match tls_config with 148 + | Some cfg -> cfg 149 + | None -> 150 + (* Use system CA certificates *) 151 + let authenticator = 152 + match Ca_certs.authenticator () with 153 + | Ok auth -> auth 154 + | Error (`Msg msg) -> 155 + Log.warn (fun m -> m "Failed to load CA certificates: %s, using null authenticator" msg); 156 + fun ?ip:_ ~host:_ _ -> Ok None 157 + in 158 + match Tls.Config.client ~authenticator () with 159 + | Ok cfg -> cfg 160 + | Error (`Msg msg) -> 161 + raise (Error.err (Error.Tls_handshake_failed { 162 + host = target_host; 163 + reason = "TLS config error: " ^ msg 164 + })) 165 + in 166 + 167 + (* Perform TLS handshake through the tunnel *) 168 + let host = 169 + match Domain_name.of_string target_host with 170 + | Ok domain -> 171 + (match Domain_name.host domain with 172 + | Ok host -> host 173 + | Error (`Msg msg) -> 174 + raise (Error.err (Error.Tls_handshake_failed { 175 + host = target_host; 176 + reason = Printf.sprintf "Invalid hostname for SNI: %s" msg 177 + }))) 178 + | Error (`Msg msg) -> 179 + raise (Error.err (Error.Tls_handshake_failed { 180 + host = target_host; 181 + reason = Printf.sprintf "Invalid domain name: %s" msg 182 + })) 183 + in 184 + 185 + Log.debug (fun m -> m "Starting TLS handshake with %s through tunnel" target_host); 186 + 187 + try 188 + let tls_flow = Tls_eio.client_of_flow tls_config ~host tunnel_flow in 189 + Log.info (fun m -> m "TLS tunnel established to %s via proxy %s:%d" 190 + target_host proxy.Proxy.host proxy.Proxy.port); 191 + (tls_flow :> Eio.Flow.two_way_ty Eio.Resource.t) 192 + with exn -> 193 + raise (Error.err (Error.Tls_handshake_failed { 194 + host = target_host; 195 + reason = Printexc.to_string exn 196 + }))
+116
lib/proxy_tunnel.mli
··· 1 + (*--------------------------------------------------------------------------- 2 + Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved. 3 + SPDX-License-Identifier: ISC 4 + ---------------------------------------------------------------------------*) 5 + 6 + (** HTTP CONNECT Tunneling for HTTPS via Proxy 7 + 8 + Per RFC 9110 Section 9.3.6: 9 + The CONNECT method requests that the recipient establish a tunnel 10 + to the destination origin server and, if successful, thereafter restrict 11 + its behavior to blind forwarding of packets in both directions. 12 + 13 + {2 Usage} 14 + 15 + Establish an HTTPS tunnel through an HTTP proxy: 16 + {[ 17 + let tunnel_flow = Proxy_tunnel.connect 18 + ~sw ~net 19 + ~proxy:(Proxy.http "proxy.example.com") 20 + ~target_host:"api.example.com" 21 + ~target_port:443 22 + () 23 + in 24 + (* Now wrap tunnel_flow with TLS and send HTTPS requests *) 25 + ]} *) 26 + 27 + (** Log source for tunnel operations *) 28 + val src : Logs.Src.t 29 + 30 + (** {1 Tunnel Establishment} *) 31 + 32 + val connect : 33 + sw:Eio.Switch.t -> 34 + net:_ Eio.Net.t -> 35 + proxy:Proxy.config -> 36 + target_host:string -> 37 + target_port:int -> 38 + unit -> 39 + [`Close | `Flow | `R | `Shutdown | `W] Eio.Resource.t 40 + (** [connect ~sw ~net ~proxy ~target_host ~target_port ()] establishes 41 + an HTTP tunnel through [proxy] to [target_host:target_port]. 42 + 43 + This performs the following steps per RFC 9110 Section 9.3.6: 44 + 1. Opens a TCP connection to the proxy server 45 + 2. Sends a CONNECT request with the target host:port 46 + 3. Includes Proxy-Authorization header if proxy has auth configured 47 + 4. Waits for a 2xx response from the proxy 48 + 5. Returns the raw connection for the caller to wrap with TLS 49 + 50 + @param sw Eio switch for resource management 51 + @param net Eio network capability 52 + @param proxy Proxy configuration including host, port, and optional auth 53 + @param target_host Destination server hostname 54 + @param target_port Destination server port (typically 443 for HTTPS) 55 + @raise Error.Proxy_error if the CONNECT request fails 56 + @raise Error.Tcp_connect_failed if cannot connect to proxy *) 57 + 58 + val connect_with_tls : 59 + sw:Eio.Switch.t -> 60 + net:_ Eio.Net.t -> 61 + clock:_ Eio.Time.clock -> 62 + proxy:Proxy.config -> 63 + target_host:string -> 64 + target_port:int -> 65 + ?tls_config:Tls.Config.client -> 66 + unit -> 67 + Eio.Flow.two_way_ty Eio.Resource.t 68 + (** [connect_with_tls ~sw ~net ~clock ~proxy ~target_host ~target_port ?tls_config ()] 69 + establishes an HTTPS tunnel and performs TLS handshake. 70 + 71 + This is a convenience function that combines {!connect} with TLS wrapping: 72 + 1. Establishes the tunnel via {!connect} 73 + 2. Performs TLS handshake with the target host through the tunnel 74 + 3. Returns the TLS-wrapped connection ready for HTTPS requests 75 + 76 + @param sw Eio switch for resource management 77 + @param net Eio network capability 78 + @param clock Eio clock for TLS operations 79 + @param proxy Proxy configuration 80 + @param target_host Destination server hostname (used for SNI) 81 + @param target_port Destination server port 82 + @param tls_config Optional custom TLS configuration. If not provided, 83 + uses default configuration from system CA certificates. 84 + @raise Error.Proxy_error if tunnel establishment fails 85 + @raise Error.Tls_handshake_failed if TLS handshake fails *) 86 + 87 + (** {1 Low-level Functions} *) 88 + 89 + val write_connect_request : 90 + Eio.Buf_write.t -> 91 + proxy:Proxy.config -> 92 + target_host:string -> 93 + target_port:int -> 94 + unit 95 + (** [write_connect_request w ~proxy ~target_host ~target_port] writes 96 + a CONNECT request to the buffer. 97 + 98 + Format per RFC 9110 Section 9.3.6: 99 + {v 100 + CONNECT host:port HTTP/1.1 101 + Host: host:port 102 + Proxy-Authorization: Basic ... (if auth configured) 103 + 104 + v} 105 + 106 + This is exposed for testing and custom tunnel implementations. *) 107 + 108 + val parse_connect_response : 109 + Eio.Buf_read.t -> 110 + proxy:Proxy.config -> 111 + target:string -> 112 + unit 113 + (** [parse_connect_response r ~proxy ~target] reads and validates 114 + the CONNECT response from the proxy. 115 + 116 + @raise Error.Proxy_error if the response status is not 2xx *)
+379 -63
lib/requests.ml
··· 13 13 module Headers = Headers 14 14 module Http_date = Http_date 15 15 module Auth = Auth 16 + module Proxy = Proxy 17 + module Proxy_tunnel = Proxy_tunnel 16 18 module Timeout = Timeout 17 19 module Body = Body 18 20 module Response = Response ··· 68 70 base_url : string option; (** Per Recommendation #11: Base URL for relative paths *) 69 71 xsrf_cookie_name : string option; (** Per Recommendation #24: XSRF cookie name *) 70 72 xsrf_header_name : string; (** Per Recommendation #24: XSRF header name *) 73 + proxy : Proxy.config option; (** HTTP/HTTPS proxy configuration *) 71 74 72 75 (* Statistics - mutable but NOTE: when sessions are derived via record update 73 76 syntax ({t with field = value}), these are copied not shared. Each derived ··· 103 106 ?base_url 104 107 ?(xsrf_cookie_name = Some "XSRF-TOKEN") (* Per Recommendation #24 *) 105 108 ?(xsrf_header_name = "X-XSRF-TOKEN") 109 + ?proxy 106 110 env = 107 111 108 112 let clock = env#clock in ··· 226 230 base_url; 227 231 xsrf_cookie_name; 228 232 xsrf_header_name; 233 + proxy; 229 234 requests_made = 0; 230 235 total_time = 0.0; 231 236 retries_count = 0; ··· 255 260 256 261 let cookies (T t) = t.cookie_jar 257 262 let clear_cookies (T t) = Cookeio_jar.clear t.cookie_jar 263 + 264 + let set_proxy (T t) config = 265 + Log.debug (fun m -> m "Setting proxy: %s:%d" config.Proxy.host config.Proxy.port); 266 + T { t with proxy = Some config } 267 + 268 + let clear_proxy (T t) = 269 + Log.debug (fun m -> m "Clearing proxy configuration"); 270 + T { t with proxy = None } 271 + 272 + let proxy (T t) = t.proxy 258 273 259 274 (* Helper to check if two URIs have the same origin for security purposes. 260 275 Used to determine if sensitive headers (Authorization, Cookie) should be ··· 550 565 ); 551 566 Log.info (fun m -> m ""); 552 567 568 + (* Determine if we should use proxy for this URL *) 569 + let use_proxy = match t.proxy with 570 + | None -> false 571 + | Some proxy -> not (Proxy.should_bypass proxy url_to_fetch) 572 + in 573 + 553 574 let make_request_fn () = 554 - Conpool.with_connection redirect_pool redirect_endpoint (fun flow -> 555 - (* Flow is already TLS-wrapped if from https_pool, plain TCP if from http_pool *) 556 - (* Use our low-level HTTP client with 100-continue support and optional auto-decompression *) 557 - Http_client.make_request_100_continue_decompress 558 - ~expect_100:t.expect_100_continue 559 - ~clock:t.clock 560 - ~sw:t.sw 561 - ~method_ ~uri:uri_to_fetch 562 - ~headers:headers_with_cookies ~body:request_body 563 - ~auto_decompress:t.auto_decompress flow 564 - ) 575 + match use_proxy, redirect_is_https, t.proxy with 576 + | false, _, _ -> 577 + (* Direct connection - use connection pool *) 578 + Conpool.with_connection redirect_pool redirect_endpoint (fun flow -> 579 + Http_client.make_request_100_continue_decompress 580 + ~expect_100:t.expect_100_continue 581 + ~clock:t.clock 582 + ~sw:t.sw 583 + ~method_ ~uri:uri_to_fetch 584 + ~headers:headers_with_cookies ~body:request_body 585 + ~auto_decompress:t.auto_decompress flow 586 + ) 587 + 588 + | true, false, Some proxy -> 589 + (* HTTP via proxy - connect to proxy and use absolute-URI form *) 590 + Log.debug (fun m -> m "Routing HTTP request via proxy %s:%d" 591 + proxy.Proxy.host proxy.Proxy.port); 592 + let proxy_endpoint = Conpool.Endpoint.make 593 + ~host:proxy.Proxy.host ~port:proxy.Proxy.port in 594 + Conpool.with_connection t.http_pool proxy_endpoint (fun flow -> 595 + (* Write request using absolute-URI form *) 596 + Http_write.write_and_flush flow (fun w -> 597 + Http_write.request_via_proxy w ~sw:t.sw ~method_ ~uri:uri_to_fetch 598 + ~headers:headers_with_cookies ~body:request_body 599 + ~proxy_auth:proxy.Proxy.auth 600 + ); 601 + (* Read response *) 602 + let limits = Response_limits.default in 603 + let buf_read = Http_read.of_flow ~max_size:65536 flow in 604 + let (_version, status, resp_headers, body_str) = 605 + Http_read.response ~limits buf_read in 606 + (* Handle decompression if enabled *) 607 + let body_str = 608 + if t.auto_decompress then 609 + match Headers.get "content-encoding" resp_headers with 610 + | Some encoding -> 611 + Http_client.decompress_body 612 + ~limits:Response_limits.default 613 + ~content_encoding:encoding body_str 614 + | None -> body_str 615 + else body_str 616 + in 617 + (status, resp_headers, body_str) 618 + ) 619 + 620 + | true, true, Some proxy -> 621 + (* HTTPS via proxy - establish CONNECT tunnel then TLS *) 622 + Log.debug (fun m -> m "Routing HTTPS request via proxy %s:%d (CONNECT tunnel)" 623 + proxy.Proxy.host proxy.Proxy.port); 624 + (* Establish TLS tunnel through proxy *) 625 + let tunnel_flow = Proxy_tunnel.connect_with_tls 626 + ~sw:t.sw ~net:t.net ~clock:t.clock 627 + ~proxy 628 + ~target_host:redirect_host 629 + ~target_port:redirect_port 630 + ?tls_config:t.tls_config 631 + () 632 + in 633 + (* Send request through tunnel using normal format (not absolute-URI) *) 634 + Http_client.make_request_100_continue_decompress 635 + ~expect_100:t.expect_100_continue 636 + ~clock:t.clock 637 + ~sw:t.sw 638 + ~method_ ~uri:uri_to_fetch 639 + ~headers:headers_with_cookies ~body:request_body 640 + ~auto_decompress:t.auto_decompress tunnel_flow 641 + 642 + | true, _, None -> 643 + (* Should not happen due to use_proxy check *) 644 + Conpool.with_connection redirect_pool redirect_endpoint (fun flow -> 645 + Http_client.make_request_100_continue_decompress 646 + ~expect_100:t.expect_100_continue 647 + ~clock:t.clock 648 + ~sw:t.sw 649 + ~method_ ~uri:uri_to_fetch 650 + ~headers:headers_with_cookies ~body:request_body 651 + ~auto_decompress:t.auto_decompress flow 652 + ) 565 653 in 566 654 567 655 (* Apply timeout if specified *) ··· 810 898 module Cmd = struct 811 899 open Cmdliner 812 900 901 + (** Source tracking for configuration values. 902 + Tracks where each configuration value came from for debugging 903 + and transparency. *) 904 + type source = 905 + | Default (** Value from hardcoded default *) 906 + | Env of string (** Value from environment variable (stores var name) *) 907 + | Cmdline (** Value from command-line argument *) 908 + 909 + (** Wrapper for values with source tracking *) 910 + type 'a with_source = { 911 + value : 'a; 912 + source : source; 913 + } 914 + 915 + (** Proxy configuration from command line and environment *) 916 + type proxy_config = { 917 + proxy_url : string with_source option; (** Proxy URL (from HTTP_PROXY/HTTPS_PROXY/etc) *) 918 + no_proxy : string with_source option; (** NO_PROXY patterns *) 919 + } 920 + 813 921 type config = { 814 922 xdg : Xdge.t * Xdge.Cmd.t; 815 - persist_cookies : bool; 816 - verify_tls : bool; 817 - timeout : float option; 818 - max_retries : int; 819 - retry_backoff : float; 820 - follow_redirects : bool; 821 - max_redirects : int; 822 - user_agent : string option; 823 - verbose_http : bool; 923 + persist_cookies : bool with_source; 924 + verify_tls : bool with_source; 925 + timeout : float option with_source; 926 + max_retries : int with_source; 927 + retry_backoff : float with_source; 928 + follow_redirects : bool with_source; 929 + max_redirects : int with_source; 930 + user_agent : string option with_source; 931 + verbose_http : bool with_source; 932 + proxy : proxy_config; 824 933 } 825 934 935 + (** Helper to check environment variable and track source *) 936 + let check_env_bool ~app_name ~suffix ~default = 937 + let env_var = String.uppercase_ascii app_name ^ "_" ^ suffix in 938 + match Sys.getenv_opt env_var with 939 + | Some v when String.lowercase_ascii v = "1" || String.lowercase_ascii v = "true" -> 940 + { value = true; source = Env env_var } 941 + | Some v when String.lowercase_ascii v = "0" || String.lowercase_ascii v = "false" -> 942 + { value = false; source = Env env_var } 943 + | Some _ | None -> { value = default; source = Default } 944 + 945 + let check_env_string ~app_name ~suffix = 946 + let env_var = String.uppercase_ascii app_name ^ "_" ^ suffix in 947 + match Sys.getenv_opt env_var with 948 + | Some v when v <> "" -> Some { value = v; source = Env env_var } 949 + | Some _ | None -> None 950 + 951 + let check_env_float ~app_name ~suffix ~default = 952 + let env_var = String.uppercase_ascii app_name ^ "_" ^ suffix in 953 + match Sys.getenv_opt env_var with 954 + | Some v -> 955 + (try { value = float_of_string v; source = Env env_var } 956 + with _ -> { value = default; source = Default }) 957 + | None -> { value = default; source = Default } 958 + 959 + let check_env_int ~app_name ~suffix ~default = 960 + let env_var = String.uppercase_ascii app_name ^ "_" ^ suffix in 961 + match Sys.getenv_opt env_var with 962 + | Some v -> 963 + (try { value = int_of_string v; source = Env env_var } 964 + with _ -> { value = default; source = Default }) 965 + | None -> { value = default; source = Default } 966 + 967 + (** Parse proxy configuration from environment. 968 + Follows standard HTTP_PROXY/HTTPS_PROXY/ALL_PROXY/NO_PROXY conventions. *) 969 + let proxy_from_env () = 970 + let proxy_url = 971 + (* Check in order of preference *) 972 + match Sys.getenv_opt "HTTP_PROXY" with 973 + | Some v when v <> "" -> Some { value = v; source = Env "HTTP_PROXY" } 974 + | _ -> 975 + match Sys.getenv_opt "http_proxy" with 976 + | Some v when v <> "" -> Some { value = v; source = Env "http_proxy" } 977 + | _ -> 978 + match Sys.getenv_opt "HTTPS_PROXY" with 979 + | Some v when v <> "" -> Some { value = v; source = Env "HTTPS_PROXY" } 980 + | _ -> 981 + match Sys.getenv_opt "https_proxy" with 982 + | Some v when v <> "" -> Some { value = v; source = Env "https_proxy" } 983 + | _ -> 984 + match Sys.getenv_opt "ALL_PROXY" with 985 + | Some v when v <> "" -> Some { value = v; source = Env "ALL_PROXY" } 986 + | _ -> 987 + match Sys.getenv_opt "all_proxy" with 988 + | Some v when v <> "" -> Some { value = v; source = Env "all_proxy" } 989 + | _ -> None 990 + in 991 + let no_proxy = 992 + match Sys.getenv_opt "NO_PROXY" with 993 + | Some v when v <> "" -> Some { value = v; source = Env "NO_PROXY" } 994 + | _ -> 995 + match Sys.getenv_opt "no_proxy" with 996 + | Some v when v <> "" -> Some { value = v; source = Env "no_proxy" } 997 + | _ -> None 998 + in 999 + { proxy_url; no_proxy } 1000 + 826 1001 let create config env sw = 827 1002 let xdg, _xdg_cmd = config.xdg in 828 - let retry = if config.max_retries > 0 then 1003 + let retry = if config.max_retries.value > 0 then 829 1004 Some (Retry.create_config 830 - ~max_retries:config.max_retries 831 - ~backoff_factor:config.retry_backoff ()) 1005 + ~max_retries:config.max_retries.value 1006 + ~backoff_factor:config.retry_backoff.value ()) 832 1007 else None in 833 1008 834 - let timeout = match config.timeout with 1009 + let timeout = match config.timeout.value with 835 1010 | Some t -> Timeout.create ~total:t () 836 1011 | None -> Timeout.default in 837 1012 1013 + (* Build proxy config if URL is set *) 1014 + let proxy = match config.proxy.proxy_url with 1015 + | Some { value = url; _ } -> 1016 + let no_proxy = match config.proxy.no_proxy with 1017 + | Some { value = np; _ } -> 1018 + np |> String.split_on_char ',' 1019 + |> List.map String.trim 1020 + |> List.filter (fun s -> s <> "") 1021 + | None -> [] 1022 + in 1023 + (* Parse proxy URL to extract components *) 1024 + let uri = Uri.of_string url in 1025 + let host = Uri.host uri |> Option.value ~default:"localhost" in 1026 + let port = Uri.port uri |> Option.value ~default:8080 in 1027 + let auth = match Uri.userinfo uri with 1028 + | Some info -> 1029 + (match String.index_opt info ':' with 1030 + | Some idx -> 1031 + let username = String.sub info 0 idx in 1032 + let password = String.sub info (idx + 1) (String.length info - idx - 1) in 1033 + Some (Auth.basic ~username ~password) 1034 + | None -> Some (Auth.basic ~username:info ~password:"")) 1035 + | None -> None 1036 + in 1037 + Some (Proxy.http ~port ?auth ~no_proxy host) 1038 + | None -> None 1039 + in 1040 + 838 1041 let req = create ~sw 839 1042 ~xdg 840 - ~persist_cookies:config.persist_cookies 841 - ~verify_tls:config.verify_tls 1043 + ~persist_cookies:config.persist_cookies.value 1044 + ~verify_tls:config.verify_tls.value 842 1045 ~timeout 843 1046 ?retry 844 - ~follow_redirects:config.follow_redirects 845 - ~max_redirects:config.max_redirects 1047 + ~follow_redirects:config.follow_redirects.value 1048 + ~max_redirects:config.max_redirects.value 1049 + ?proxy 846 1050 env in 847 1051 848 1052 (* Set user agent if provided *) 849 - let req = match config.user_agent with 1053 + let req = match config.user_agent.value with 850 1054 | Some ua -> set_default_header req "User-Agent" ua 851 1055 | None -> req 852 1056 in 853 1057 854 1058 req 855 1059 856 - (* Individual terms - parameterized by app_name *) 1060 + (* Individual terms - parameterized by app_name 1061 + These terms return with_source wrapped values to track provenance *) 857 1062 858 1063 let persist_cookies_term app_name = 859 1064 let doc = "Persist cookies to disk between sessions" in 860 1065 let env_name = String.uppercase_ascii app_name ^ "_PERSIST_COOKIES" in 861 1066 let env_info = Cmdliner.Cmd.Env.info env_name in 862 - Arg.(value & flag & info ["persist-cookies"] ~env:env_info ~doc) 1067 + let cmdline_arg = Arg.(value & flag & info ["persist-cookies"] ~env:env_info ~doc) in 1068 + Term.(const (fun cmdline -> 1069 + if cmdline then 1070 + { value = true; source = Cmdline } 1071 + else 1072 + check_env_bool ~app_name ~suffix:"PERSIST_COOKIES" ~default:false 1073 + ) $ cmdline_arg) 863 1074 864 1075 let verify_tls_term app_name = 865 1076 let doc = "Skip TLS certificate verification (insecure)" in 866 1077 let env_name = String.uppercase_ascii app_name ^ "_NO_VERIFY_TLS" in 867 1078 let env_info = Cmdliner.Cmd.Env.info env_name in 868 - Term.(const (fun no_verify -> not no_verify) $ 869 - Arg.(value & flag & info ["no-verify-tls"] ~env:env_info ~doc)) 1079 + let cmdline_arg = Arg.(value & flag & info ["no-verify-tls"] ~env:env_info ~doc) in 1080 + Term.(const (fun no_verify -> 1081 + if no_verify then 1082 + { value = false; source = Cmdline } 1083 + else 1084 + let env_val = check_env_bool ~app_name ~suffix:"NO_VERIFY_TLS" ~default:false in 1085 + { value = not env_val.value; source = env_val.source } 1086 + ) $ cmdline_arg) 870 1087 871 1088 let timeout_term app_name = 872 1089 let doc = "Request timeout in seconds" in 873 1090 let env_name = String.uppercase_ascii app_name ^ "_TIMEOUT" in 874 1091 let env_info = Cmdliner.Cmd.Env.info env_name in 875 - Arg.(value & opt (some float) None & info ["timeout"] ~env:env_info ~docv:"SECONDS" ~doc) 1092 + let cmdline_arg = Arg.(value & opt (some float) None & info ["timeout"] ~env:env_info ~docv:"SECONDS" ~doc) in 1093 + Term.(const (fun cmdline -> 1094 + match cmdline with 1095 + | Some t -> { value = Some t; source = Cmdline } 1096 + | None -> 1097 + match check_env_string ~app_name ~suffix:"TIMEOUT" with 1098 + | Some { value = v; source } -> 1099 + (try { value = Some (float_of_string v); source } 1100 + with _ -> { value = None; source = Default }) 1101 + | None -> { value = None; source = Default } 1102 + ) $ cmdline_arg) 876 1103 877 1104 let retries_term app_name = 878 1105 let doc = "Maximum number of request retries" in 879 1106 let env_name = String.uppercase_ascii app_name ^ "_MAX_RETRIES" in 880 1107 let env_info = Cmdliner.Cmd.Env.info env_name in 881 - Arg.(value & opt int 3 & info ["max-retries"] ~env:env_info ~docv:"N" ~doc) 1108 + let cmdline_arg = Arg.(value & opt (some int) None & info ["max-retries"] ~env:env_info ~docv:"N" ~doc) in 1109 + Term.(const (fun cmdline -> 1110 + match cmdline with 1111 + | Some n -> { value = n; source = Cmdline } 1112 + | None -> check_env_int ~app_name ~suffix:"MAX_RETRIES" ~default:3 1113 + ) $ cmdline_arg) 882 1114 883 1115 let retry_backoff_term app_name = 884 1116 let doc = "Retry backoff factor for exponential delay" in 885 1117 let env_name = String.uppercase_ascii app_name ^ "_RETRY_BACKOFF" in 886 1118 let env_info = Cmdliner.Cmd.Env.info env_name in 887 - Arg.(value & opt float 0.3 & info ["retry-backoff"] ~env:env_info ~docv:"FACTOR" ~doc) 1119 + let cmdline_arg = Arg.(value & opt (some float) None & info ["retry-backoff"] ~env:env_info ~docv:"FACTOR" ~doc) in 1120 + Term.(const (fun cmdline -> 1121 + match cmdline with 1122 + | Some f -> { value = f; source = Cmdline } 1123 + | None -> check_env_float ~app_name ~suffix:"RETRY_BACKOFF" ~default:0.3 1124 + ) $ cmdline_arg) 888 1125 889 1126 let follow_redirects_term app_name = 890 1127 let doc = "Don't follow HTTP redirects" in 891 1128 let env_name = String.uppercase_ascii app_name ^ "_NO_FOLLOW_REDIRECTS" in 892 1129 let env_info = Cmdliner.Cmd.Env.info env_name in 893 - Term.(const (fun no_follow -> not no_follow) $ 894 - Arg.(value & flag & info ["no-follow-redirects"] ~env:env_info ~doc)) 1130 + let cmdline_arg = Arg.(value & flag & info ["no-follow-redirects"] ~env:env_info ~doc) in 1131 + Term.(const (fun no_follow -> 1132 + if no_follow then 1133 + { value = false; source = Cmdline } 1134 + else 1135 + let env_val = check_env_bool ~app_name ~suffix:"NO_FOLLOW_REDIRECTS" ~default:false in 1136 + { value = not env_val.value; source = env_val.source } 1137 + ) $ cmdline_arg) 895 1138 896 1139 let max_redirects_term app_name = 897 1140 let doc = "Maximum number of redirects to follow" in 898 1141 let env_name = String.uppercase_ascii app_name ^ "_MAX_REDIRECTS" in 899 1142 let env_info = Cmdliner.Cmd.Env.info env_name in 900 - Arg.(value & opt int 10 & info ["max-redirects"] ~env:env_info ~docv:"N" ~doc) 1143 + let cmdline_arg = Arg.(value & opt (some int) None & info ["max-redirects"] ~env:env_info ~docv:"N" ~doc) in 1144 + Term.(const (fun cmdline -> 1145 + match cmdline with 1146 + | Some n -> { value = n; source = Cmdline } 1147 + | None -> check_env_int ~app_name ~suffix:"MAX_REDIRECTS" ~default:10 1148 + ) $ cmdline_arg) 901 1149 902 1150 let user_agent_term app_name = 903 1151 let doc = "User-Agent header to send with requests" in 904 1152 let env_name = String.uppercase_ascii app_name ^ "_USER_AGENT" in 905 1153 let env_info = Cmdliner.Cmd.Env.info env_name in 906 - Arg.(value & opt (some string) None & info ["user-agent"] ~env:env_info ~docv:"STRING" ~doc) 1154 + let cmdline_arg = Arg.(value & opt (some string) None & info ["user-agent"] ~env:env_info ~docv:"STRING" ~doc) in 1155 + Term.(const (fun cmdline -> 1156 + match cmdline with 1157 + | Some ua -> { value = Some ua; source = Cmdline } 1158 + | None -> 1159 + match check_env_string ~app_name ~suffix:"USER_AGENT" with 1160 + | Some { value; source } -> { value = Some value; source } 1161 + | None -> { value = None; source = Default } 1162 + ) $ cmdline_arg) 907 1163 908 1164 let verbose_http_term app_name = 909 1165 let doc = "Enable verbose HTTP-level logging (hexdumps, TLS details)" in 910 1166 let env_name = String.uppercase_ascii app_name ^ "_VERBOSE_HTTP" in 911 1167 let env_info = Cmdliner.Cmd.Env.info env_name in 912 - Arg.(value & flag & info ["verbose-http"] ~env:env_info ~doc) 1168 + let cmdline_arg = Arg.(value & flag & info ["verbose-http"] ~env:env_info ~doc) in 1169 + Term.(const (fun cmdline -> 1170 + if cmdline then 1171 + { value = true; source = Cmdline } 1172 + else 1173 + check_env_bool ~app_name ~suffix:"VERBOSE_HTTP" ~default:false 1174 + ) $ cmdline_arg) 1175 + 1176 + let proxy_term _app_name = 1177 + let doc = "HTTP/HTTPS proxy URL (e.g., http://proxy:8080)" in 1178 + let cmdline_arg = Arg.(value & opt (some string) None & info ["proxy"] ~docv:"URL" ~doc) in 1179 + let no_proxy_doc = "Comma-separated list of hosts to bypass proxy" in 1180 + let no_proxy_arg = Arg.(value & opt (some string) None & info ["no-proxy"] ~docv:"HOSTS" ~doc:no_proxy_doc) in 1181 + Term.(const (fun cmdline_proxy cmdline_no_proxy -> 1182 + let proxy_url = match cmdline_proxy with 1183 + | Some url -> Some { value = url; source = Cmdline } 1184 + | None -> (proxy_from_env ()).proxy_url 1185 + in 1186 + let no_proxy = match cmdline_no_proxy with 1187 + | Some np -> Some { value = np; source = Cmdline } 1188 + | None -> (proxy_from_env ()).no_proxy 1189 + in 1190 + { proxy_url; no_proxy } 1191 + ) $ cmdline_arg $ no_proxy_arg) 913 1192 914 1193 (* Combined terms *) 915 1194 916 1195 let config_term app_name fs = 917 1196 let xdg_term = Xdge.Cmd.term app_name fs 918 1197 ~dirs:[`Config; `Data; `Cache] () in 919 - Term.(const (fun xdg persist verify timeout retries backoff follow max_redir ua verbose -> 1198 + Term.(const (fun xdg persist verify timeout retries backoff follow max_redir ua verbose proxy -> 920 1199 { xdg; persist_cookies = persist; verify_tls = verify; 921 1200 timeout; max_retries = retries; retry_backoff = backoff; 922 1201 follow_redirects = follow; max_redirects = max_redir; 923 - user_agent = ua; verbose_http = verbose }) 1202 + user_agent = ua; verbose_http = verbose; proxy }) 924 1203 $ xdg_term 925 1204 $ persist_cookies_term app_name 926 1205 $ verify_tls_term app_name ··· 930 1209 $ follow_redirects_term app_name 931 1210 $ max_redirects_term app_name 932 1211 $ user_agent_term app_name 933 - $ verbose_http_term app_name) 1212 + $ verbose_http_term app_name 1213 + $ proxy_term app_name) 934 1214 935 1215 let requests_term app_name eio_env sw = 936 1216 let config_t = config_term app_name eio_env#fs in ··· 939 1219 let minimal_term app_name fs = 940 1220 let xdg_term = Xdge.Cmd.term app_name fs 941 1221 ~dirs:[`Data; `Cache] () in 942 - Term.(const (fun (xdg, _xdg_cmd) persist -> (xdg, persist)) 1222 + Term.(const (fun (xdg, _xdg_cmd) persist -> (xdg, persist.value)) 943 1223 $ xdg_term 944 1224 $ persist_cookies_term app_name) 945 1225 ··· 948 1228 Printf.sprintf 949 1229 "## ENVIRONMENT\n\n\ 950 1230 The following environment variables affect %s:\n\n\ 1231 + ### XDG Directories\n\n\ 951 1232 **%s_CONFIG_DIR**\n\ 952 1233 : Override configuration directory location\n\n\ 953 1234 **%s_DATA_DIR**\n\ ··· 960 1241 : Base directory for user data files (default: ~/.local/share)\n\n\ 961 1242 **XDG_CACHE_HOME**\n\ 962 1243 : Base directory for user cache files (default: ~/.cache)\n\n\ 1244 + ### HTTP Settings\n\n\ 963 1245 **%s_PERSIST_COOKIES**\n\ 964 1246 : Set to '1' to persist cookies by default\n\n\ 965 1247 **%s_NO_VERIFY_TLS**\n\ ··· 977 1259 **%s_USER_AGENT**\n\ 978 1260 : User-Agent header to send with requests\n\n\ 979 1261 **%s_VERBOSE_HTTP**\n\ 980 - : Set to '1' to enable verbose HTTP-level logging\ 1262 + : Set to '1' to enable verbose HTTP-level logging\n\n\ 1263 + ### Proxy Configuration\n\n\ 1264 + **HTTP_PROXY** / **http_proxy**\n\ 1265 + : HTTP proxy URL (e.g., http://proxy:8080 or http://user:pass@proxy:8080)\n\n\ 1266 + **HTTPS_PROXY** / **https_proxy**\n\ 1267 + : HTTPS proxy URL (used for HTTPS requests)\n\n\ 1268 + **ALL_PROXY** / **all_proxy**\n\ 1269 + : Fallback proxy URL for all protocols\n\n\ 1270 + **NO_PROXY** / **no_proxy**\n\ 1271 + : Comma-separated list of hosts to bypass proxy (e.g., localhost,*.example.com)\ 981 1272 " 982 1273 app_name app_upper app_upper app_upper 983 1274 app_upper app_upper app_upper app_upper 984 1275 app_upper app_upper app_upper app_upper app_upper 985 1276 986 - let pp_config ppf config = 1277 + (** Pretty-print source type *) 1278 + let pp_source ppf = function 1279 + | Default -> Format.fprintf ppf "default" 1280 + | Env var -> Format.fprintf ppf "env(%s)" var 1281 + | Cmdline -> Format.fprintf ppf "cmdline" 1282 + 1283 + (** Pretty-print a value with its source *) 1284 + let pp_with_source pp_val ppf ws = 1285 + Format.fprintf ppf "%a [%a]" pp_val ws.value pp_source ws.source 1286 + 1287 + let pp_config ?(show_sources = true) ppf config = 987 1288 let _xdg, xdg_cmd = config.xdg in 1289 + let pp_bool = Format.pp_print_bool in 1290 + let pp_float = Format.pp_print_float in 1291 + let pp_int = Format.pp_print_int in 1292 + let pp_string_opt = Format.pp_print_option Format.pp_print_string in 1293 + let pp_float_opt = Format.pp_print_option Format.pp_print_float in 1294 + 1295 + let pp_val pp = if show_sources then pp_with_source pp else fun ppf ws -> pp ppf ws.value in 1296 + 988 1297 Format.fprintf ppf "@[<v>Configuration:@,\ 989 1298 @[<v 2>XDG:@,%a@]@,\ 990 - persist_cookies: %b@,\ 991 - verify_tls: %b@,\ 1299 + persist_cookies: %a@,\ 1300 + verify_tls: %a@,\ 992 1301 timeout: %a@,\ 993 - max_retries: %d@,\ 994 - retry_backoff: %.2f@,\ 995 - follow_redirects: %b@,\ 996 - max_redirects: %d@,\ 1302 + max_retries: %a@,\ 1303 + retry_backoff: %a@,\ 1304 + follow_redirects: %a@,\ 1305 + max_redirects: %a@,\ 997 1306 user_agent: %a@,\ 998 - verbose_http: %b@]" 1307 + verbose_http: %a@,\ 1308 + @[<v 2>Proxy:@,\ 1309 + url: %a@,\ 1310 + no_proxy: %a@]@]" 999 1311 Xdge.Cmd.pp xdg_cmd 1000 - config.persist_cookies 1001 - config.verify_tls 1002 - (Format.pp_print_option Format.pp_print_float) config.timeout 1003 - config.max_retries 1004 - config.retry_backoff 1005 - config.follow_redirects 1006 - config.max_redirects 1007 - (Format.pp_print_option Format.pp_print_string) config.user_agent 1008 - config.verbose_http 1312 + (pp_val pp_bool) config.persist_cookies 1313 + (pp_val pp_bool) config.verify_tls 1314 + (pp_val pp_float_opt) config.timeout 1315 + (pp_val pp_int) config.max_retries 1316 + (pp_val pp_float) config.retry_backoff 1317 + (pp_val pp_bool) config.follow_redirects 1318 + (pp_val pp_int) config.max_redirects 1319 + (pp_val pp_string_opt) config.user_agent 1320 + (pp_val pp_bool) config.verbose_http 1321 + (Format.pp_print_option (pp_with_source Format.pp_print_string)) 1322 + config.proxy.proxy_url 1323 + (Format.pp_print_option (pp_with_source Format.pp_print_string)) 1324 + config.proxy.no_proxy 1009 1325 1010 1326 (* Logging configuration *) 1011 1327 let setup_log_sources ?(verbose_http = false) level =
+172 -39
lib/requests.mli
··· 243 243 ?base_url:string -> 244 244 ?xsrf_cookie_name:string option -> 245 245 ?xsrf_header_name:string -> 246 + ?proxy:Proxy.config -> 246 247 < clock: _ Eio.Time.clock; net: _ Eio.Net.t; fs: Eio.Fs.dir_ty Eio.Path.t; .. > -> 247 248 t 248 249 (** Create a new requests instance with persistent state and connection pooling. ··· 272 273 @param base_url Base URL for relative paths (per Recommendation #11). Relative URLs are resolved against this. 273 274 @param xsrf_cookie_name Cookie name to extract XSRF token from (default: Some "XSRF-TOKEN", per Recommendation #24). Set to None to disable. 274 275 @param xsrf_header_name Header name to inject XSRF token into (default: "X-XSRF-TOKEN") 276 + @param proxy HTTP/HTTPS proxy configuration. When set, requests are routed through the proxy. 277 + HTTP requests use absolute-URI form (RFC 9112 Section 3.2.2). 278 + HTTPS requests use CONNECT tunneling (RFC 9110 Section 9.3.6). 275 279 276 280 {b Note:} HTTP caching has been disabled for simplicity. See CACHEIO.md for integration notes 277 281 if you need to restore caching functionality in the future. ··· 475 479 val clear_cookies : t -> unit 476 480 (** Clear all cookies *) 477 481 482 + (** {2 Proxy Configuration} *) 483 + 484 + val set_proxy : t -> Proxy.config -> t 485 + (** Set HTTP/HTTPS proxy configuration. Returns a new session with proxy configured. 486 + When set, requests are routed through the proxy: 487 + - HTTP requests use absolute-URI form (RFC 9112 Section 3.2.2) 488 + - HTTPS requests use CONNECT tunneling (RFC 9110 Section 9.3.6) 489 + 490 + Example: 491 + {[ 492 + let proxy = Proxy.http ~port:8080 "proxy.example.com" in 493 + let session = Requests.set_proxy session proxy 494 + ]} *) 495 + 496 + val clear_proxy : t -> t 497 + (** Remove proxy configuration. Returns a new session without proxy. *) 498 + 499 + val proxy : t -> Proxy.config option 500 + (** Get the current proxy configuration, if any. *) 501 + 478 502 (** {1 Cmdliner Integration} *) 479 503 480 504 module Cmd : sig ··· 482 506 483 507 This module provides command-line argument handling for configuring 484 508 HTTP requests, including XDG directory paths, timeouts, retries, 485 - and other parameters. *) 509 + proxy settings, and other parameters. 510 + 511 + {2 Source Tracking} 512 + 513 + Configuration values include source tracking to indicate where 514 + each value came from (command line, environment variable, or default). 515 + This enables transparent debugging and helps users understand 516 + how their configuration was resolved. 517 + 518 + {[ 519 + let config = ... in 520 + if show_sources then 521 + Format.printf "%a@." (Cmd.pp_config ~show_sources:true) config 522 + ]} *) 523 + 524 + (** {2 Source Tracking Types} *) 525 + 526 + (** Source of a configuration value. 527 + Tracks where each configuration value originated from for debugging 528 + and transparency. *) 529 + type source = 530 + | Default (** Value from hardcoded default *) 531 + | Env of string (** Value from environment variable (stores var name) *) 532 + | Cmdline (** Value from command-line argument *) 486 533 487 - (** Configuration from command line and environment *) 534 + (** Wrapper for values with source tracking *) 535 + type 'a with_source = { 536 + value : 'a; (** The actual configuration value *) 537 + source : source; (** Where the value came from *) 538 + } 539 + 540 + (** Proxy configuration from command line and environment *) 541 + type proxy_config = { 542 + proxy_url : string with_source option; (** Proxy URL (from HTTP_PROXY/HTTPS_PROXY/etc) *) 543 + no_proxy : string with_source option; (** NO_PROXY patterns *) 544 + } 545 + 546 + (** {2 Configuration Type} *) 547 + 548 + (** Configuration from command line and environment. 549 + All values include source tracking for debugging. *) 488 550 type config = { 489 - xdg : Xdge.t * Xdge.Cmd.t; (** XDG paths and their sources *) 490 - persist_cookies : bool; (** Whether to persist cookies *) 491 - verify_tls : bool; (** Whether to verify TLS certificates *) 492 - timeout : float option; (** Request timeout in seconds *) 493 - max_retries : int; (** Maximum number of retries *) 494 - retry_backoff : float; (** Retry backoff factor *) 495 - follow_redirects : bool; (** Whether to follow redirects *) 496 - max_redirects : int; (** Maximum number of redirects *) 497 - user_agent : string option; (** User-Agent header *) 498 - verbose_http : bool; (** Enable verbose HTTP-level logging *) 551 + xdg : Xdge.t * Xdge.Cmd.t; (** XDG paths and their sources *) 552 + persist_cookies : bool with_source; (** Whether to persist cookies *) 553 + verify_tls : bool with_source; (** Whether to verify TLS certificates *) 554 + timeout : float option with_source; (** Request timeout in seconds *) 555 + max_retries : int with_source; (** Maximum number of retries *) 556 + retry_backoff : float with_source; (** Retry backoff factor *) 557 + follow_redirects : bool with_source; (** Whether to follow redirects *) 558 + max_redirects : int with_source; (** Maximum number of redirects *) 559 + user_agent : string option with_source; (** User-Agent header *) 560 + verbose_http : bool with_source; (** Enable verbose HTTP-level logging *) 561 + proxy : proxy_config; (** Proxy configuration *) 499 562 } 500 563 501 564 val create : config -> < clock: _ Eio.Time.clock; net: _ Eio.Net.t; fs: Eio.Fs.dir_ty Eio.Path.t; .. > -> Eio.Switch.t -> t 502 - (** [create config env sw] creates a requests instance from command-line configuration *) 565 + (** [create config env sw] creates a requests instance from command-line configuration. 566 + Proxy configuration from the config is applied automatically. *) 503 567 504 - (** {2 Individual Terms} *) 568 + (** {2 Individual Terms} 569 + 570 + Each term returns a value with source tracking to indicate whether 571 + the value came from the command line, environment, or default. 572 + Source precedence: Cmdline > Env > Default *) 505 573 506 - val persist_cookies_term : string -> bool Cmdliner.Term.t 507 - (** Term for [--persist-cookies] flag with app-specific env var *) 574 + val persist_cookies_term : string -> bool with_source Cmdliner.Term.t 575 + (** Term for [--persist-cookies] flag with app-specific env var. 576 + Env var: [{APP_NAME}_PERSIST_COOKIES] *) 508 577 509 - val verify_tls_term : string -> bool Cmdliner.Term.t 510 - (** Term for [--no-verify-tls] flag with app-specific env var *) 578 + val verify_tls_term : string -> bool with_source Cmdliner.Term.t 579 + (** Term for [--no-verify-tls] flag with app-specific env var. 580 + Env var: [{APP_NAME}_NO_VERIFY_TLS] *) 511 581 512 - val timeout_term : string -> float option Cmdliner.Term.t 513 - (** Term for [--timeout SECONDS] option with app-specific env var *) 582 + val timeout_term : string -> float option with_source Cmdliner.Term.t 583 + (** Term for [--timeout SECONDS] option with app-specific env var. 584 + Env var: [{APP_NAME}_TIMEOUT] *) 514 585 515 - val retries_term : string -> int Cmdliner.Term.t 516 - (** Term for [--max-retries N] option with app-specific env var *) 586 + val retries_term : string -> int with_source Cmdliner.Term.t 587 + (** Term for [--max-retries N] option with app-specific env var. 588 + Env var: [{APP_NAME}_MAX_RETRIES] *) 517 589 518 - val retry_backoff_term : string -> float Cmdliner.Term.t 519 - (** Term for [--retry-backoff FACTOR] option with app-specific env var *) 590 + val retry_backoff_term : string -> float with_source Cmdliner.Term.t 591 + (** Term for [--retry-backoff FACTOR] option with app-specific env var. 592 + Env var: [{APP_NAME}_RETRY_BACKOFF] *) 520 593 521 - val follow_redirects_term : string -> bool Cmdliner.Term.t 522 - (** Term for [--no-follow-redirects] flag with app-specific env var *) 594 + val follow_redirects_term : string -> bool with_source Cmdliner.Term.t 595 + (** Term for [--no-follow-redirects] flag with app-specific env var. 596 + Env var: [{APP_NAME}_NO_FOLLOW_REDIRECTS] *) 523 597 524 - val max_redirects_term : string -> int Cmdliner.Term.t 525 - (** Term for [--max-redirects N] option with app-specific env var *) 598 + val max_redirects_term : string -> int with_source Cmdliner.Term.t 599 + (** Term for [--max-redirects N] option with app-specific env var. 600 + Env var: [{APP_NAME}_MAX_REDIRECTS] *) 526 601 527 - val user_agent_term : string -> string option Cmdliner.Term.t 528 - (** Term for [--user-agent STRING] option with app-specific env var *) 602 + val user_agent_term : string -> string option with_source Cmdliner.Term.t 603 + (** Term for [--user-agent STRING] option with app-specific env var. 604 + Env var: [{APP_NAME}_USER_AGENT] *) 529 605 530 - val verbose_http_term : string -> bool Cmdliner.Term.t 606 + val verbose_http_term : string -> bool with_source Cmdliner.Term.t 531 607 (** Term for [--verbose-http] flag with app-specific env var. 532 608 533 609 Enables verbose HTTP-level logging including hexdumps, TLS details, 534 610 and low-level protocol information. Typically used in conjunction 535 - with debug-level logging. *) 611 + with debug-level logging. 612 + Env var: [{APP_NAME}_VERBOSE_HTTP] *) 613 + 614 + val proxy_term : string -> proxy_config Cmdliner.Term.t 615 + (** Term for [--proxy URL] and [--no-proxy HOSTS] options. 616 + 617 + Provides cmdliner integration for proxy configuration with proper 618 + source tracking. Environment variables are checked in order: 619 + HTTP_PROXY, http_proxy, HTTPS_PROXY, https_proxy, ALL_PROXY, all_proxy. 620 + 621 + {b Generated Flags:} 622 + - [--proxy URL]: HTTP/HTTPS proxy URL (e.g., http://proxy:8080) 623 + - [--no-proxy HOSTS]: Comma-separated list of hosts to bypass proxy 624 + 625 + {b Environment Variables:} 626 + - [HTTP_PROXY] / [http_proxy]: HTTP proxy URL 627 + - [HTTPS_PROXY] / [https_proxy]: HTTPS proxy URL 628 + - [ALL_PROXY] / [all_proxy]: Fallback proxy URL for all protocols 629 + - [NO_PROXY] / [no_proxy]: Hosts to bypass proxy *) 536 630 537 631 (** {2 Combined Terms} *) 538 632 ··· 540 634 (** [config_term app_name fs] creates a complete configuration term. 541 635 542 636 This combines all individual terms plus XDG configuration into 543 - a single term that can be used to configure requests. 637 + a single term that can be used to configure requests. All values 638 + include source tracking. 544 639 545 640 {b Generated Flags:} 546 641 - [--config-dir DIR]: Configuration directory ··· 555 650 - [--max-redirects N]: Maximum redirects to follow 556 651 - [--user-agent STRING]: User-Agent header 557 652 - [--verbose-http]: Enable verbose HTTP-level logging 653 + - [--proxy URL]: HTTP/HTTPS proxy URL 654 + - [--no-proxy HOSTS]: Hosts to bypass proxy 558 655 559 656 {b Example:} 560 657 {[ ··· 596 693 - [--cache-dir DIR]: Cache directory for responses 597 694 - [--persist-cookies]: Cookie persistence flag 598 695 599 - Returns the XDG context and persist_cookies boolean. 696 + Returns the XDG context and persist_cookies boolean (without source tracking 697 + for simplified usage). 600 698 601 699 {b Example:} 602 700 {[ ··· 611 709 Cmd.eval cmd 612 710 ]} *) 613 711 614 - (** {2 Documentation} *) 712 + (** {2 Documentation and Pretty-Printing} *) 615 713 616 714 val env_docs : string -> string 617 715 (** [env_docs app_name] generates environment variable documentation. 618 716 619 717 Returns formatted documentation for all environment variables that 620 - affect requests configuration, including XDG variables. 718 + affect requests configuration, including XDG variables and proxy settings. 621 719 622 720 {b Included Variables:} 623 721 - [${APP_NAME}_CONFIG_DIR]: Configuration directory ··· 625 723 - [${APP_NAME}_CACHE_DIR]: Cache directory 626 724 - [${APP_NAME}_STATE_DIR]: State directory 627 725 - [XDG_CONFIG_HOME], [XDG_DATA_HOME], [XDG_CACHE_HOME], [XDG_STATE_HOME] 628 - - [HTTP_PROXY], [HTTPS_PROXY], [NO_PROXY] (when proxy support is added) 726 + - [HTTP_PROXY], [HTTPS_PROXY], [ALL_PROXY]: Proxy URLs 727 + - [NO_PROXY]: Hosts to bypass proxy 629 728 630 729 {b Example:} 631 730 {[ ··· 635 734 () 636 735 ]} *) 637 736 638 - val pp_config : Format.formatter -> config -> unit 639 - (** Pretty print configuration for debugging *) 737 + val pp_source : Format.formatter -> source -> unit 738 + (** Pretty print a source type. 739 + Output format: "default", "env(VAR_NAME)", or "cmdline" *) 740 + 741 + val pp_with_source : (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a with_source -> unit 742 + (** [pp_with_source pp_val ppf ws] pretty prints a value with its source. 743 + Output format: "value [source]" 744 + 745 + {b Example:} 746 + {[ 747 + let pp_bool_with_source = Cmd.pp_with_source Format.pp_print_bool in 748 + Format.printf "%a@." pp_bool_with_source config.verify_tls 749 + (* Output: true [env(MYAPP_NO_VERIFY_TLS)] *) 750 + ]} *) 751 + 752 + val pp_config : ?show_sources:bool -> Format.formatter -> config -> unit 753 + (** [pp_config ?show_sources ppf config] pretty prints configuration for debugging. 754 + 755 + @param show_sources If true (default), shows the source of each value 756 + (e.g., "default", "env(VAR_NAME)", "cmdline"). If false, only 757 + shows the values without source annotations. 758 + 759 + {b Example:} 760 + {[ 761 + (* Show full config with sources *) 762 + Format.printf "%a@." (Cmd.pp_config ~show_sources:true) config; 763 + 764 + (* Show config without sources for cleaner output *) 765 + Format.printf "%a@." (Cmd.pp_config ~show_sources:false) config; 766 + ]} *) 640 767 641 768 (** {2 Logging Configuration} *) 642 769 ··· 705 832 706 833 (** Authentication schemes (Basic, Bearer, OAuth, etc.) *) 707 834 module Auth = Auth 835 + 836 + (** HTTP/HTTPS proxy configuration *) 837 + module Proxy = Proxy 838 + 839 + (** HTTPS proxy tunneling via CONNECT *) 840 + module Proxy_tunnel = Proxy_tunnel 708 841 709 842 (** Error types and exception handling *) 710 843 module Error = Error