My agentic slop goes here. Not intended for anyone else!
anil.recoil.org
1open Eio
2open Cmdliner
3
4(* Command-line options *)
5let http_method =
6 let methods = [
7 ("GET", `GET);
8 ("POST", `POST);
9 ("PUT", `PUT);
10 ("DELETE", `DELETE);
11 ("HEAD", `HEAD);
12 ("OPTIONS", `OPTIONS);
13 ("PATCH", `PATCH);
14 ] in
15 let doc = "HTTP method to use" in
16 let env_info = Cmdliner.Cmd.Env.info "OCURL_METHOD" in
17 Arg.(value & opt (enum methods) `GET & info ["X"; "request"] ~env:env_info ~docv:"METHOD" ~doc)
18
19let urls =
20 let doc = "URL(s) to fetch" in
21 Arg.(non_empty & pos_all string [] & info [] ~docv:"URL" ~doc)
22
23let headers =
24 let doc = "Add custom HTTP header (can be used multiple times)" in
25 Arg.(value & opt_all string [] & info ["H"; "header"] ~docv:"HEADER" ~doc)
26
27let data =
28 let doc = "HTTP POST/PUT data" in
29 Arg.(value & opt (some string) None & info ["d"; "data"] ~docv:"DATA" ~doc)
30
31let json_data =
32 let doc = "HTTP POST/PUT JSON data" in
33 Arg.(value & opt (some string) None & info ["json"] ~docv:"JSON" ~doc)
34
35let output_file =
36 let doc = "Write output to file instead of stdout" in
37 Arg.(value & opt (some string) None & info ["o"; "output"] ~docv:"FILE" ~doc)
38
39let include_headers =
40 let doc = "Include response headers in output" in
41 Arg.(value & flag & info ["i"; "include"] ~doc)
42
43let auth =
44 let doc = "Basic authentication in USER:PASSWORD format" in
45 Arg.(value & opt (some string) None & info ["u"; "user"] ~docv:"USER:PASS" ~doc)
46
47(* Note: verbose (-v, --verbose) and quiet (-q, --quiet) functionality is provided
48 by Logs_cli through standard command line options *)
49
50let show_progress =
51 let doc = "Show progress bar for downloads" in
52 Arg.(value & flag & info ["progress-bar"] ~doc)
53
54(* Logging setup *)
55(* Setup logging using Logs_cli for standard logging options *)
56let setup_log =
57 let setup style_renderer level =
58 Fmt_tty.setup_std_outputs ?style_renderer ();
59 Logs.set_level level;
60 Logs.set_reporter (Logs_fmt.reporter ());
61 (* Set specific log levels for requests modules based on verbosity *)
62 match level with
63 | Some Logs.Debug ->
64 (* Enable debug logging for all requests modules *)
65 Logs.Src.set_level Requests.src (Some Logs.Debug);
66 Logs.Src.set_level Requests.Auth.src (Some Logs.Debug);
67 Logs.Src.set_level Requests.Body.src (Some Logs.Debug);
68 Logs.Src.set_level Requests.Response.src (Some Logs.Debug);
69 Logs.Src.set_level Requests.Retry.src (Some Logs.Debug);
70 Logs.Src.set_level Requests.One.src (Some Logs.Debug);
71 Logs.Src.set_level Requests.Headers.src (Some Logs.Debug);
72 Logs.Src.set_level Requests.Error.src (Some Logs.Debug);
73 Logs.Src.set_level Requests.Method.src (Some Logs.Debug);
74 Logs.Src.set_level Requests.Mime.src (Some Logs.Debug);
75 Logs.Src.set_level Requests.Status.src (Some Logs.Debug);
76 Logs.Src.set_level Requests.Timeout.src (Some Logs.Debug)
77 | Some Logs.Info ->
78 (* Set info level for main modules *)
79 Logs.Src.set_level Requests.src (Some Logs.Info);
80 Logs.Src.set_level Requests.Response.src (Some Logs.Info);
81 Logs.Src.set_level Requests.One.src (Some Logs.Info)
82 | _ -> ()
83 in
84 Term.(const setup $ Fmt_cli.style_renderer () $ Logs_cli.level ())
85
86(* Parse authentication *)
87let parse_auth auth_str =
88 match String.split_on_char ':' auth_str with
89 | [user; pass] -> Some (user, pass)
90 | _ -> None
91
92(* Parse headers *)
93let parse_header header_str =
94 match String.split_on_char ':' header_str with
95 | [] -> None
96 | [name] -> Some (String.trim name, "")
97 | name :: rest ->
98 Some (String.trim name, String.trim (String.concat ":" rest))
99
100(* Pretty print response *)
101let pp_response ppf response =
102 let status = Requests.Response.status response in
103 let status_code = Requests.Response.status_code response in
104 let headers = Requests.Response.headers response in
105
106 (* Color code status *)
107 let status_style =
108 if Requests.Status.is_success status then Fmt.(styled `Green)
109 else if Requests.Status.is_client_error status then Fmt.(styled `Yellow)
110 else if Requests.Status.is_server_error status then Fmt.(styled `Red)
111 else Fmt.(styled `Blue)
112 in
113
114 (* Print status line *)
115 Fmt.pf ppf "@[<v>HTTP/1.1 %d %a@]@."
116 status_code
117 (status_style Fmt.string) (Requests.Status.reason_phrase status);
118
119 (* Print headers *)
120 let header_list = Requests.Headers.to_list headers in
121 List.iter (fun (k, v) ->
122 Fmt.pf ppf "@[<h>%a: %s@]@."
123 Fmt.(styled `Cyan string) k v
124 ) header_list;
125
126 Fmt.pf ppf "@."
127
128(* Process a single URL and return result *)
129let process_url env req method_ headers body include_headers output url_str =
130 let quiet = match Logs.level () with Some (Logs.Error | Logs.Warning) -> true | _ -> false in
131 let uri = Uri.of_string url_str in
132
133 if not quiet then begin
134 let method_str = Requests.Method.to_string (method_ :> Requests.Method.t) in
135 Fmt.pr "@[<v>%a %a@]@."
136 Fmt.(styled `Bold string) method_str
137 Fmt.(styled `Underline Uri.pp) uri;
138 end;
139 try
140 (* Make request *)
141 let response =
142 match method_ with
143 | `GET -> Requests.get req ~headers url_str
144 | `POST -> Requests.post req ~headers ?body url_str
145 | `PUT -> Requests.put req ~headers ?body url_str
146 | `DELETE -> Requests.delete req ~headers url_str
147 | `HEAD -> Requests.head req ~headers url_str
148 | `OPTIONS -> Requests.options req ~headers url_str
149 | `PATCH -> Requests.patch req ~headers ?body url_str
150 in
151
152 (* Print response headers if requested *)
153 if include_headers && not quiet then
154 pp_response Fmt.stdout response;
155
156 (* Handle output *)
157 let body_flow = Requests.Response.body response in
158
159 begin match output with
160 | Some file -> begin
161 let filename =
162 if List.length [url_str] > 1 then begin
163 let base = Filename.remove_extension file in
164 let ext = Filename.extension file in
165 let url_hash =
166 let full_hash = Digest.string url_str |> Digest.to_hex in
167 String.sub full_hash (String.length full_hash - 8) 8 in
168 Printf.sprintf "%s-%s%s" base url_hash ext
169 end else file
170 in
171 let () =
172 Eio.Path.with_open_out ~create:(`Or_truncate 0o644)
173 Eio.Path.(env#fs / filename) @@ fun sink ->
174 Eio.Flow.copy body_flow sink in
175 let () = if not quiet then
176 Fmt.pr "[%s] Saved to %s@." url_str filename else () in
177 Ok (url_str, response)
178 end
179 | None ->
180 (* Write to stdout *)
181 let buf = Buffer.create 1024 in
182 Eio.Flow.copy body_flow (Eio.Flow.buffer_sink buf);
183 let body_str = Buffer.contents buf in
184
185 (* Pretty-print JSON if applicable *)
186 if String.length body_str > 0 &&
187 (body_str.[0] = '{' || body_str.[0] = '[') then
188 try
189 match Jsont_bytesrw.decode_string' Jsont.json body_str with
190 | Ok json ->
191 (match Jsont_bytesrw.encode_string' ~format:Jsont.Indent Jsont.json json with
192 | Ok pretty ->
193 if not quiet then Fmt.pr "[%s]:@." url_str;
194 print_string pretty
195 | Error _ ->
196 if not quiet then Fmt.pr "[%s]:@." url_str;
197 print_string body_str)
198 | Error _ ->
199 if not quiet then Fmt.pr "[%s]:@." url_str;
200 print_string body_str
201 with _ ->
202 if not quiet then Fmt.pr "[%s]:@." url_str;
203 print_string body_str
204 else begin
205 if not quiet then Fmt.pr "[%s]:@." url_str;
206 print_string body_str
207 end;
208
209 if not quiet && Requests.Response.ok response then
210 Logs.app (fun m -> m "✓ Success for %s" url_str);
211
212 Ok (url_str, response)
213 end
214 with
215 | exn ->
216 if not quiet then
217 Logs.err (fun m -> m "Request failed for %s: %s" url_str (Printexc.to_string exn));
218 Error (url_str, exn)
219
220(* Main function using Requests with concurrent fetching *)
221let run_request env sw persist_cookies verify_tls timeout follow_redirects max_redirects
222 method_ urls headers data json_data output include_headers
223 auth _show_progress () =
224
225 (* Log levels are already set by setup_log via Logs_cli *)
226
227 (* Create XDG paths *)
228 let xdg = Xdge.create env#fs "ocurl" in
229
230 (* Create requests instance with configuration *)
231 let timeout_obj = Option.map (fun t -> Requests.Timeout.create ~total:t ()) timeout in
232 let req = Requests.create ~sw ~xdg ~persist_cookies ~verify_tls
233 ~follow_redirects ~max_redirects ?timeout:timeout_obj env in
234
235 (* Set authentication if provided *)
236 let req = match auth with
237 | Some auth_str ->
238 (match parse_auth auth_str with
239 | Some (user, pass) ->
240 Requests.set_auth req
241 (Requests.Auth.basic ~username:user ~password:pass)
242 | None ->
243 Logs.warn (fun m -> m "Invalid auth format, ignoring");
244 req)
245 | None -> req
246 in
247
248 (* Build headers from command line *)
249 let cmd_headers = List.fold_left (fun hdrs header_str ->
250 match parse_header header_str with
251 | Some (k, v) -> Requests.Headers.add k v hdrs
252 | None -> hdrs
253 ) Requests.Headers.empty headers in
254
255 (* Prepare body based on data/json options *)
256 let body = match json_data, data with
257 | Some json_str, _ ->
258 (* Use of_string with JSON mime type for raw JSON string *)
259 Some (Requests.Body.of_string Requests.Mime.json json_str)
260 | None, Some d -> Some (Requests.Body.text d)
261 | None, None -> None
262 in
263
264 (* Process URLs concurrently or sequentially based on count *)
265 match urls with
266 | [] -> ()
267 | [single_url] ->
268 (* Single URL - process directly *)
269 let _ = process_url env req method_ cmd_headers body include_headers output single_url in
270 ()
271 | multiple_urls ->
272 (* Multiple URLs - process concurrently *)
273 let verbose = Logs.level () = Some Logs.Debug || Logs.level () = Some Logs.Info in
274 if verbose then
275 Fmt.pr "@[<v>Processing %d URLs concurrently...@]@." (List.length multiple_urls);
276
277 (* Create promises for each URL *)
278 let results =
279 List.map (fun url_str ->
280 let promise, resolver = Eio.Promise.create () in
281 (* Fork a fiber for each URL *)
282 Fiber.fork ~sw (fun () ->
283 let result = process_url env req method_ cmd_headers body include_headers output url_str in
284 Eio.Promise.resolve resolver result
285 );
286 promise
287 ) multiple_urls
288 in
289
290 (* Wait for all promises to complete *)
291 let completed_results = List.map Eio.Promise.await results in
292
293 (* Report summary *)
294 let quiet = match Logs.level () with Some (Logs.Error | Logs.Warning) -> true | _ -> false in
295 if not quiet then begin
296 let successes = List.filter Result.is_ok completed_results |> List.length in
297 let failures = List.filter Result.is_error completed_results |> List.length in
298 Fmt.pr "@[<v>@.Summary: %d successful, %d failed out of %d total@]@."
299 successes failures (List.length completed_results);
300
301 (* Print failed URLs *)
302 if failures > 0 then begin
303 Fmt.pr "@[<v>Failed URLs:@]@.";
304 List.iter (function
305 | Error (url, _) -> Fmt.pr " - %s@." url
306 | Ok _ -> ()
307 ) completed_results
308 end
309 end
310
311(* Main entry point *)
312let main method_ urls headers data json_data output include_headers
313 auth show_progress persist_cookies verify_tls
314 timeout follow_redirects max_redirects () =
315
316 Eio_main.run @@ fun env ->
317 Mirage_crypto_rng_unix.use_default ();
318 Switch.run @@ fun sw ->
319
320 run_request env sw persist_cookies verify_tls timeout follow_redirects max_redirects
321 method_ urls headers data json_data output include_headers auth
322 show_progress ()
323
324(* Command-line interface *)
325let cmd =
326 let doc = "OCaml HTTP client with concurrent fetching using the Requests library" in
327 let man = [
328 `S Manpage.s_description;
329 `P "$(tname) is a command-line HTTP client written in OCaml that uses the \
330 Requests library with stateful request management. It supports various HTTP methods, \
331 custom headers, authentication, cookies, and JSON data. When multiple URLs are provided, \
332 they are fetched concurrently using Eio fibers for maximum performance.";
333 `S Manpage.s_examples;
334 `P "Fetch a URL:";
335 `Pre " $(tname) https://api.github.com";
336 `P "Fetch multiple URLs concurrently:";
337 `Pre " $(tname) https://api.github.com https://httpbin.org/get https://example.com";
338 `P "POST JSON data:";
339 `Pre " $(tname) -X POST --json '{\"key\":\"value\"}' https://httpbin.org/post";
340 `P "Download file:";
341 `Pre " $(tname) -o file.zip https://example.com/file.zip";
342 `P "Download multiple files concurrently:";
343 `Pre " $(tname) -o output.json https://api1.example.com https://api2.example.com https://api3.example.com";
344 `P "Basic authentication:";
345 `Pre " $(tname) -u user:pass https://httpbin.org/basic-auth/user/pass";
346 `P "Custom headers:";
347 `Pre " $(tname) -H 'Accept: application/json' -H 'X-Api-Key: secret' https://api.example.com";
348 `P "With persistent cookies:";
349 `Pre " $(tname) --persist-cookies https://example.com";
350 `P "Disable TLS verification (insecure):";
351 `Pre " $(tname) --no-verify-tls https://self-signed.example.com";
352 `S "LOGGING OPTIONS";
353 `P "Control logging verbosity using standard options:";
354 `P "Enable verbose logging (can be repeated):";
355 `Pre " $(tname) -v https://api.github.com # info level";
356 `Pre " $(tname) -vv https://api.github.com # debug level";
357 `P "Suppress output:";
358 `Pre " $(tname) -q https://api.github.com # warnings and errors only";
359 `P "Set specific log level:";
360 `Pre " $(tname) --verbosity=info https://api.github.com";
361 `Pre " $(tname) --verbosity=debug https://api.github.com";
362 `Pre " $(tname) --verbosity=error https://api.github.com";
363 `P "Available verbosity levels: quiet, error, warning, info, debug";
364 `P "The logging system provides detailed information about:";
365 `P "- HTTP requests and responses";
366 `P "- Authentication and cookie handling";
367 `P "- Retry attempts and backoff calculations";
368 `P "- TLS configuration and connection details";
369 ] in
370
371 (* Build the term with Requests configuration options *)
372 let app_name = "ocurl" in
373 let combined_term =
374 Term.(const main $ http_method $ urls $ headers $ data $ json_data $
375 output_file $ include_headers $ auth $
376 show_progress $
377 Requests.Cmd.persist_cookies_term app_name $
378 Requests.Cmd.verify_tls_term app_name $
379 Requests.Cmd.timeout_term app_name $
380 Requests.Cmd.follow_redirects_term app_name $
381 Requests.Cmd.max_redirects_term app_name $
382 setup_log)
383 in
384
385 let info = Cmd.info "ocurl" ~version:"2.0.0" ~doc ~man in
386 Cmd.v info combined_term
387
388let () = exit (Cmd.eval cmd)