this repo has no description
more
+317
-9
+4
requests/bin/dune
+4
requests/bin/dune
+297
requests/bin/ocurl.ml
+297
requests/bin/ocurl.ml
···
1
+
open Eio
2
+
open Cmdliner
3
+
4
+
let _setup_log style_renderer level =
5
+
Fmt_tty.setup_std_outputs ?style_renderer ();
6
+
Logs.set_level level;
7
+
Logs.set_reporter (Logs_fmt.reporter ())
8
+
9
+
(* Command-line options *)
10
+
let http_method =
11
+
let methods = [
12
+
("GET", `GET);
13
+
("POST", `POST);
14
+
("PUT", `PUT);
15
+
("DELETE", `DELETE);
16
+
("HEAD", `HEAD);
17
+
("OPTIONS", `OPTIONS);
18
+
("PATCH", `PATCH);
19
+
] in
20
+
let doc = "HTTP method to use" in
21
+
let env = Cmd.Env.info "OCURL_METHOD" in
22
+
Arg.(value & opt (enum methods) `GET & info ["X"; "request"] ~env ~docv:"METHOD" ~doc)
23
+
24
+
let urls =
25
+
let doc = "URL(s) to fetch" in
26
+
Arg.(non_empty & pos_all string [] & info [] ~docv:"URL" ~doc)
27
+
28
+
let headers =
29
+
let doc = "Add custom HTTP header (can be used multiple times)" in
30
+
Arg.(value & opt_all string [] & info ["H"; "header"] ~docv:"HEADER" ~doc)
31
+
32
+
let data =
33
+
let doc = "HTTP POST/PUT data" in
34
+
Arg.(value & opt (some string) None & info ["d"; "data"] ~docv:"DATA" ~doc)
35
+
36
+
let json_data =
37
+
let doc = "HTTP POST/PUT JSON data" in
38
+
Arg.(value & opt (some string) None & info ["json"] ~docv:"JSON" ~doc)
39
+
40
+
let output_file =
41
+
let doc = "Write output to file instead of stdout" in
42
+
Arg.(value & opt (some string) None & info ["o"; "output"] ~docv:"FILE" ~doc)
43
+
44
+
let include_headers =
45
+
let doc = "Include response headers in output" in
46
+
Arg.(value & flag & info ["i"; "include"] ~doc)
47
+
48
+
let follow_redirects =
49
+
let doc = "Follow redirects (default: true)" in
50
+
Arg.(value & opt bool true & info ["L"; "location"] ~doc)
51
+
52
+
let max_redirects =
53
+
let doc = "Maximum number of redirects to follow" in
54
+
Arg.(value & opt int 10 & info ["max-redirs"] ~docv:"NUM" ~doc)
55
+
56
+
let timeout =
57
+
let doc = "Maximum time allowed for transfer (seconds)" in
58
+
Arg.(value & opt (some float) None & info ["m"; "max-time"] ~docv:"SECONDS" ~doc)
59
+
60
+
let auth =
61
+
let doc = "Basic authentication in USER:PASSWORD format" in
62
+
Arg.(value & opt (some string) None & info ["u"; "user"] ~docv:"USER:PASS" ~doc)
63
+
64
+
let verify_tls =
65
+
let doc = "Verify TLS certificates (default: true)" in
66
+
Arg.(value & opt bool true & info ["k"; "insecure"] ~doc:("Don't " ^ doc))
67
+
68
+
let verbose =
69
+
let doc = "Verbose output" in
70
+
Arg.(value & flag & info ["v"; "verbose"] ~doc)
71
+
72
+
let quiet =
73
+
let doc = "Quiet mode (no progress or errors)" in
74
+
Arg.(value & flag & info ["q"; "quiet"] ~doc)
75
+
76
+
let show_progress =
77
+
let doc = "Show progress bar for downloads" in
78
+
Arg.(value & flag & info ["progress-bar"] ~doc)
79
+
80
+
let user_agent =
81
+
let doc = "User-Agent to send to server" in
82
+
let default = "ocurl/1.0 (OCaml Requests)" in
83
+
Arg.(value & opt string default & info ["A"; "user-agent"] ~docv:"STRING" ~doc)
84
+
85
+
(* Logging setup *)
86
+
let setup_log =
87
+
let setup style_renderer level =
88
+
Fmt_tty.setup_std_outputs ?style_renderer ();
89
+
Logs.set_level level;
90
+
Logs.set_reporter (Logs_fmt.reporter ())
91
+
in
92
+
let style_renderer =
93
+
let doc = "Colorize output" in
94
+
Arg.(value & opt (some (enum [("auto", `Ansi_tty); ("always", `Ansi_tty); ("never", `None)])) None & info ["color"] ~doc)
95
+
in
96
+
let log_level =
97
+
let doc = "Set log level" in
98
+
Arg.(value & opt (some (enum [("error", Logs.Error); ("warning", Logs.Warning); ("info", Logs.Info); ("debug", Logs.Debug)])) None & info ["log-level"] ~doc)
99
+
in
100
+
Term.(const setup $ style_renderer $ log_level)
101
+
102
+
(* Parse authentication *)
103
+
let parse_auth auth_str =
104
+
match String.split_on_char ':' auth_str with
105
+
| [user; pass] -> Some (user, pass)
106
+
| _ -> None
107
+
108
+
(* Parse headers *)
109
+
let parse_header header_str =
110
+
match String.split_on_char ':' header_str with
111
+
| [] -> None
112
+
| [name] -> Some (String.trim name, "")
113
+
| name :: rest ->
114
+
Some (String.trim name, String.trim (String.concat ":" rest))
115
+
116
+
(* Pretty print response *)
117
+
let pp_response ppf response =
118
+
let open Requests.Response in
119
+
let status = status response in
120
+
let headers = headers response in
121
+
122
+
(* Color code status *)
123
+
let status_style =
124
+
if is_success response then Fmt.(styled `Green)
125
+
else if is_client_error response then Fmt.(styled `Yellow)
126
+
else if is_server_error response then Fmt.(styled `Red)
127
+
else Fmt.(styled `Blue)
128
+
in
129
+
130
+
let status_str = Cohttp.Code.string_of_status status in
131
+
Fmt.pf ppf "@[<v>%a@]@."
132
+
(status_style Fmt.string) status_str;
133
+
134
+
(* Print headers *)
135
+
Cohttp.Header.iter (fun k v ->
136
+
Fmt.pf ppf "@[<h>%a: %s@]@."
137
+
Fmt.(styled `Cyan string) k v
138
+
) headers;
139
+
140
+
Fmt.pf ppf "@."
141
+
142
+
(* Main function *)
143
+
let run_request method_ urls headers data json_data output include_headers
144
+
follow_redirects max_redirects timeout auth verify_tls
145
+
verbose quiet _show_progress user_agent () =
146
+
147
+
(* Setup logging *)
148
+
let log_level =
149
+
if quiet then Logs.Error
150
+
else if verbose then Logs.Debug
151
+
else Logs.Info
152
+
in
153
+
Logs.set_level (Some log_level);
154
+
155
+
Eio_main.run @@ fun env ->
156
+
Switch.run @@ fun sw ->
157
+
158
+
(* Create client *)
159
+
let tls_config =
160
+
if verify_tls then Requests.Tls.default ()
161
+
else Requests.Tls.insecure ()
162
+
in
163
+
164
+
let client = Requests.create ~clock:env#clock ~tls_config env#net in
165
+
166
+
(* Process each URL *)
167
+
List.iter (fun url_str ->
168
+
let uri = Uri.of_string url_str in
169
+
170
+
if not quiet then
171
+
let method_str = match method_ with
172
+
| `GET -> "GET"
173
+
| `POST -> "POST"
174
+
| `PUT -> "PUT"
175
+
| `DELETE -> "DELETE"
176
+
| `HEAD -> "HEAD"
177
+
| `OPTIONS -> "OPTIONS"
178
+
| `PATCH -> "PATCH"
179
+
in
180
+
Fmt.pr "@[<v>%a %a@]@."
181
+
Fmt.(styled `Bold string) method_str
182
+
Fmt.(styled `Underline Uri.pp) uri;
183
+
184
+
(* Build auth if provided *)
185
+
let auth_obj = match auth with
186
+
| Some auth_str ->
187
+
(match parse_auth auth_str with
188
+
| Some (user, pass) ->
189
+
Some (Requests.Auth.basic ~username:user ~password:pass)
190
+
| None ->
191
+
Logs.warn (fun m -> m "Invalid auth format, ignoring");
192
+
None)
193
+
| None -> None
194
+
in
195
+
196
+
(* Build config *)
197
+
let config = Requests.Config.create
198
+
~follow_redirects
199
+
~max_redirects
200
+
?timeout
201
+
~verify_tls
202
+
?auth:auth_obj
203
+
()
204
+
in
205
+
206
+
(* Add headers *)
207
+
let config = List.fold_left (fun cfg header_str ->
208
+
match parse_header header_str with
209
+
| Some (k, v) -> Requests.Config.add_header k v cfg
210
+
| None -> cfg
211
+
) config headers in
212
+
213
+
(* Add user agent *)
214
+
let config = Requests.Config.add_header "User-Agent" user_agent config
215
+
in
216
+
217
+
(* Prepare body and update config for JSON *)
218
+
let body, config = match json_data, data with
219
+
| Some json, _ ->
220
+
(* Add JSON content type *)
221
+
let config = Requests.Config.add_header "Content-Type" "application/json" config in
222
+
Some json, config
223
+
| None, Some d -> Some d, config
224
+
| None, None -> None, config
225
+
in
226
+
227
+
try
228
+
(* Make request *)
229
+
let response = Requests.request ~sw client ~config ?body ~meth:method_ uri in
230
+
231
+
(* Print response *)
232
+
if include_headers && not quiet then
233
+
pp_response Fmt.stdout response;
234
+
235
+
(* Handle output *)
236
+
let body_str = Requests.Response.body response in
237
+
238
+
(match output with
239
+
| Some file ->
240
+
Out_channel.with_open_text file (fun oc ->
241
+
output_string oc body_str
242
+
);
243
+
if not quiet then
244
+
Fmt.pr "Saved to %s (%d bytes)@." file (String.length body_str)
245
+
| None ->
246
+
(* Try to pretty-print JSON if it looks like JSON *)
247
+
if String.length body_str > 0 &&
248
+
(body_str.[0] = '{' || body_str.[0] = '[') then
249
+
try
250
+
let json = Yojson.Safe.from_string body_str in
251
+
Fmt.pr "%a@." (Yojson.Safe.pretty_print ~std:true) json
252
+
with _ ->
253
+
print_string body_str
254
+
else
255
+
print_string body_str);
256
+
257
+
if not quiet && Requests.Response.is_success response then
258
+
Logs.app (fun m -> m "✓ Success")
259
+
260
+
with
261
+
| Requests.Request_error err ->
262
+
if not quiet then
263
+
Logs.err (fun m -> m "Request failed: %a" Requests.pp_error err);
264
+
exit 1
265
+
| exn ->
266
+
if not quiet then
267
+
Logs.err (fun m -> m "Unexpected error: %s" (Printexc.to_string exn));
268
+
exit 1
269
+
) urls
270
+
271
+
(* Command-line interface *)
272
+
let cmd =
273
+
let doc = "OCaml HTTP client using the Requests library" in
274
+
let man = [
275
+
`S Manpage.s_description;
276
+
`P "$(tname) is a command-line HTTP client written in OCaml that uses the \
277
+
Requests library. It supports various HTTP methods, custom headers, \
278
+
authentication, and JSON data.";
279
+
`S Manpage.s_examples;
280
+
`P "Fetch a URL:";
281
+
`Pre " $(tname) https://api.github.com";
282
+
`P "POST JSON data:";
283
+
`Pre " $(tname) -X POST --json '{\"key\":\"value\"}' https://httpbin.org/post";
284
+
`P "Download file with progress:";
285
+
`Pre " $(tname) --progress-bar -o file.zip https://example.com/file.zip";
286
+
`P "Basic authentication:";
287
+
`Pre " $(tname) -u user:pass https://httpbin.org/basic-auth/user/pass";
288
+
`P "Custom headers:";
289
+
`Pre " $(tname) -H 'Accept: application/json' -H 'X-Api-Key: secret' https://api.example.com";
290
+
] in
291
+
let info = Cmd.info "ocurl" ~version:"1.0.0" ~doc ~man in
292
+
Cmd.v info Term.(const run_request $ http_method $ urls $ headers $ data $
293
+
json_data $ output_file $ include_headers $ follow_redirects $
294
+
max_redirects $ timeout $ auth $ verify_tls $ verbose $
295
+
quiet $ show_progress $ user_agent $ setup_log)
296
+
297
+
let () = exit (Cmd.eval cmd)
+1
-1
requests/lib/dune
+1
-1
requests/lib/dune
···
1
1
(library
2
2
(public_name requests)
3
3
(name requests)
4
-
(libraries eio cohttp-eio tls-eio ca-certs x509 uri yojson logs base64 unix digestif mirage-crypto-rng))
4
+
(libraries eio cohttp-eio tls-eio ca-certs x509 uri yojson logs base64 unix digestif mirage-crypto-rng mirage-crypto-rng.unix))
+15
-8
requests/lib/requests.ml
+15
-8
requests/lib/requests.ml
···
1
1
open Eio
2
2
3
+
(* Initialize the RNG on module load for OAuth and other crypto operations *)
4
+
let () = Mirage_crypto_rng_unix.use_default ()
5
+
3
6
(* Error types *)
4
7
type error =
5
8
| Http_error of { status : Cohttp.Code.status_code; body : string; headers : Cohttp.Header.t }
···
102
105
let timestamp = Printf.sprintf "%.0f" (Unix.gettimeofday ()) in
103
106
(* Generate cryptographically secure nonce using mirage-crypto-rng *)
104
107
let nonce_bytes = Mirage_crypto_rng.generate 16 in
105
-
let nonce = Base64.encode_string (Cstruct.to_string nonce_bytes) in
108
+
let nonce = Base64.encode_string nonce_bytes in
106
109
107
110
let signature_method_str = match signature_method with
108
111
| `HMAC_SHA1 -> "HMAC-SHA1"
···
394
397
| Custom _ -> Format.fprintf ppf "Custom TLS config"
395
398
| Insecure -> Format.fprintf ppf "Insecure (no verification)"
396
399
397
-
let to_tls_config = function
400
+
let to_tls_config : config -> (Tls.Config.client, [> `Msg of string ]) result = function
398
401
| Default ->
399
-
let authenticator = Result.get_ok (Ca_certs.authenticator ()) in
400
-
Tls.Config.client ~authenticator ()
402
+
(match Ca_certs.authenticator () with
403
+
| Ok authenticator -> Tls.Config.client ~authenticator ()
404
+
| Error _ as e -> e)
401
405
| WithCaCerts auth ->
402
406
Tls.Config.client ~authenticator:auth ()
403
407
| Custom config ->
404
-
config
408
+
Ok config
405
409
| Insecure ->
406
410
let authenticator ?ip:_ ~host:_ _ = Ok None in
407
411
Tls.Config.client ~authenticator ()
···
421
425
422
426
423
427
let make_client net tls_config =
424
-
let tls_config = Tls.to_tls_config tls_config in
425
-
let https_fn _uri socket = Tls_eio.client_of_flow tls_config socket in
426
-
Cohttp_eio.Client.make ~https:(Some https_fn) net
428
+
match Tls.to_tls_config tls_config with
429
+
| Ok tls_config ->
430
+
let https_fn _uri socket = Tls_eio.client_of_flow tls_config socket in
431
+
Cohttp_eio.Client.make ~https:(Some https_fn) net
432
+
| Error (`Msg msg) ->
433
+
failwith ("TLS configuration error: " ^ msg)
427
434
428
435
let merge_headers base_headers request_headers =
429
436
Cohttp.Header.fold (fun key value acc ->