···
1
-
let src = Logs.Src.create "requests.cookie_jar" ~doc:"HTTP Cookie Jar"
2
-
module Log = (val Logs.src_log src : Logs.LOG)
4
-
(** Cookie same-site policy *)
5
-
type same_site = [`Strict | `Lax | `None]
15
-
expires : Ptime.t option;
16
-
same_site : same_site option;
17
-
creation_time : Ptime.t;
18
-
last_access : Ptime.t;
21
-
(** Cookie jar for storing and managing cookies *)
23
-
mutable cookies : cookie list;
24
-
mutex : Eio.Mutex.t;
30
-
Log.debug (fun m -> m "Creating new empty cookie jar");
31
-
{ cookies = []; mutex = Eio.Mutex.create () }
33
-
(** {1 Cookie Matching Helpers} *)
35
-
let domain_matches cookie_domain request_domain =
36
-
(* Cookie domain .example.com matches example.com and sub.example.com *)
37
-
if String.starts_with ~prefix:"." cookie_domain then
38
-
let domain = String.sub cookie_domain 1 (String.length cookie_domain - 1) in
39
-
request_domain = domain ||
40
-
String.ends_with ~suffix:("." ^ domain) request_domain
42
-
cookie_domain = request_domain
44
-
let path_matches cookie_path request_path =
45
-
(* Cookie path /foo matches /foo, /foo/, /foo/bar *)
46
-
String.starts_with ~prefix:cookie_path request_path
48
-
let is_expired cookie clock =
49
-
match cookie.expires with
50
-
| None -> false (* Session cookie *)
52
-
let now = Ptime.of_float_s (Eio.Time.now clock) |> Option.value ~default:(Ptime.epoch) in
53
-
Ptime.compare now exp_time > 0
55
-
(** {1 Cookie Parsing} *)
57
-
let parse_cookie_attribute ~url:_ attr value cookie =
58
-
let attr_lower = String.lowercase_ascii attr in
59
-
match attr_lower with
60
-
| "domain" -> { cookie with domain = value }
61
-
| "path" -> { cookie with path = value }
63
-
(* Parse various date formats *)
65
-
let time, _tz_offset, _tz_string = Ptime.of_rfc3339 value |> Result.get_ok in
66
-
{ cookie with expires = Some time }
68
-
Log.debug (fun m -> m "Failed to parse expires: %s" value);
72
-
let seconds = int_of_string value in
73
-
let now = Unix.time () in
74
-
let expires = Ptime.of_float_s (now +. float_of_int seconds) in
75
-
{ cookie with expires }
77
-
| "secure" -> { cookie with secure = true }
78
-
| "httponly" -> { cookie with http_only = true }
80
-
let same_site = match String.lowercase_ascii value with
81
-
| "strict" -> Some `Strict
82
-
| "lax" -> Some `Lax
83
-
| "none" -> Some `None
86
-
{ cookie with same_site }
89
-
let rec parse_set_cookie ~url value =
90
-
Log.debug (fun m -> m "Parsing Set-Cookie: %s" value);
92
-
let uri = Uri.of_string url in
93
-
let default_domain = Uri.host_with_default ~default:"localhost" uri in
95
-
let p = Uri.path uri in
98
-
let last_slash = String.rindex_opt p '/' in
99
-
match last_slash with
101
-
| Some i -> String.sub p 0 (i + 1)
104
-
(* Split into attributes *)
105
-
let parts = String.split_on_char ';' value |> List.map String.trim in
109
-
| name_value :: attrs ->
110
-
(* Parse name=value *)
111
-
(match String.index_opt name_value '=' with
114
-
let name = String.sub name_value 0 eq_pos |> String.trim in
115
-
let value = String.sub name_value (eq_pos + 1)
116
-
(String.length name_value - eq_pos - 1) |> String.trim in
118
-
let now = Ptime.of_float_s (Unix.time ()) |> Option.value ~default:Ptime.epoch in
119
-
let base_cookie = {
122
-
domain = default_domain;
123
-
path = default_path;
128
-
creation_time = now;
132
-
(* Parse attributes *)
133
-
let cookie = List.fold_left (fun cookie attr ->
134
-
match String.index_opt attr '=' with
135
-
| None -> parse_cookie_attribute ~url attr "" cookie
137
-
let attr_name = String.sub attr 0 eq |> String.trim in
138
-
let attr_value = String.sub attr (eq + 1)
139
-
(String.length attr - eq - 1) |> String.trim in
140
-
parse_cookie_attribute ~url attr_name attr_value cookie
141
-
) base_cookie attrs in
143
-
Log.debug (fun m -> m "Parsed cookie: %a" pp_cookie cookie);
146
-
and make_cookie_header cookies =
148
-
|> List.map (fun c -> Printf.sprintf "%s=%s" c.name c.value)
149
-
|> String.concat "; "
151
-
(** {1 Pretty Printing} *)
153
-
and pp_same_site ppf = function
154
-
| `Strict -> Format.pp_print_string ppf "Strict"
155
-
| `Lax -> Format.pp_print_string ppf "Lax"
156
-
| `None -> Format.pp_print_string ppf "None"
158
-
and pp_cookie ppf cookie =
159
-
Format.fprintf ppf "@[<hov 2>{ name=%S;@ value=%S;@ domain=%S;@ path=%S;@ \
160
-
secure=%b;@ http_only=%b;@ expires=%a;@ same_site=%a }@]"
167
-
(Format.pp_print_option Ptime.pp) cookie.expires
168
-
(Format.pp_print_option pp_same_site) cookie.same_site
171
-
Eio.Mutex.lock t.mutex;
172
-
let cookies = t.cookies in
173
-
Eio.Mutex.unlock t.mutex;
175
-
Format.fprintf ppf "@[<v>CookieJar with %d cookies:@," (List.length cookies);
176
-
List.iter (fun cookie ->
177
-
Format.fprintf ppf " %a@," pp_cookie cookie
179
-
Format.fprintf ppf "@]"
181
-
(** {1 Cookie Management} *)
183
-
let add_cookie t cookie =
184
-
Log.debug (fun m -> m "Adding cookie: %s=%s for domain %s"
185
-
cookie.name cookie.value cookie.domain);
187
-
Eio.Mutex.lock t.mutex;
188
-
(* Remove existing cookie with same name, domain, and path *)
189
-
t.cookies <- List.filter (fun c ->
190
-
not (c.name = cookie.name && c.domain = cookie.domain && c.path = cookie.path)
192
-
t.cookies <- cookie :: t.cookies;
193
-
Eio.Mutex.unlock t.mutex
195
-
let extract_from_headers t ~url headers =
196
-
Log.debug (fun m -> m "Extracting cookies from headers for URL: %s" url);
198
-
let set_cookie_values = Headers.get_multi "set-cookie" headers in
199
-
List.iter (fun value ->
200
-
match parse_set_cookie ~url value with
201
-
| Some cookie -> add_cookie t cookie
202
-
| None -> Log.warn (fun m -> m "Failed to parse Set-Cookie header: %s" value)
203
-
) set_cookie_values
205
-
let get_cookies t ~url =
206
-
let uri = Uri.of_string url in
207
-
let domain = Uri.host_with_default ~default:"localhost" uri in
208
-
let path = Uri.path uri in
209
-
let is_secure = Uri.scheme uri = Some "https" in
211
-
Log.debug (fun m -> m "Getting cookies for domain=%s path=%s secure=%b"
212
-
domain path is_secure);
214
-
Eio.Mutex.lock t.mutex;
215
-
let applicable = List.filter (fun cookie ->
216
-
domain_matches cookie.domain domain &&
217
-
path_matches cookie.path path &&
218
-
(not cookie.secure || is_secure)
221
-
(* Update last access time *)
222
-
let now = Ptime.of_float_s (Unix.time ()) |> Option.value ~default:Ptime.epoch in
223
-
let updated = List.map (fun c ->
224
-
if List.memq c applicable then
225
-
{ c with last_access = now }
228
-
t.cookies <- updated;
229
-
Eio.Mutex.unlock t.mutex;
231
-
Log.debug (fun m -> m "Found %d applicable cookies" (List.length applicable));
234
-
let add_to_headers t ~url headers =
235
-
let cookies = get_cookies t ~url in
236
-
if cookies = [] then headers
238
-
let cookie_header = make_cookie_header cookies in
239
-
Log.debug (fun m -> m "Adding Cookie header: %s" cookie_header);
240
-
Headers.add "cookie" cookie_header headers
243
-
Log.info (fun m -> m "Clearing all cookies");
244
-
Eio.Mutex.lock t.mutex;
246
-
Eio.Mutex.unlock t.mutex
248
-
let clear_expired t ~clock =
249
-
Eio.Mutex.lock t.mutex;
250
-
let before_count = List.length t.cookies in
251
-
t.cookies <- List.filter (fun c -> not (is_expired c clock)) t.cookies;
252
-
let removed = before_count - List.length t.cookies in
253
-
Eio.Mutex.unlock t.mutex;
254
-
Log.info (fun m -> m "Cleared %d expired cookies" removed)
256
-
let clear_session_cookies t =
257
-
Eio.Mutex.lock t.mutex;
258
-
let before_count = List.length t.cookies in
259
-
t.cookies <- List.filter (fun c -> c.expires <> None) t.cookies;
260
-
let removed = before_count - List.length t.cookies in
261
-
Eio.Mutex.unlock t.mutex;
262
-
Log.info (fun m -> m "Cleared %d session cookies" removed)
265
-
Eio.Mutex.lock t.mutex;
266
-
let n = List.length t.cookies in
267
-
Eio.Mutex.unlock t.mutex;
270
-
(** {1 Mozilla Format} *)
272
-
let to_mozilla_format_internal t =
273
-
let buffer = Buffer.create 1024 in
274
-
Buffer.add_string buffer "# Netscape HTTP Cookie File\n";
275
-
Buffer.add_string buffer "# This is a generated file! Do not edit.\n\n";
277
-
List.iter (fun cookie ->
278
-
let include_subdomains =
279
-
if String.starts_with ~prefix:"." cookie.domain then "TRUE" else "FALSE" in
280
-
let secure = if cookie.secure then "TRUE" else "FALSE" in
281
-
let expires = match cookie.expires with
282
-
| None -> "0" (* Session cookie *)
284
-
let epoch = Ptime.to_float_s t |> int_of_float |> string_of_int in
288
-
Buffer.add_string buffer (Printf.sprintf "%s\t%s\t%s\t%s\t%s\t%s\t%s\n"
298
-
Buffer.contents buffer
300
-
let to_mozilla_format t =
301
-
Eio.Mutex.lock t.mutex;
302
-
let result = to_mozilla_format_internal t in
303
-
Eio.Mutex.unlock t.mutex;
306
-
let from_mozilla_format content =
307
-
Log.debug (fun m -> m "Parsing Mozilla format cookies");
308
-
let jar = create () in
310
-
let lines = String.split_on_char '\n' content in
311
-
List.iter (fun line ->
312
-
let line = String.trim line in
313
-
if line <> "" && not (String.starts_with ~prefix:"#" line) then
314
-
match String.split_on_char '\t' line with
315
-
| [domain; _include_subdomains; path; secure; expires; name; value] ->
316
-
let now = Ptime.of_float_s (Unix.time ()) |> Option.value ~default:Ptime.epoch in
318
-
let exp_int = try int_of_string expires with _ -> 0 in
319
-
if exp_int = 0 then None
320
-
else Ptime.of_float_s (float_of_int exp_int)
328
-
secure = (secure = "TRUE");
329
-
http_only = false; (* Not stored in Mozilla format *)
331
-
same_site = None; (* Not stored in Mozilla format *)
332
-
creation_time = now;
335
-
add_cookie jar cookie;
336
-
Log.debug (fun m -> m "Loaded cookie: %s=%s" name value)
338
-
Log.warn (fun m -> m "Invalid cookie line: %s" line)
341
-
Log.info (fun m -> m "Loaded %d cookies" (List.length jar.cookies));
344
-
(** {1 File Operations} *)
346
-
(** Get cookie file path - uses XDG data directory or provided path *)
347
-
let get_cookie_file ?xdg ?path () =
348
-
match xdg, path with
349
-
| Some xdg_ctx, _ ->
350
-
(* Use XDG data directory for cookies *)
351
-
let data_dir = Xdge.data_dir xdg_ctx in
352
-
Eio.Path.(data_dir / "cookies.txt")
353
-
| None, Some p -> p
355
-
failwith "Cookie_jar: either xdg or path must be provided"
357
-
let load ?xdg ?path () =
358
-
let cookie_file = get_cookie_file ?xdg ?path () in
359
-
Log.info (fun m -> m "Loading cookies from %a" Eio.Path.pp cookie_file);
362
-
let content = Eio.Path.load cookie_file in
363
-
from_mozilla_format content
366
-
Log.info (fun m -> m "Cookie file not found, creating empty jar");
369
-
Log.err (fun m -> m "Failed to load cookies: %s" (Printexc.to_string exn));
372
-
let save ?xdg ?path t =
373
-
let cookie_file = get_cookie_file ?xdg ?path () in
374
-
Log.info (fun m -> m "Saving %d cookies to %a" (List.length t.cookies) Eio.Path.pp cookie_file);
376
-
let content = to_mozilla_format t in
379
-
Eio.Path.save ~create:(`Or_truncate 0o600) cookie_file content;
380
-
Log.debug (fun m -> m "Cookies saved successfully")
382
-
Log.err (fun m -> m "Failed to save cookies: %s" (Printexc.to_string exn))
anil.recoil.org