My agentic slop goes here. Not intended for anyone else!
anil.recoil.org
1(** Low-level HTTP/1.1 client over raw TCP connections for connection pooling *)
2
3let src = Logs.Src.create "requests.http_client" ~doc:"Low-level HTTP client"
4module Log = (val Logs.src_log src : Logs.LOG)
5
6(** Build HTTP/1.1 request as a string *)
7let build_request ~method_ ~uri ~headers ~body_str =
8 let path = Uri.path uri in
9 let path = if path = "" then "/" else path in
10 let query = Uri.query uri in
11 let path_with_query =
12 if query = [] then path
13 else path ^ "?" ^ (Uri.encoded_of_query query)
14 in
15
16 let host = match Uri.host uri with
17 | Some h -> h
18 | None -> failwith "URI must have a host"
19 in
20
21 let port = match Uri.port uri with
22 | Some p -> ":" ^ string_of_int p
23 | None ->
24 match Uri.scheme uri with
25 | Some "https" -> ":443"
26 | Some "http" -> ":80"
27 | _ -> ""
28 in
29
30 (* Build request line *)
31 let request_line = Printf.sprintf "%s %s HTTP/1.1\r\n" method_ path_with_query in
32
33 (* Ensure Host header is present *)
34 let headers = if not (Headers.mem "host" headers) then
35 Headers.add "host" (host ^ port) headers
36 else headers in
37
38 (* Ensure Connection header for keep-alive *)
39 let headers = if not (Headers.mem "connection" headers) then
40 Headers.add "connection" "keep-alive" headers
41 else headers in
42
43 (* Add Content-Length if we have a body *)
44 let headers =
45 if body_str <> "" && not (Headers.mem "content-length" headers) then
46 let len = String.length body_str in
47 Headers.add "content-length" (string_of_int len) headers
48 else headers
49 in
50
51 (* Build headers section *)
52 let headers_str =
53 Headers.to_list headers
54 |> List.map (fun (k, v) -> Printf.sprintf "%s: %s\r\n" k v)
55 |> String.concat ""
56 in
57
58 request_line ^ headers_str ^ "\r\n" ^ body_str
59
60(** Parse HTTP response status line *)
61let parse_status_line line =
62 match String.split_on_char ' ' line with
63 | "HTTP/1.1" :: code :: _ | "HTTP/1.0" :: code :: _ ->
64 (try int_of_string code
65 with _ -> failwith ("Invalid status code: " ^ code))
66 | _ -> failwith ("Invalid status line: " ^ line)
67
68(** Parse HTTP headers from buffer reader *)
69let parse_headers buf_read =
70 let rec read_headers acc =
71 let line = Eio.Buf_read.line buf_read in
72 if line = "" then List.rev acc
73 else begin
74 match String.index_opt line ':' with
75 | None -> read_headers acc
76 | Some idx ->
77 let name = String.sub line 0 idx |> String.trim |> String.lowercase_ascii in
78 let value = String.sub line (idx + 1) (String.length line - idx - 1) |> String.trim in
79 read_headers ((name, value) :: acc)
80 end
81 in
82 read_headers [] |> Headers.of_list
83
84(** Read body with Content-Length *)
85let read_fixed_body buf_read length =
86 let buf = Buffer.create (Int64.to_int length) in
87 let rec read_n remaining =
88 if remaining > 0L then begin
89 let to_read = min 8192 (Int64.to_int remaining) in
90 let chunk = Eio.Buf_read.take to_read buf_read in
91 Buffer.add_string buf chunk;
92 read_n (Int64.sub remaining (Int64.of_int (String.length chunk)))
93 end
94 in
95 read_n length;
96 Buffer.contents buf
97
98(** Read chunked body *)
99let read_chunked_body buf_read =
100 let buf = Buffer.create 4096 in
101 let rec read_chunks () =
102 let size_line = Eio.Buf_read.line buf_read in
103 (* Parse hex chunk size, ignore extensions after ';' *)
104 let size_str = match String.index_opt size_line ';' with
105 | Some idx -> String.sub size_line 0 idx
106 | None -> size_line
107 in
108 let chunk_size = int_of_string ("0x" ^ size_str) in
109 if chunk_size = 0 then begin
110 (* Read trailing headers (if any) until empty line *)
111 let rec skip_trailers () =
112 let line = Eio.Buf_read.line buf_read in
113 if line <> "" then skip_trailers ()
114 in
115 skip_trailers ()
116 end else begin
117 let chunk = Eio.Buf_read.take chunk_size buf_read in
118 Buffer.add_string buf chunk;
119 let _crlf = Eio.Buf_read.line buf_read in (* Read trailing CRLF *)
120 read_chunks ()
121 end
122 in
123 read_chunks ();
124 Buffer.contents buf
125
126(** Make HTTP request over a pooled connection *)
127let make_request ~method_ ~uri ~headers ~body_str flow =
128 Log.debug (fun m -> m "Making %s request to %s" method_ (Uri.to_string uri));
129
130 (* Build and send request *)
131 let request_str = build_request ~method_ ~uri ~headers ~body_str in
132 Eio.Flow.copy_string request_str flow;
133
134 (* Read and parse response *)
135 let buf_read = Eio.Buf_read.of_flow flow ~max_size:max_int in
136
137 (* Parse status line *)
138 let status_line = Eio.Buf_read.line buf_read in
139 let status = parse_status_line status_line in
140
141 Log.debug (fun m -> m "Received response status: %d" status);
142
143 (* Parse headers *)
144 let resp_headers = parse_headers buf_read in
145
146 (* Determine how to read body *)
147 let transfer_encoding = Headers.get "transfer-encoding" resp_headers in
148 let content_length = Headers.get "content-length" resp_headers |> Option.map Int64.of_string in
149
150 let body_str = match transfer_encoding, content_length with
151 | Some te, _ when String.lowercase_ascii te |> String.trim = "chunked" ->
152 Log.debug (fun m -> m "Reading chunked response body");
153 read_chunked_body buf_read
154 | _, Some len ->
155 Log.debug (fun m -> m "Reading fixed-length response body (%Ld bytes)" len);
156 read_fixed_body buf_read len
157 | Some other_te, None ->
158 Log.warn (fun m -> m "Unsupported transfer-encoding: %s, assuming no body" other_te);
159 ""
160 | None, None ->
161 Log.debug (fun m -> m "No body indicated");
162 ""
163 in
164
165 (status, resp_headers, body_str)