this repo has no description
nocache
+11
-553
+5
-13
stack/requests/bin/ocurl.ml
+5
-13
stack/requests/bin/ocurl.ml
···
51
51
let doc = "Show progress bar for downloads" in
52
52
Arg.(value & flag & info ["progress-bar"] ~doc)
53
53
54
-
let enable_cache =
55
-
let doc = "Enable HTTP response caching for GET and HEAD requests" in
56
-
let env_info = Cmdliner.Cmd.Env.info "OCURL_ENABLE_CACHE" in
57
-
Arg.(value & flag & info ["enable-cache"] ~env:env_info ~doc)
58
-
59
54
(* Logging setup *)
60
55
(* Setup logging using Logs_cli for standard logging options *)
61
56
let setup_log =
···
223
218
Error (url_str, exn)
224
219
225
220
(* Main function using Requests with concurrent fetching *)
226
-
let run_request env sw persist_cookies verify_tls enable_cache timeout follow_redirects max_redirects
221
+
let run_request env sw persist_cookies verify_tls timeout follow_redirects max_redirects
227
222
method_ urls headers data json_data output include_headers
228
223
auth _show_progress () =
229
224
···
234
229
235
230
(* Create requests instance with configuration *)
236
231
let timeout_obj = Option.map (fun t -> Requests.Timeout.create ~total:t ()) timeout in
237
-
let req = Requests.create ~sw ~xdg ~persist_cookies ~verify_tls ~enable_cache
232
+
let req = Requests.create ~sw ~xdg ~persist_cookies ~verify_tls
238
233
~follow_redirects ~max_redirects ?timeout:timeout_obj env in
239
234
240
235
(* Set authentication if provided *)
···
315
310
316
311
(* Main entry point *)
317
312
let main method_ urls headers data json_data output include_headers
318
-
auth show_progress persist_cookies verify_tls enable_cache
313
+
auth show_progress persist_cookies verify_tls
319
314
timeout follow_redirects max_redirects () =
320
315
321
316
Eio_main.run @@ fun env ->
322
317
Mirage_crypto_rng_unix.use_default ();
323
318
Switch.run @@ fun sw ->
324
319
325
-
run_request env sw persist_cookies verify_tls enable_cache timeout follow_redirects max_redirects
320
+
run_request env sw persist_cookies verify_tls timeout follow_redirects max_redirects
326
321
method_ urls headers data json_data output include_headers auth
327
322
show_progress ()
328
323
···
351
346
`P "Custom headers:";
352
347
`Pre " $(tname) -H 'Accept: application/json' -H 'X-Api-Key: secret' https://api.example.com";
353
348
`P "With persistent cookies:";
354
-
`Pre " $(tname) --persist-cookies --cache-dir ~/.ocurl https://example.com";
355
-
`P "Enable response caching:";
356
-
`Pre " $(tname) --enable-cache https://api.example.com";
349
+
`Pre " $(tname) --persist-cookies https://example.com";
357
350
`P "Disable TLS verification (insecure):";
358
351
`Pre " $(tname) --no-verify-tls https://self-signed.example.com";
359
352
`S "LOGGING OPTIONS";
···
383
376
show_progress $
384
377
Requests.Cmd.persist_cookies_term app_name $
385
378
Requests.Cmd.verify_tls_term app_name $
386
-
enable_cache $
387
379
Requests.Cmd.timeout_term app_name $
388
380
Requests.Cmd.follow_redirects_term app_name $
389
381
Requests.Cmd.max_redirects_term app_name $
-488
stack/requests/lib/cache.ml
-488
stack/requests/lib/cache.ml
···
1
-
let src = Logs.Src.create "requests.cache" ~doc:"HTTP cache with cacheio"
2
-
module Log = (val Logs.src_log src : Logs.LOG)
3
-
4
-
type cached_response = {
5
-
status : Cohttp.Code.status_code;
6
-
headers : Cohttp.Header.t;
7
-
body : string;
8
-
}
9
-
10
-
type t = {
11
-
sw : Eio.Switch.t;
12
-
enabled : bool;
13
-
cache_get_requests : bool;
14
-
cache_range_requests : bool;
15
-
cacheio : Cacheio.t option;
16
-
memory_cache : (string, cached_response * float) Hashtbl.t;
17
-
}
18
-
19
-
let create ~sw ~enabled ?(cache_get_requests=true) ?(cache_range_requests=true) ~cache_dir () =
20
-
let cacheio =
21
-
match cache_dir with
22
-
| Some dir when enabled ->
23
-
(try
24
-
Some (Cacheio.create ~base_dir:dir)
25
-
with e ->
26
-
Log.warn (fun m -> m "Failed to create cacheio backend: %s. Using memory cache only."
27
-
(Printexc.to_string e));
28
-
None)
29
-
| _ -> None
30
-
in
31
-
{ sw; enabled; cache_get_requests; cache_range_requests; cacheio;
32
-
memory_cache = Hashtbl.create 100 }
33
-
34
-
let make_cache_key ~method_ ~url ~headers =
35
-
let method_str = match method_ with
36
-
| `GET -> "GET" | `HEAD -> "HEAD"
37
-
| _ -> "OTHER"
38
-
in
39
-
let url_str = Uri.to_string url in
40
-
let range_str = match Cohttp.Header.get headers "range" with
41
-
| Some r -> "_range:" ^ r
42
-
| None -> ""
43
-
in
44
-
Printf.sprintf "%s_%s%s" method_str url_str range_str
45
-
46
-
let is_cacheable ~method_ ~status ~headers =
47
-
match method_ with
48
-
| `GET | `HEAD ->
49
-
let code = Cohttp.Code.code_of_status status in
50
-
if code >= 200 && code < 300 then
51
-
match Cohttp.Header.get headers "cache-control" with
52
-
| Some cc ->
53
-
let cc_lower = String.lowercase_ascii cc in
54
-
let rec contains s sub pos =
55
-
if pos + String.length sub > String.length s then false
56
-
else if String.sub s pos (String.length sub) = sub then true
57
-
else contains s sub (pos + 1)
58
-
in
59
-
not (contains cc_lower "no-store" 0 ||
60
-
contains cc_lower "no-cache" 0 ||
61
-
contains cc_lower "private" 0)
62
-
| None -> true
63
-
else
64
-
code = 301 || code = 308
65
-
| _ -> false
66
-
67
-
let parse_max_age headers =
68
-
match Cohttp.Header.get headers "cache-control" with
69
-
| Some cc ->
70
-
let parts = String.split_on_char ',' cc |> List.map String.trim in
71
-
List.find_map (fun part ->
72
-
let prefix = "max-age=" in
73
-
if String.starts_with ~prefix part then
74
-
let value = String.sub part (String.length prefix)
75
-
(String.length part - String.length prefix) in
76
-
try Some (float_of_string value) with _ -> None
77
-
else None
78
-
) parts
79
-
| None -> None
80
-
81
-
(* JSON codec for cache metadata *)
82
-
module Metadata = struct
83
-
type t = {
84
-
status_code : int;
85
-
headers : (string * string) list;
86
-
}
87
-
88
-
let make status_code headers = { status_code; headers }
89
-
let status_code t = t.status_code
90
-
let headers t = t.headers
91
-
92
-
let t_jsont =
93
-
let header_pair_jsont =
94
-
let dec x y = (x, y) in
95
-
let enc (x, y) i = if i = 0 then x else y in
96
-
Jsont.t2 ~dec ~enc Jsont.string
97
-
in
98
-
Jsont.Object.map ~kind:"CacheMetadata" make
99
-
|> Jsont.Object.mem "status_code" Jsont.int ~enc:status_code
100
-
|> Jsont.Object.mem "headers" (Jsont.list header_pair_jsont) ~enc:headers
101
-
|> Jsont.Object.finish
102
-
end
103
-
104
-
let serialize_metadata ~status ~headers =
105
-
let status_code = Cohttp.Code.code_of_status status in
106
-
let headers_assoc = Cohttp.Header.to_list headers in
107
-
let metadata = Metadata.make status_code headers_assoc in
108
-
match Jsont_bytesrw.encode_string' Metadata.t_jsont metadata with
109
-
| Ok s -> s
110
-
| Error e -> failwith (Fmt.str "Failed to serialize metadata: %s" (Jsont.Error.to_string e))
111
-
112
-
let deserialize_metadata json_str =
113
-
try
114
-
match Jsont_bytesrw.decode_string' Metadata.t_jsont json_str with
115
-
| Ok metadata ->
116
-
let status = Cohttp.Code.status_of_code (Metadata.status_code metadata) in
117
-
let headers = Cohttp.Header.of_list (Metadata.headers metadata) in
118
-
Some (status, headers)
119
-
| Error _ -> None
120
-
with _ -> None
121
-
122
-
let get t ~method_ ~url ~headers =
123
-
if not t.enabled then None
124
-
else if method_ = `GET && not t.cache_get_requests then None
125
-
else
126
-
let key = make_cache_key ~method_ ~url ~headers in
127
-
128
-
(* Try cacheio first *)
129
-
match t.cacheio with
130
-
| Some cache ->
131
-
(* Check for metadata entry *)
132
-
let metadata_key = key ^ ".meta" in
133
-
let body_key = key ^ ".body" in
134
-
135
-
if Cacheio.exists cache ~key:metadata_key && Cacheio.exists cache ~key:body_key then
136
-
Eio.Switch.run @@ fun sw ->
137
-
(* Read metadata *)
138
-
let metadata_opt = match Cacheio.get cache ~key:metadata_key ~sw with
139
-
| Some source ->
140
-
let buf = Buffer.create 256 in
141
-
Eio.Flow.copy source (Eio.Flow.buffer_sink buf);
142
-
deserialize_metadata (Buffer.contents buf)
143
-
| None -> None
144
-
in
145
-
146
-
(match metadata_opt with
147
-
| Some (status, resp_headers) ->
148
-
(* Read body *)
149
-
(match Cacheio.get cache ~key:body_key ~sw with
150
-
| Some source ->
151
-
let buf = Buffer.create 4096 in
152
-
Eio.Flow.copy source (Eio.Flow.buffer_sink buf);
153
-
let body = Buffer.contents buf in
154
-
Log.debug (fun m -> m "Cache hit for %s" (Uri.to_string url));
155
-
Some { status; headers = resp_headers; body }
156
-
| None ->
157
-
Log.debug (fun m -> m "Cache body missing for %s" (Uri.to_string url));
158
-
None)
159
-
| None ->
160
-
Log.debug (fun m -> m "Cache metadata missing for %s" (Uri.to_string url));
161
-
None)
162
-
else
163
-
(Log.debug (fun m -> m "Cache miss for %s" (Uri.to_string url));
164
-
None)
165
-
| None ->
166
-
(* Fall back to memory cache *)
167
-
match Hashtbl.find_opt t.memory_cache key with
168
-
| Some (response, expiry) when expiry > Unix.gettimeofday () ->
169
-
Log.debug (fun m -> m "Memory cache hit for %s" (Uri.to_string url));
170
-
Some response
171
-
| _ ->
172
-
Log.debug (fun m -> m "Cache miss for %s" (Uri.to_string url));
173
-
None
174
-
175
-
let get_stream t ~method_ ~url ~headers ~sw =
176
-
if not t.enabled then None
177
-
else if method_ = `GET && not t.cache_get_requests then None
178
-
else
179
-
let key = make_cache_key ~method_ ~url ~headers in
180
-
181
-
match t.cacheio with
182
-
| Some cache ->
183
-
let metadata_key = key ^ ".meta" in
184
-
let body_key = key ^ ".body" in
185
-
186
-
if Cacheio.exists cache ~key:metadata_key && Cacheio.exists cache ~key:body_key then
187
-
(* Read metadata first *)
188
-
let metadata_opt =
189
-
match Cacheio.get cache ~key:metadata_key ~sw with
190
-
| Some source ->
191
-
let buf = Buffer.create 256 in
192
-
Eio.Flow.copy source (Eio.Flow.buffer_sink buf);
193
-
deserialize_metadata (Buffer.contents buf)
194
-
| None -> None
195
-
in
196
-
197
-
(match metadata_opt with
198
-
| Some (status, resp_headers) ->
199
-
(* Return body stream directly *)
200
-
(match Cacheio.get cache ~key:body_key ~sw with
201
-
| Some source ->
202
-
Log.debug (fun m -> m "Streaming cache hit for %s" (Uri.to_string url));
203
-
Some (status, resp_headers, source)
204
-
| None -> None)
205
-
| None -> None)
206
-
else None
207
-
| None -> None
208
-
209
-
let put t ~method_ ~url ~request_headers ~status ~headers ~body =
210
-
if not t.enabled then ()
211
-
else if is_cacheable ~method_ ~status ~headers then
212
-
let key = make_cache_key ~method_ ~url ~headers:request_headers in
213
-
let ttl = parse_max_age headers in
214
-
215
-
Log.debug (fun m -> m "Caching response for %s (ttl: %s)"
216
-
(Uri.to_string url)
217
-
(match ttl with Some t -> Printf.sprintf "%.0fs" t | None -> "3600s"));
218
-
219
-
(match t.cacheio with
220
-
| Some cache ->
221
-
Eio.Switch.run @@ fun _sw ->
222
-
let metadata_key = key ^ ".meta" in
223
-
let metadata = serialize_metadata ~status ~headers in
224
-
let metadata_source = Eio.Flow.string_source metadata in
225
-
Cacheio.put cache ~key:metadata_key ~source:metadata_source ~ttl ();
226
-
227
-
let body_key = key ^ ".body" in
228
-
let body_source = Eio.Flow.string_source body in
229
-
Cacheio.put cache ~key:body_key ~source:body_source ~ttl ()
230
-
| None -> ());
231
-
232
-
let cached_resp = { status; headers; body } in
233
-
let expiry = Unix.gettimeofday () +. Option.value ttl ~default:3600.0 in
234
-
Hashtbl.replace t.memory_cache key (cached_resp, expiry)
235
-
236
-
let put_stream t ~method_ ~url ~request_headers ~status ~headers ~body_source ~ttl =
237
-
if not t.enabled then ()
238
-
else if is_cacheable ~method_ ~status ~headers then
239
-
let key = make_cache_key ~method_ ~url ~headers:request_headers in
240
-
241
-
Log.debug (fun m -> m "Caching streamed response for %s (ttl: %s)"
242
-
(Uri.to_string url)
243
-
(match ttl with Some t -> Printf.sprintf "%.0fs" t | None -> "3600s"));
244
-
245
-
match t.cacheio with
246
-
| Some cache ->
247
-
Eio.Switch.run @@ fun _sw ->
248
-
249
-
(* Store metadata *)
250
-
let metadata_key = key ^ ".meta" in
251
-
let metadata = serialize_metadata ~status ~headers in
252
-
let metadata_source = Eio.Flow.string_source metadata in
253
-
Cacheio.put cache ~key:metadata_key ~source:metadata_source ~ttl ();
254
-
255
-
(* Store body directly from source *)
256
-
let body_key = key ^ ".body" in
257
-
Cacheio.put cache ~key:body_key ~source:body_source ~ttl ()
258
-
| None -> ()
259
-
260
-
module Range = struct
261
-
type t = {
262
-
start : int64;
263
-
end_ : int64 option; (* None means to end of file *)
264
-
}
265
-
266
-
let of_header header =
267
-
(* Parse Range: bytes=start-end *)
268
-
let prefix = "bytes=" in
269
-
let prefix_len = String.length prefix in
270
-
if String.length header >= prefix_len &&
271
-
String.sub header 0 prefix_len = prefix then
272
-
let range_str = String.sub header prefix_len (String.length header - prefix_len) in
273
-
match String.split_on_char '-' range_str with
274
-
| [start; ""] ->
275
-
(* bytes=N- means from N to end *)
276
-
(try Some { start = Int64.of_string start; end_ = None }
277
-
with _ -> None)
278
-
| [start; end_] ->
279
-
(* bytes=N-M *)
280
-
(try Some {
281
-
start = Int64.of_string start;
282
-
end_ = Some (Int64.of_string end_)
283
-
}
284
-
with _ -> None)
285
-
| _ -> None
286
-
else None
287
-
288
-
let to_header t =
289
-
match t.end_ with
290
-
| None -> Printf.sprintf "bytes=%Ld-" t.start
291
-
| Some e -> Printf.sprintf "bytes=%Ld-%Ld" t.start e
292
-
293
-
let to_cacheio_range t ~total_size =
294
-
let end_ = match t.end_ with
295
-
| None -> Int64.pred total_size
296
-
| Some e -> min e (Int64.pred total_size)
297
-
in
298
-
(* Convert to Cacheio.Range.t *)
299
-
Cacheio.Range.create ~start:t.start ~end_
300
-
end
301
-
302
-
let download_range t ~sw ~url ~range ~on_chunk =
303
-
let range_header = Range.to_header range in
304
-
Log.debug (fun m -> m "Range request for %s: %s"
305
-
(Uri.to_string url) range_header);
306
-
307
-
match t.cacheio with
308
-
| Some cache ->
309
-
let key = Uri.to_string url in
310
-
let cacheio_range = Range.to_cacheio_range range ~total_size:Int64.max_int in
311
-
312
-
(match Cacheio.get_range cache ~key ~range:cacheio_range ~sw with
313
-
| `Complete source ->
314
-
let rec read_chunks () =
315
-
let chunk = Cstruct.create 8192 in
316
-
try
317
-
let n = Eio.Flow.single_read source chunk in
318
-
if n > 0 then begin
319
-
on_chunk (Cstruct.to_string ~off:0 ~len:n chunk);
320
-
read_chunks ()
321
-
end
322
-
with End_of_file -> ()
323
-
in
324
-
read_chunks ();
325
-
Some true
326
-
| `Chunks chunk_sources ->
327
-
List.iter (fun (_range, source) ->
328
-
let rec read_chunk () =
329
-
let chunk = Cstruct.create 8192 in
330
-
try
331
-
let n = Eio.Flow.single_read source chunk in
332
-
if n > 0 then begin
333
-
on_chunk (Cstruct.to_string ~off:0 ~len:n chunk);
334
-
read_chunk ()
335
-
end
336
-
with End_of_file -> ()
337
-
in
338
-
read_chunk ()
339
-
) chunk_sources;
340
-
Some true
341
-
| `Not_found -> None)
342
-
| None -> None
343
-
344
-
let put_chunk t ~url ~range ~data =
345
-
if not t.enabled || not t.cache_range_requests then ()
346
-
else
347
-
match t.cacheio with
348
-
| Some cache ->
349
-
let key = Uri.to_string url in
350
-
let cacheio_range = Range.to_cacheio_range range ~total_size:Int64.max_int in
351
-
Eio.Switch.run @@ fun _sw ->
352
-
let source = Eio.Flow.string_source data in
353
-
Cacheio.put_chunk cache ~key ~range:cacheio_range ~source ()
354
-
| None ->
355
-
Log.debug (fun m -> m "Cannot cache chunk for %s: no cacheio backend"
356
-
(Uri.to_string url))
357
-
358
-
let has_complete t ~url ~total_size =
359
-
if not t.enabled then false
360
-
else
361
-
match t.cacheio with
362
-
| Some cache ->
363
-
let key = Uri.to_string url in
364
-
Cacheio.has_complete_chunks cache ~key ~total_size
365
-
| None -> false
366
-
367
-
let missing_ranges t ~url ~total_size =
368
-
if not t.enabled then
369
-
[{ Range.start = 0L; end_ = Some (Int64.pred total_size) }]
370
-
else
371
-
match t.cacheio with
372
-
| Some cache ->
373
-
let key = Uri.to_string url in
374
-
let cacheio_ranges = Cacheio.missing_ranges cache ~key ~total_size in
375
-
List.map (fun r ->
376
-
{ Range.start = Cacheio.Range.start r;
377
-
end_ = Some (Cacheio.Range.end_ r) }
378
-
) cacheio_ranges
379
-
| None ->
380
-
[{ Range.start = 0L; end_ = Some (Int64.pred total_size) }]
381
-
382
-
let coalesce_chunks t ~url =
383
-
if not t.enabled then false
384
-
else
385
-
match t.cacheio with
386
-
| Some cache ->
387
-
let key = Uri.to_string url in
388
-
let promise = Cacheio.coalesce_chunks cache ~key ~verify:true () in
389
-
(match Eio.Promise.await promise with
390
-
| Ok () ->
391
-
Log.info (fun m -> m "Successfully coalesced chunks for %s" key);
392
-
true
393
-
| Error exn ->
394
-
Log.warn (fun m -> m "Failed to coalesce chunks for %s: %s"
395
-
key (Printexc.to_string exn));
396
-
false)
397
-
| None -> false
398
-
399
-
let evict t ~url =
400
-
if not t.enabled then ()
401
-
else
402
-
let key = make_cache_key ~method_:`GET ~url ~headers:(Cohttp.Header.init ()) in
403
-
(match t.cacheio with
404
-
| Some cache ->
405
-
Cacheio.delete cache ~key:(key ^ ".meta");
406
-
Cacheio.delete cache ~key:(key ^ ".body")
407
-
| None -> ());
408
-
Log.debug (fun m -> m "Evicting cache for %s" (Uri.to_string url));
409
-
Hashtbl.remove t.memory_cache key
410
-
411
-
let clear t =
412
-
Log.info (fun m -> m "Clearing entire cache");
413
-
(match t.cacheio with
414
-
| Some cache -> Cacheio.clear cache
415
-
| None -> ());
416
-
Hashtbl.clear t.memory_cache
417
-
418
-
module Stats = struct
419
-
type cacheio_stats = {
420
-
total_entries : int;
421
-
total_bytes : int;
422
-
expired_entries : int;
423
-
pinned_entries : int;
424
-
temporary_entries : int;
425
-
}
426
-
427
-
type t = {
428
-
memory_cache_entries : int;
429
-
cache_backend : string;
430
-
enabled : bool;
431
-
cache_get_requests : bool;
432
-
cache_range_requests : bool;
433
-
cacheio_stats : cacheio_stats option;
434
-
}
435
-
436
-
let make_cacheio_stats total_entries total_bytes expired_entries pinned_entries temporary_entries =
437
-
{ total_entries; total_bytes; expired_entries; pinned_entries; temporary_entries }
438
-
439
-
let make memory_cache_entries cache_backend enabled cache_get_requests cache_range_requests cacheio_stats =
440
-
{ memory_cache_entries; cache_backend; enabled; cache_get_requests; cache_range_requests; cacheio_stats }
441
-
442
-
let cacheio_stats_jsont =
443
-
Jsont.Object.map ~kind:"CacheioStats" make_cacheio_stats
444
-
|> Jsont.Object.mem "total_entries" Jsont.int ~enc:(fun t -> t.total_entries)
445
-
|> Jsont.Object.mem "total_bytes" Jsont.int ~enc:(fun t -> t.total_bytes)
446
-
|> Jsont.Object.mem "expired_entries" Jsont.int ~enc:(fun t -> t.expired_entries)
447
-
|> Jsont.Object.mem "pinned_entries" Jsont.int ~enc:(fun t -> t.pinned_entries)
448
-
|> Jsont.Object.mem "temporary_entries" Jsont.int ~enc:(fun t -> t.temporary_entries)
449
-
|> Jsont.Object.finish
450
-
451
-
let t_jsont =
452
-
Jsont.Object.map ~kind:"CacheStats" make
453
-
|> Jsont.Object.mem "memory_cache_entries" Jsont.int ~enc:(fun t -> t.memory_cache_entries)
454
-
|> Jsont.Object.mem "cache_backend" Jsont.string ~enc:(fun t -> t.cache_backend)
455
-
|> Jsont.Object.mem "enabled" Jsont.bool ~enc:(fun t -> t.enabled)
456
-
|> Jsont.Object.mem "cache_get_requests" Jsont.bool ~enc:(fun t -> t.cache_get_requests)
457
-
|> Jsont.Object.mem "cache_range_requests" Jsont.bool ~enc:(fun t -> t.cache_range_requests)
458
-
|> Jsont.Object.opt_mem "cacheio_stats" cacheio_stats_jsont ~enc:(fun t -> t.cacheio_stats)
459
-
|> Jsont.Object.finish
460
-
461
-
let to_string t =
462
-
match Jsont_bytesrw.encode_string' ~format:Jsont.Indent t_jsont t with
463
-
| Ok s -> s
464
-
| Error e ->
465
-
let msg = Jsont.Error.to_string e in
466
-
failwith (Printf.sprintf "Failed to encode stats: %s" msg)
467
-
end
468
-
469
-
let stats t =
470
-
let cacheio_stats =
471
-
match t.cacheio with
472
-
| Some cache ->
473
-
let stats = Cacheio.stats cache in
474
-
Some (Stats.make_cacheio_stats
475
-
(Cacheio.Stats.entry_count stats)
476
-
(Int64.to_int (Cacheio.Stats.total_size stats))
477
-
(Cacheio.Stats.expired_count stats)
478
-
(Cacheio.Stats.pinned_count stats)
479
-
(Cacheio.Stats.temporary_count stats))
480
-
| None -> None
481
-
in
482
-
Stats.make
483
-
(Hashtbl.length t.memory_cache)
484
-
(if Option.is_some t.cacheio then "cacheio" else "memory")
485
-
t.enabled
486
-
t.cache_get_requests
487
-
t.cache_range_requests
488
-
cacheio_stats
-1
stack/requests/lib/dune
-1
stack/requests/lib/dune
+2
-45
stack/requests/lib/requests.ml
+2
-45
stack/requests/lib/requests.ml
···
14
14
module Status = Status
15
15
module Error = Error
16
16
module Retry = Retry
17
-
module Cache = Cache
18
17
19
18
(* Note: RNG initialization should be done by the application using
20
19
Mirage_crypto_rng_unix.initialize before calling Eio_main.run.
···
41
40
retry : Retry.config option;
42
41
persist_cookies : bool;
43
42
xdg : Xdge.t option;
44
-
cache : Cache.t option;
45
43
46
44
(* Statistics - mutable for tracking across all derived sessions *)
47
45
mutable requests_made : int;
···
66
64
?(connection_lifetime = 300.0)
67
65
?retry
68
66
?(persist_cookies = false)
69
-
?(enable_cache = false)
70
67
?xdg
71
68
env =
72
69
73
70
let clock = env#clock in
74
71
let net = env#net in
75
72
76
-
let xdg = match xdg, persist_cookies || enable_cache with
73
+
let xdg = match xdg, persist_cookies with
77
74
| Some x, _ -> Some x
78
75
| None, true -> Some (Xdge.create env#fs "requests")
79
76
| None, false -> None
···
135
132
Cookeio.create ()
136
133
in
137
134
138
-
let cache = match enable_cache, xdg with
139
-
| true, Some xdg_ctx ->
140
-
let cache_dir = Xdge.cache_dir xdg_ctx in
141
-
Some (Cache.create ~sw ~enabled:true ~cache_dir:(Some cache_dir) ())
142
-
| true, None ->
143
-
(* Memory-only cache when no XDG available *)
144
-
Some (Cache.create ~sw ~enabled:true ~cache_dir:None ())
145
-
| false, _ -> None
146
-
in
147
-
148
135
{
149
136
sw;
150
137
clock;
···
163
150
retry;
164
151
persist_cookies;
165
152
xdg;
166
-
cache;
167
153
requests_made = 0;
168
154
total_time = 0.0;
169
155
retries_count = 0;
···
254
240
| Some b -> Body.Private.to_string b
255
241
in
256
242
257
-
(* Check cache for GET and HEAD requests when body is not present *)
258
-
let cached_response = match t.cache, method_, body with
259
-
| Some cache, (`GET | `HEAD), None ->
260
-
Log.debug (fun m -> m "Checking cache for %s request to %s" method_str url);
261
-
let headers_cohttp = Cohttp.Header.of_list (Headers.to_list headers) in
262
-
Cache.get cache ~method_ ~url:uri ~headers:headers_cohttp
263
-
| _ -> None
264
-
in
265
-
266
-
let response = match cached_response with
267
-
| Some cached ->
268
-
Log.info (fun m -> m "Cache HIT for %s request to %s" method_str url);
269
-
(* Convert cached response to Response.t *)
270
-
let status = Cohttp.Code.code_of_status cached.Cache.status in
271
-
let resp_headers = Headers.of_list (Cohttp.Header.to_list cached.Cache.headers) in
272
-
let body_flow = Eio.Flow.string_source cached.Cache.body in
273
-
Response.Private.make ~sw:t.sw ~status ~headers:resp_headers ~body:body_flow ~url ~elapsed:0.0
274
-
| None ->
275
-
Log.info (fun m -> m "Cache MISS or not applicable for %s request to %s" method_str url);
243
+
let response =
276
244
277
245
(* Execute request with redirect handling *)
278
246
let rec make_with_redirects url_to_fetch redirects_left =
···
353
321
354
322
let elapsed = Unix.gettimeofday () -. start_time in
355
323
Log.info (fun m -> m "Request completed in %.3f seconds" elapsed);
356
-
357
-
(* Store in cache if successful and caching enabled *)
358
-
(match t.cache with
359
-
| Some cache when final_status >= 200 && final_status < 300 ->
360
-
Log.debug (fun m -> m "Storing response in cache for %s" url);
361
-
let status = Cohttp.Code.status_of_code final_status in
362
-
let resp_headers_cohttp = Cohttp.Header.of_list (Headers.to_list final_headers) in
363
-
let headers_cohttp = Cohttp.Header.of_list (Headers.to_list headers) in
364
-
Cache.put cache ~method_ ~url:uri ~request_headers:headers_cohttp
365
-
~status ~headers:resp_headers_cohttp ~body:final_body_str
366
-
| _ -> ());
367
324
368
325
(* Create a flow from the body string *)
369
326
let body_flow = Eio.Flow.string_source final_body_str in
+4
-6
stack/requests/lib/requests.mli
+4
-6
stack/requests/lib/requests.mli
···
155
155
?connection_lifetime:float ->
156
156
?retry:Retry.config ->
157
157
?persist_cookies:bool ->
158
-
?enable_cache:bool ->
159
158
?xdg:Xdge.t ->
160
159
< clock: 'clock Eio.Resource.t; net: 'net Eio.Resource.t; fs: Eio.Fs.dir_ty Eio.Path.t; .. > ->
161
160
('clock Eio.Resource.t, 'net Eio.Resource.t) t
···
178
177
@param connection_lifetime Max lifetime of any pooled connection (default: 300s)
179
178
@param retry Retry configuration for failed requests
180
179
@param persist_cookies Whether to persist cookies to disk (default: false)
181
-
@param enable_cache Whether to enable HTTP caching (default: false)
182
-
@param xdg XDG directory context for cookies/cache (required if persist_cookies or enable_cache)
180
+
@param xdg XDG directory context for cookies (required if persist_cookies=true)
181
+
182
+
{b Note:} HTTP caching has been disabled for simplicity. See CACHEIO.md for integration notes
183
+
if you need to restore caching functionality in the future.
183
184
*)
184
185
185
186
(** {2 Configuration Management} *)
···
569
570
570
571
(** Timeout configuration for requests *)
571
572
module Timeout = Timeout
572
-
573
-
(** HTTP caching with cache control and range request support *)
574
-
module Cache = Cache
575
573
576
574
(** {2 Logging} *)
577
575