this repo has no description
more
+195
-288
+118
-122
stack/requests/bin/ocurl.ml
+118
-122
stack/requests/bin/ocurl.ml
···
1
1
open Eio
2
2
open Cmdliner
3
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
4
(* Command-line options *)
10
5
let http_method =
11
6
let methods = [
···
45
40
let doc = "Include response headers in output" in
46
41
Arg.(value & flag & info ["i"; "include"] ~doc)
47
42
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
43
let auth =
61
44
let doc = "Basic authentication in USER:PASSWORD format" in
62
45
Arg.(value & opt (some string) None & info ["u"; "user"] ~docv:"USER:PASS" ~doc)
63
-
64
-
let insecure =
65
-
let doc = "Don't verify TLS certificates" in
66
-
Arg.(value & flag & info ["k"; "insecure"] ~doc)
67
46
68
47
let verbose =
69
48
let doc = "Verbose output" in
···
76
55
let show_progress =
77
56
let doc = "Show progress bar for downloads" in
78
57
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
58
85
59
(* Logging setup *)
86
60
let setup_log =
···
115
89
116
90
(* Pretty print response *)
117
91
let pp_response ppf response =
118
-
let open Requests.Response in
119
-
let status = status response in
120
-
let headers = headers response in
92
+
let status = Requests.Response.status response in
93
+
let status_code = Requests.Response.status_code response in
94
+
let headers = Requests.Response.headers response in
121
95
122
96
(* Color code status *)
123
97
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)
98
+
if Requests.Status.is_success status then Fmt.(styled `Green)
99
+
else if Requests.Status.is_client_error status then Fmt.(styled `Yellow)
100
+
else if Requests.Status.is_server_error status then Fmt.(styled `Red)
127
101
else Fmt.(styled `Blue)
128
102
in
129
103
130
-
let status_code = Cohttp.Code.status_of_code status in
131
-
let status_str = Cohttp.Code.string_of_status status_code in
132
-
Fmt.pf ppf "@[<v>%a@]@."
133
-
(status_style Fmt.string) status_str;
104
+
(* Print status line *)
105
+
Fmt.pf ppf "@[<v>HTTP/1.1 %d %a@]@."
106
+
status_code
107
+
(status_style Fmt.string) (Requests.Status.reason_phrase status);
134
108
135
109
(* Print headers *)
136
110
let header_list = Requests.Headers.to_list headers in
···
141
115
142
116
Fmt.pf ppf "@."
143
117
144
-
(* Main function *)
145
-
let run_request method_ urls headers data json_data output include_headers
146
-
follow_redirects max_redirects timeout auth insecure
147
-
verbose quiet _show_progress user_agent () =
118
+
(* Main function using Session *)
119
+
let run_request env sw persist_cookies verify_tls timeout follow_redirects max_redirects
120
+
method_ urls headers data json_data output include_headers
121
+
auth verbose quiet _show_progress () =
148
122
149
123
(* Setup logging *)
150
124
let log_level =
···
154
128
in
155
129
Logs.set_level (Some log_level);
156
130
157
-
Eio_main.run @@ fun env ->
158
-
Mirage_crypto_rng_unix.use_default ();
159
-
Switch.run @@ fun sw ->
131
+
(* Create XDG paths *)
132
+
let xdg = Xdge.create env#fs "ocurl" in
160
133
161
-
(* Create client *)
162
-
let client = Requests.Client.create ~clock:env#clock ~net:env#net
163
-
~verify_tls:(not insecure) () in
134
+
(* Create session with configuration *)
135
+
let timeout_obj = Option.map (fun t -> Requests.Timeout.create ~total:t ()) timeout in
136
+
let session = Requests.Session.create ~sw ~xdg ~persist_cookies ~verify_tls
137
+
~follow_redirects ~max_redirects ?timeout:timeout_obj env in
138
+
139
+
(* Set authentication if provided *)
140
+
(match auth with
141
+
| Some auth_str ->
142
+
(match parse_auth auth_str with
143
+
| Some (user, pass) ->
144
+
Requests.Session.set_auth session
145
+
(Requests.Auth.basic ~username:user ~password:pass)
146
+
| None ->
147
+
Logs.warn (fun m -> m "Invalid auth format, ignoring"))
148
+
| None -> ());
164
149
165
150
(* Process each URL *)
166
151
List.iter (fun url_str ->
167
152
let uri = Uri.of_string url_str in
168
153
169
154
if not quiet then
170
-
let method_str = match method_ with
171
-
| `GET -> "GET"
172
-
| `POST -> "POST"
173
-
| `PUT -> "PUT"
174
-
| `DELETE -> "DELETE"
175
-
| `HEAD -> "HEAD"
176
-
| `OPTIONS -> "OPTIONS"
177
-
| `PATCH -> "PATCH"
178
-
in
155
+
let method_str = Requests.Method.to_string (method_ :> Requests.Method.t) in
179
156
Fmt.pr "@[<v>%a %a@]@."
180
157
Fmt.(styled `Bold string) method_str
181
158
Fmt.(styled `Underline Uri.pp) uri;
182
159
183
-
(* Build auth if provided *)
184
-
let auth_obj = match auth with
185
-
| Some auth_str ->
186
-
(match parse_auth auth_str with
187
-
| Some (user, pass) ->
188
-
Some (Requests.Auth.basic ~username:user ~password:pass)
189
-
| None ->
190
-
Logs.warn (fun m -> m "Invalid auth format, ignoring");
191
-
None)
192
-
| None -> None
193
-
in
194
-
195
-
(* Build headers *)
196
-
let headers = List.fold_left (fun hdrs header_str ->
160
+
(* Build headers from command line *)
161
+
let cmd_headers = List.fold_left (fun hdrs header_str ->
197
162
match parse_header header_str with
198
163
| Some (k, v) -> Requests.Headers.add k v hdrs
199
164
| None -> hdrs
200
165
) Requests.Headers.empty headers in
201
166
202
-
(* Add user agent *)
203
-
let headers = Requests.Headers.add "User-Agent" user_agent headers in
204
-
205
-
(* Prepare body and update headers for JSON *)
206
-
let body, headers = match json_data, data with
207
-
| Some json, _ ->
208
-
(* Add JSON content type *)
209
-
let headers = Requests.Headers.add "Content-Type" "application/json" headers in
210
-
Some (Requests.Body.json json), headers
211
-
| None, Some d -> Some (Requests.Body.text d), headers
212
-
| None, None -> None, headers
167
+
(* Prepare body based on data/json options *)
168
+
let body = match json_data, data with
169
+
| Some json, _ -> Some (Requests.Body.json json)
170
+
| None, Some d -> Some (Requests.Body.text d)
171
+
| None, None -> None
213
172
in
214
173
215
-
(* Convert to full Method.t type *)
216
-
let req_method : Requests.Method.t = (method_ :> Requests.Method.t) in
217
-
218
-
(* Convert timeout float to Timeout.t *)
219
-
let timeout_obj = Option.map (fun t -> Requests.Timeout.create ~total:t ()) timeout in
220
-
221
174
try
222
-
(* Make request *)
223
-
let response = Requests.Stream.request ~sw ~client ~headers ?body ?auth:auth_obj
224
-
?timeout:timeout_obj ~follow_redirects ~max_redirects ~method_:req_method url_str in
175
+
(* Make request using session *)
176
+
let response =
177
+
match method_ with
178
+
| `GET -> Requests.Session.get session ~headers:cmd_headers url_str
179
+
| `POST -> Requests.Session.post session ~headers:cmd_headers ?body url_str
180
+
| `PUT -> Requests.Session.put session ~headers:cmd_headers ?body url_str
181
+
| `DELETE -> Requests.Session.delete session ~headers:cmd_headers url_str
182
+
| `HEAD -> Requests.Session.head session ~headers:cmd_headers url_str
183
+
| `OPTIONS -> Requests.Session.options session ~headers:cmd_headers url_str
184
+
| `PATCH -> Requests.Session.patch session ~headers:cmd_headers ?body url_str
185
+
in
225
186
226
-
(* Print response *)
187
+
(* Print response headers if requested *)
227
188
if include_headers && not quiet then
228
189
pp_response Fmt.stdout response;
229
190
230
191
(* Handle output *)
231
192
let body_flow = Requests.Response.body response in
232
-
let buf = Buffer.create 1024 in
233
-
Eio.Flow.copy body_flow (Eio.Flow.buffer_sink buf);
234
-
let body_str = Buffer.contents buf in
235
193
236
-
(match output with
237
-
| Some file ->
238
-
Out_channel.with_open_text file (fun oc ->
239
-
output_string oc body_str
240
-
);
241
-
if not quiet then
242
-
Fmt.pr "Saved to %s (%d bytes)@." file (String.length body_str)
243
-
| None ->
244
-
(* Try to pretty-print JSON if it looks like JSON *)
245
-
if String.length body_str > 0 &&
246
-
(body_str.[0] = '{' || body_str.[0] = '[') then
247
-
try
248
-
let json = Yojson.Safe.from_string body_str in
249
-
Fmt.pr "%a@." (Yojson.Safe.pretty_print ~std:true) json
250
-
with _ ->
251
-
print_string body_str
252
-
else
253
-
print_string body_str);
194
+
match output with
195
+
| Some file ->
196
+
(* Write to file *)
197
+
Eio.Path.with_open_out ~create:(`Or_truncate 0o644)
198
+
Eio.Path.(env#fs / file) @@ fun sink ->
199
+
Eio.Flow.copy body_flow sink;
200
+
if not quiet then
201
+
Fmt.pr "Saved to %s@." file
202
+
| None ->
203
+
(* Write to stdout *)
204
+
let buf = Buffer.create 1024 in
205
+
Eio.Flow.copy body_flow (Eio.Flow.buffer_sink buf);
206
+
let body_str = Buffer.contents buf in
254
207
255
-
if not quiet && Requests.Response.is_success response then
208
+
(* Try to pretty-print JSON if it looks like JSON *)
209
+
if String.length body_str > 0 &&
210
+
(body_str.[0] = '{' || body_str.[0] = '[') then
211
+
try
212
+
let json = Yojson.Safe.from_string body_str in
213
+
Fmt.pr "%a@." (Yojson.Safe.pretty_print ~std:true) json
214
+
with _ ->
215
+
print_string body_str
216
+
else
217
+
print_string body_str;
218
+
219
+
(* Close response to free resources *)
220
+
Requests.Response.close response;
221
+
222
+
if not quiet && Requests.Response.ok response then
256
223
Logs.app (fun m -> m "✓ Success")
257
224
258
225
with
259
226
| exn ->
260
227
if not quiet then
261
-
Logs.err (fun m -> m "%a" Requests.Error.pp_exn exn);
228
+
Logs.err (fun m -> m "Request failed: %s" (Printexc.to_string exn));
262
229
exit 1
263
230
) urls
264
231
232
+
(* Main entry point *)
233
+
let main method_ urls headers data json_data output include_headers
234
+
auth verbose quiet show_progress persist_cookies verify_tls
235
+
timeout follow_redirects max_redirects () =
236
+
237
+
Eio_main.run @@ fun env ->
238
+
Mirage_crypto_rng_unix.use_default ();
239
+
Switch.run @@ fun sw ->
240
+
241
+
run_request env sw persist_cookies verify_tls timeout follow_redirects max_redirects
242
+
method_ urls headers data json_data output include_headers auth verbose quiet
243
+
show_progress ()
244
+
265
245
(* Command-line interface *)
266
246
let cmd =
267
247
let doc = "OCaml HTTP client using the Requests library" in
268
248
let man = [
269
249
`S Manpage.s_description;
270
250
`P "$(tname) is a command-line HTTP client written in OCaml that uses the \
271
-
Requests library. It supports various HTTP methods, custom headers, \
272
-
authentication, and JSON data.";
251
+
Requests library with session management. It supports various HTTP methods, \
252
+
custom headers, authentication, cookies, and JSON data.";
273
253
`S Manpage.s_examples;
274
254
`P "Fetch a URL:";
275
255
`Pre " $(tname) https://api.github.com";
276
256
`P "POST JSON data:";
277
257
`Pre " $(tname) -X POST --json '{\"key\":\"value\"}' https://httpbin.org/post";
278
-
`P "Download file with progress:";
279
-
`Pre " $(tname) --progress-bar -o file.zip https://example.com/file.zip";
258
+
`P "Download file:";
259
+
`Pre " $(tname) -o file.zip https://example.com/file.zip";
280
260
`P "Basic authentication:";
281
261
`Pre " $(tname) -u user:pass https://httpbin.org/basic-auth/user/pass";
282
262
`P "Custom headers:";
283
263
`Pre " $(tname) -H 'Accept: application/json' -H 'X-Api-Key: secret' https://api.example.com";
264
+
`P "With persistent cookies:";
265
+
`Pre " $(tname) --persist-cookies --cache-dir ~/.ocurl https://example.com";
266
+
`P "Disable TLS verification (insecure):";
267
+
`Pre " $(tname) --no-verify-tls https://self-signed.example.com";
284
268
] in
285
-
let info = Cmd.info "ocurl" ~version:"1.0.0" ~doc ~man in
286
-
Cmd.v info Term.(const run_request $ http_method $ urls $ headers $ data $
287
-
json_data $ output_file $ include_headers $ follow_redirects $
288
-
max_redirects $ timeout $ auth $ insecure $ verbose $
289
-
quiet $ show_progress $ user_agent $ setup_log)
269
+
270
+
(* Build the term with Session configuration options *)
271
+
let app_name = "ocurl" in
272
+
let combined_term =
273
+
Term.(const main $ http_method $ urls $ headers $ data $ json_data $
274
+
output_file $ include_headers $ auth $ verbose $ quiet $
275
+
show_progress $
276
+
Requests.Session.Cmd.persist_cookies_term app_name $
277
+
Requests.Session.Cmd.verify_tls_term app_name $
278
+
Requests.Session.Cmd.timeout_term app_name $
279
+
Requests.Session.Cmd.follow_redirects_term app_name $
280
+
Requests.Session.Cmd.max_redirects_term app_name $
281
+
setup_log)
282
+
in
283
+
284
+
let info = Cmd.info "ocurl" ~version:"2.0.0" ~doc ~man in
285
+
Cmd.v info combined_term
290
286
291
287
let () = exit (Cmd.eval cmd)
-4
stack/requests/lib/client.ml
-4
stack/requests/lib/client.ml
···
3
3
net : 'b;
4
4
default_headers : Headers.t;
5
5
timeout : Timeout.t;
6
-
pool_config : Pool.config;
7
6
max_retries : int;
8
7
retry_backoff : float;
9
8
verify_tls : bool;
···
13
12
let create
14
13
?(default_headers = Headers.empty)
15
14
?(timeout = Timeout.default)
16
-
?(pool_config = Pool.default_config)
17
15
?(max_retries = 3)
18
16
?(retry_backoff = 2.0)
19
17
?(verify_tls = true)
···
44
42
net;
45
43
default_headers;
46
44
timeout;
47
-
pool_config;
48
45
max_retries;
49
46
retry_backoff;
50
47
verify_tls;
···
59
56
let net t = t.net
60
57
let default_headers t = t.default_headers
61
58
let timeout t = t.timeout
62
-
let pool_config t = t.pool_config
63
59
let max_retries t = t.max_retries
64
60
let retry_backoff t = t.retry_backoff
65
61
let verify_tls t = t.verify_tls
-2
stack/requests/lib/client.mli
-2
stack/requests/lib/client.mli
···
6
6
val create :
7
7
?default_headers:Headers.t ->
8
8
?timeout:Timeout.t ->
9
-
?pool_config:Pool.config ->
10
9
?max_retries:int ->
11
10
?retry_backoff:float ->
12
11
?verify_tls:bool ->
···
24
23
val net : ('a,'b) t -> 'b
25
24
val default_headers : ('a,'b) t -> Headers.t
26
25
val timeout : ('a,'b) t -> Timeout.t
27
-
val pool_config : ('a,'b) t -> Pool.config
28
26
val max_retries : ('a,'b) t -> int
29
27
val retry_backoff : ('a,'b) t -> float
30
28
val verify_tls : ('a,'b) t -> bool
-11
stack/requests/lib/pool.ml
-11
stack/requests/lib/pool.ml
-10
stack/requests/lib/pool.mli
-10
stack/requests/lib/pool.mli
···
1
-
(** Connection pool configuration *)
2
-
3
-
type config = {
4
-
max_connections_per_host : int; (** Maximum connections per host *)
5
-
max_idle_time : float; (** Maximum idle time in seconds *)
6
-
max_lifetime : float option; (** Maximum connection lifetime *)
7
-
}
8
-
9
-
val default_config : config
10
-
(** Default configuration: 10 connections per host, 300s idle time *)
-1
stack/requests/lib/requests.ml
-1
stack/requests/lib/requests.ml
-1
stack/requests/lib/requests.mli
-1
stack/requests/lib/requests.mli
+7
-19
stack/requests/lib/response.ml
+7
-19
stack/requests/lib/response.ml
···
14
14
Log.debug (fun m -> m "Creating response: status=%d url=%s elapsed=%.3fs" status url elapsed);
15
15
{ status; headers; body; url; elapsed; closed = false }
16
16
17
-
let status t = t.status
18
-
19
-
let ok t = t.status >= 200 && t.status < 300
20
-
21
-
let is_success t = ok t
22
-
23
-
let is_redirect t = t.status >= 300 && t.status < 400
17
+
let status t = Status.of_int t.status
24
18
25
-
let is_client_error t = t.status >= 400 && t.status < 500
19
+
let status_code t = t.status
26
20
27
-
let is_server_error t = t.status >= 500 && t.status < 600
21
+
let ok t = Status.is_success (Status.of_int t.status)
28
22
29
23
let headers t = t.headers
30
24
···
70
64
(* Pretty printers *)
71
65
let pp ppf t =
72
66
Format.fprintf ppf "@[<v>Response:@,\
73
-
status: %d@,\
67
+
status: %a@,\
74
68
url: %s@,\
75
69
elapsed: %.3fs@,\
76
70
headers: @[%a@]@]"
77
-
t.status t.url t.elapsed
71
+
Status.pp (Status.of_int t.status) t.url t.elapsed
78
72
Headers.pp_brief t.headers
79
73
80
74
let pp_detailed ppf t =
81
-
let status_desc =
82
-
if is_success t then "success"
83
-
else if is_redirect t then "redirect"
84
-
else if is_client_error t then "client error"
85
-
else if is_server_error t then "server error"
86
-
else "unknown" in
87
75
Format.fprintf ppf "@[<v>Response:@,\
88
-
status: %d (%s)@,\
76
+
status: %a@,\
89
77
url: %s@,\
90
78
elapsed: %.3fs@,\
91
79
@[%a@]@]"
92
-
t.status status_desc t.url t.elapsed
80
+
Status.pp_hum (Status.of_int t.status) t.url t.elapsed
93
81
Headers.pp t.headers
+6
-15
stack/requests/lib/response.mli
+6
-15
stack/requests/lib/response.mli
···
7
7
8
8
(** Status *)
9
9
10
-
val status : t -> int
11
-
(** Get HTTP status code *)
10
+
val status : t -> Status.t
11
+
(** Get HTTP status as Status.t *)
12
+
13
+
val status_code : t -> int
14
+
(** Get HTTP status code as integer *)
12
15
13
16
val ok : t -> bool
14
-
(** Returns true if status is 200-299 *)
15
-
16
-
val is_success : t -> bool
17
-
(** Returns true if status is 200-299 *)
18
-
19
-
val is_redirect : t -> bool
20
-
(** Returns true if status is 300-399 *)
21
-
22
-
val is_client_error : t -> bool
23
-
(** Returns true if status is 400-499 *)
24
-
25
-
val is_server_error : t -> bool
26
-
(** Returns true if status is 500-599 *)
17
+
(** Returns true if status is 200-299 (alias for Status.is_success) *)
27
18
28
19
(** Headers *)
29
20
+47
-50
stack/requests/lib/session.ml
+47
-50
stack/requests/lib/session.ml
···
286
286
Eio.Path.with_open_out ~create:(`Or_truncate 0o644) path @@ fun sink ->
287
287
download t ?headers ?auth ?timeout url ~sink
288
288
289
-
(** {1 Batch Operations} *)
290
-
291
-
let concurrent_requests (type a b) (t : (a, b) t) ?(max_concurrent = 10) tasks =
292
-
let sem = Eio.Semaphore.make max_concurrent in
293
-
294
-
tasks |> Eio.Fiber.List.map ~max_fibers:max_concurrent (fun task ->
295
-
Eio.Semaphore.acquire sem;
296
-
try
297
-
let result = task t in
298
-
Eio.Semaphore.release sem;
299
-
result
300
-
with exn ->
301
-
Eio.Semaphore.release sem;
302
-
raise exn
303
-
)
304
-
305
-
let map_concurrent (type a b) (t : (a, b) t) ?max_concurrent ~f items =
306
-
let tasks = List.map (fun item session -> f session item) items in
307
-
concurrent_requests t ?max_concurrent tasks
308
289
309
290
let pp ppf t =
310
291
Mutex.lock t.mutex;
···
392
373
393
374
session
394
375
395
-
(* Individual terms *)
376
+
(* Individual terms - parameterized by app_name *)
396
377
397
-
let persist_cookies_term =
378
+
let persist_cookies_term app_name =
398
379
let doc = "Persist cookies to disk between sessions" in
399
-
let env = Cmd.Env.info "REQUESTS_PERSIST_COOKIES" in
380
+
let env_name = String.uppercase_ascii app_name ^ "_PERSIST_COOKIES" in
381
+
let env = Cmd.Env.info env_name in
400
382
Arg.(value & flag & info ["persist-cookies"] ~env ~doc)
401
383
402
-
let verify_tls_term =
384
+
let verify_tls_term app_name =
403
385
let doc = "Skip TLS certificate verification (insecure)" in
404
-
let env = Cmd.Env.info "REQUESTS_NO_VERIFY_TLS" in
386
+
let env_name = String.uppercase_ascii app_name ^ "_NO_VERIFY_TLS" in
387
+
let env = Cmd.Env.info env_name in
405
388
Term.(const (fun no_verify -> not no_verify) $
406
389
Arg.(value & flag & info ["no-verify-tls"] ~env ~doc))
407
390
408
-
let timeout_term =
391
+
let timeout_term app_name =
409
392
let doc = "Request timeout in seconds" in
410
-
let env = Cmd.Env.info "REQUESTS_TIMEOUT" in
393
+
let env_name = String.uppercase_ascii app_name ^ "_TIMEOUT" in
394
+
let env = Cmd.Env.info env_name in
411
395
Arg.(value & opt (some float) None & info ["timeout"] ~env ~docv:"SECONDS" ~doc)
412
396
413
-
let retries_term =
397
+
let retries_term app_name =
414
398
let doc = "Maximum number of request retries" in
415
-
let env = Cmd.Env.info "REQUESTS_MAX_RETRIES" in
399
+
let env_name = String.uppercase_ascii app_name ^ "_MAX_RETRIES" in
400
+
let env = Cmd.Env.info env_name in
416
401
Arg.(value & opt int 3 & info ["max-retries"] ~env ~docv:"N" ~doc)
417
402
418
-
let retry_backoff_term =
403
+
let retry_backoff_term app_name =
419
404
let doc = "Retry backoff factor for exponential delay" in
420
-
let env = Cmd.Env.info "REQUESTS_RETRY_BACKOFF" in
405
+
let env_name = String.uppercase_ascii app_name ^ "_RETRY_BACKOFF" in
406
+
let env = Cmd.Env.info env_name in
421
407
Arg.(value & opt float 0.3 & info ["retry-backoff"] ~env ~docv:"FACTOR" ~doc)
422
408
423
-
let follow_redirects_term =
409
+
let follow_redirects_term app_name =
424
410
let doc = "Don't follow HTTP redirects" in
425
-
let env = Cmd.Env.info "REQUESTS_NO_FOLLOW_REDIRECTS" in
411
+
let env_name = String.uppercase_ascii app_name ^ "_NO_FOLLOW_REDIRECTS" in
412
+
let env = Cmd.Env.info env_name in
426
413
Term.(const (fun no_follow -> not no_follow) $
427
414
Arg.(value & flag & info ["no-follow-redirects"] ~env ~doc))
428
415
429
-
let max_redirects_term =
416
+
let max_redirects_term app_name =
430
417
let doc = "Maximum number of redirects to follow" in
431
-
let env = Cmd.Env.info "REQUESTS_MAX_REDIRECTS" in
418
+
let env_name = String.uppercase_ascii app_name ^ "_MAX_REDIRECTS" in
419
+
let env = Cmd.Env.info env_name in
432
420
Arg.(value & opt int 10 & info ["max-redirects"] ~env ~docv:"N" ~doc)
433
421
434
-
let user_agent_term =
422
+
let user_agent_term app_name =
435
423
let doc = "User-Agent header to send with requests" in
436
-
let env = Cmd.Env.info "REQUESTS_USER_AGENT" in
424
+
let env_name = String.uppercase_ascii app_name ^ "_USER_AGENT" in
425
+
let env = Cmd.Env.info env_name in
437
426
Arg.(value & opt (some string) None & info ["user-agent"] ~env ~docv:"STRING" ~doc)
438
427
439
428
(* Combined terms *)
···
447
436
follow_redirects = follow; max_redirects = max_redir;
448
437
user_agent = ua })
449
438
$ xdg_term
450
-
$ persist_cookies_term
451
-
$ verify_tls_term
452
-
$ timeout_term
453
-
$ retries_term
454
-
$ retry_backoff_term
455
-
$ follow_redirects_term
456
-
$ max_redirects_term
457
-
$ user_agent_term)
439
+
$ persist_cookies_term app_name
440
+
$ verify_tls_term app_name
441
+
$ timeout_term app_name
442
+
$ retries_term app_name
443
+
$ retry_backoff_term app_name
444
+
$ follow_redirects_term app_name
445
+
$ max_redirects_term app_name
446
+
$ user_agent_term app_name)
458
447
459
448
let session_term app_name env sw =
460
449
let config_t = config_term app_name env#fs in
···
465
454
~config:false ~data:true ~cache:true ~state:false ~runtime:false () in
466
455
Term.(const (fun (xdg, _xdg_cmd) persist -> (xdg, persist))
467
456
$ xdg_term
468
-
$ persist_cookies_term)
457
+
$ persist_cookies_term app_name)
469
458
470
459
let env_docs app_name =
471
460
let app_upper = String.uppercase_ascii app_name in
···
484
473
: Base directory for user data files (default: ~/.local/share)\n\n\
485
474
**XDG_CACHE_HOME**\n\
486
475
: Base directory for user cache files (default: ~/.cache)\n\n\
487
-
**REQUESTS_PERSIST_COOKIES**\n\
476
+
**%s_PERSIST_COOKIES**\n\
488
477
: Set to '1' to persist cookies by default\n\n\
489
-
**REQUESTS_NO_VERIFY_TLS**\n\
478
+
**%s_NO_VERIFY_TLS**\n\
490
479
: Set to '1' to disable TLS verification (insecure)\n\n\
491
-
**REQUESTS_TIMEOUT**\n\
480
+
**%s_TIMEOUT**\n\
492
481
: Default request timeout in seconds\n\n\
493
-
**REQUESTS_MAX_RETRIES**\n\
482
+
**%s_MAX_RETRIES**\n\
494
483
: Maximum number of retries for failed requests\n\n\
495
-
**REQUESTS_USER_AGENT**\n\
484
+
**%s_MAX_REDIRECTS**\n\
485
+
: Maximum number of redirects to follow\n\n\
486
+
**%s_NO_FOLLOW_REDIRECTS**\n\
487
+
: Set to '1' to disable following redirects\n\n\
488
+
**%s_RETRY_BACKOFF**\n\
489
+
: Backoff factor for retry delays\n\n\
490
+
**%s_USER_AGENT**\n\
496
491
: Default User-Agent header\n\n\
497
492
**HTTP_PROXY**, **HTTPS_PROXY**, **NO_PROXY**\n\
498
493
: Proxy configuration (when proxy support is implemented)"
499
494
app_name app_upper app_upper app_upper
495
+
app_upper app_upper app_upper app_upper
496
+
app_upper app_upper app_upper app_upper
500
497
501
498
let pp_config ppf config =
502
499
let _xdg, xdg_cmd = config.xdg in
+16
-46
stack/requests/lib/session.mli
+16
-46
stack/requests/lib/session.mli
···
245
245
unit
246
246
(** Download directly to a file *)
247
247
248
-
(** {1 Batch Operations} *)
249
-
250
-
val concurrent_requests :
251
-
('clock, 'net) t ->
252
-
?max_concurrent:int ->
253
-
(('clock, 'net) t -> 'a) list ->
254
-
'a list
255
-
(** Execute multiple requests concurrently with the same session.
256
-
Cookies and state are shared safely across all requests.
257
-
@param max_concurrent Maximum number of concurrent requests (default: 10) *)
258
-
259
-
val map_concurrent :
260
-
('clock, 'net) t ->
261
-
?max_concurrent:int ->
262
-
f:(('clock, 'net) t -> 'a -> 'b) ->
263
-
'a list ->
264
-
'b list
265
-
(** Map a function over a list concurrently using the session *)
266
-
267
248
val pp : Format.formatter -> ('clock, 'net) t -> unit
268
249
(** Pretty print session configuration *)
269
250
···
322
303
]}
323
304
*)
324
305
325
-
(** {2 Concurrent Downloads}
326
-
{[
327
-
let download_all session urls =
328
-
Session.map_concurrent session ~max_concurrent:5
329
-
~f:(fun sess url ->
330
-
let resp = Session.get sess url in
331
-
Response.body resp |> Buf_read.take_all)
332
-
urls
333
-
]}
334
-
*)
335
-
336
306
(** {1 Cmdliner Integration} *)
337
307
338
308
module Cmd : sig
···
363
333
364
334
(** {2 Individual Terms} *)
365
335
366
-
val persist_cookies_term : bool Cmdliner.Term.t
367
-
(** Term for [--persist-cookies] flag *)
336
+
val persist_cookies_term : string -> bool Cmdliner.Term.t
337
+
(** Term for [--persist-cookies] flag with app-specific env var *)
368
338
369
-
val verify_tls_term : bool Cmdliner.Term.t
370
-
(** Term for [--no-verify-tls] flag *)
339
+
val verify_tls_term : string -> bool Cmdliner.Term.t
340
+
(** Term for [--no-verify-tls] flag with app-specific env var *)
371
341
372
-
val timeout_term : float option Cmdliner.Term.t
373
-
(** Term for [--timeout SECONDS] option *)
342
+
val timeout_term : string -> float option Cmdliner.Term.t
343
+
(** Term for [--timeout SECONDS] option with app-specific env var *)
374
344
375
-
val retries_term : int Cmdliner.Term.t
376
-
(** Term for [--max-retries N] option *)
345
+
val retries_term : string -> int Cmdliner.Term.t
346
+
(** Term for [--max-retries N] option with app-specific env var *)
377
347
378
-
val retry_backoff_term : float Cmdliner.Term.t
379
-
(** Term for [--retry-backoff FACTOR] option *)
348
+
val retry_backoff_term : string -> float Cmdliner.Term.t
349
+
(** Term for [--retry-backoff FACTOR] option with app-specific env var *)
380
350
381
-
val follow_redirects_term : bool Cmdliner.Term.t
382
-
(** Term for [--no-follow-redirects] flag *)
351
+
val follow_redirects_term : string -> bool Cmdliner.Term.t
352
+
(** Term for [--no-follow-redirects] flag with app-specific env var *)
383
353
384
-
val max_redirects_term : int Cmdliner.Term.t
385
-
(** Term for [--max-redirects N] option *)
354
+
val max_redirects_term : string -> int Cmdliner.Term.t
355
+
(** Term for [--max-redirects N] option with app-specific env var *)
386
356
387
-
val user_agent_term : string option Cmdliner.Term.t
388
-
(** Term for [--user-agent STRING] option *)
357
+
val user_agent_term : string -> string option Cmdliner.Term.t
358
+
(** Term for [--user-agent STRING] option with app-specific env var *)
389
359
390
360
(** {2 Combined Terms} *)
391
361
+1
-6
stack/requests/lib/stream.ml
+1
-6
stack/requests/lib/stream.ml
···
23
23
24
24
(* Main request implementation *)
25
25
let request ~sw ?client ?headers ?body ?auth ?timeout ?follow_redirects
26
-
?max_redirects ?pool_config ~method_ url =
26
+
?max_redirects ~method_ url =
27
27
let client = get_client client in
28
28
let start_time = Unix.gettimeofday () in
29
29
30
30
Log.info (fun m -> m "Making %s request to %s" (Method.to_string method_) url);
31
-
32
-
(* Note: pool_config is accepted for API compatibility but not used yet
33
-
as Cohttp_eio doesn't expose connection pooling configuration.
34
-
This will be implemented when connection pooling is added. *)
35
-
let _ = pool_config in
36
31
37
32
(* Prepare headers *)
38
33
let headers = match headers with