gazagnaire.org
forked from
anil.recoil.org/ocaml-requests
A batteries included HTTP/1.1 client in OCaml
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: The CONNECT method requests that the recipient
9 establish a tunnel to the destination origin server and, if successful,
10 thereafter restrict its behavior to blind forwarding of packets in both
11 directions. *)
12
13let src = Logs.Src.create "requests.proxy_tunnel" ~doc:"HTTPS proxy tunneling"
14
15module Log = (val Logs.src_log src : Logs.LOG)
16module Write = Eio.Buf_write
17module Read = Eio.Buf_read
18
19(** {1 Low-level Functions} *)
20
21let write_connect_request w ~proxy ~target_host ~target_port =
22 let target = Fmt.str "%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.find `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 ->
54 m "Wrote CONNECT request for %s via %s:%d" target proxy.Proxy.host
55 proxy.Proxy.port)
56
57let parse_connect_response r ~proxy ~target =
58 (* Parse status line - we just need version and status code *)
59 let version_str =
60 Read.take_while
61 (function
62 | 'A' .. 'Z' | 'a' .. 'z' | '0' .. '9' | '/' | '.' -> true | _ -> false)
63 r
64 in
65 Read.char ' ' r;
66 let status_str =
67 Read.take_while (function '0' .. '9' -> true | _ -> false) r
68 in
69 Read.char ' ' r;
70 let reason = Read.line r in
71
72 let status =
73 try int_of_string status_str
74 with Failure _ ->
75 raise
76 (Error.proxy_errorf ~host:proxy.Proxy.host
77 "Invalid status code in CONNECT response: %s" status_str)
78 in
79
80 Log.debug (fun m -> m "CONNECT response: %s %d %s" version_str status reason);
81
82 (* Read headers until empty line *)
83 let rec skip_headers () =
84 let line = Read.line r in
85 if line <> "" then skip_headers ()
86 in
87 skip_headers ();
88
89 (* Check for success (2xx) *)
90 if status < 200 || status >= 300 then
91 raise
92 (Error.proxy_errorf ~host:proxy.Proxy.host "CONNECT to %s failed: %d %s"
93 target status reason);
94
95 Log.info (fun m ->
96 m "CONNECT tunnel established to %s via proxy %s:%d" target
97 proxy.Proxy.host proxy.Proxy.port)
98
99(** {1 Tunnel Establishment} *)
100
101let connect ~sw ~net ~proxy ~target_host ~target_port () =
102 let target = Fmt.str "%s:%d" target_host target_port in
103
104 Log.debug (fun m ->
105 m "Establishing CONNECT tunnel to %s via %s:%d" target proxy.Proxy.host
106 proxy.Proxy.port);
107
108 (* Connect to proxy server *)
109 let proxy_addr =
110 let addrs =
111 Eio.Net.getaddrinfo_stream net proxy.Proxy.host
112 ~service:(string_of_int proxy.Proxy.port)
113 in
114 match addrs with
115 | [] ->
116 raise
117 (Error.err
118 (Error.Dns_resolution_failed { hostname = proxy.Proxy.host }))
119 | addr :: _ -> addr
120 in
121
122 let flow =
123 try Eio.Net.connect ~sw net proxy_addr
124 with exn ->
125 raise
126 (Error.err
127 (Error.Tcp_connect_failed
128 {
129 host = proxy.Proxy.host;
130 port = proxy.Proxy.port;
131 reason = Printexc.to_string exn;
132 }))
133 in
134
135 Log.debug (fun m ->
136 m "Connected to proxy %s:%d" proxy.Proxy.host proxy.Proxy.port);
137
138 (* Send CONNECT request *)
139 Http_write.write_and_flush flow (fun w ->
140 write_connect_request w ~proxy ~target_host ~target_port);
141
142 (* Read and validate response *)
143 let buf_read = Read.of_flow ~max_size:65536 flow in
144 parse_connect_response buf_read ~proxy ~target;
145
146 (* Return the raw flow - caller is responsible for TLS wrapping *)
147 (flow :> [ `Close | `Flow | `R | `Shutdown | `W ] Eio.Resource.t)
148
149let default_tls_config ~target_host =
150 let authenticator =
151 match Ca_certs.authenticator () with
152 | Ok auth -> auth
153 | Error (`Msg msg) ->
154 Log.warn (fun m ->
155 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
162 (Error.err
163 (Error.Tls_handshake_failed
164 { host = target_host; reason = "TLS config error: " ^ msg }))
165
166let connect_with_tls ~sw ~net ~clock:_ ~proxy ~target_host ~target_port
167 ?tls_config () =
168 (* First establish the tunnel *)
169 let tunnel_flow = connect ~sw ~net ~proxy ~target_host ~target_port () in
170
171 (* Get or create TLS config *)
172 let tls_config =
173 match tls_config with
174 | Some cfg -> cfg
175 | None -> default_tls_config ~target_host
176 in
177
178 (* Perform TLS handshake through the tunnel *)
179 let host =
180 match Domain_name.of_string target_host with
181 | Ok domain -> (
182 match Domain_name.host domain with
183 | Ok host -> host
184 | Error (`Msg msg) ->
185 raise
186 (Error.tls_handshake_failedf ~host:target_host
187 "Invalid hostname for SNI: %s" msg))
188 | Error (`Msg msg) ->
189 raise
190 (Error.tls_handshake_failedf ~host:target_host
191 "Invalid domain name: %s" msg)
192 in
193
194 Log.debug (fun m ->
195 m "Starting TLS handshake with %s through tunnel" target_host);
196
197 try
198 let tls_flow = Tls_eio.client_of_flow tls_config ~host tunnel_flow in
199 Log.info (fun m ->
200 m "TLS tunnel established to %s via proxy %s:%d" target_host
201 proxy.Proxy.host proxy.Proxy.port);
202 (tls_flow :> Eio.Flow.two_way_ty Eio.Resource.t)
203 with exn ->
204 raise
205 (Error.tls_handshake_failedf ~host:target_host "%s"
206 (Printexc.to_string exn))