jon.recoil.org
forked from
anil.recoil.org/ocaml-cookeio
OCaml HTTP cookie handling library with support for Eio-based storage jars
publicsuffix
anil.recoil.org
+18
-13
RFC-TODO.md
+18
-13
RFC-TODO.md
···
6
7
### 1. Public Suffix Validation (Section 5.3, Step 5)
8
9
-
**Status:** Not implemented
10
11
The RFC requires rejecting cookies with domains that are "public suffixes" (e.g., `.com`, `.co.uk`) to prevent domain-wide cookie attacks.
12
13
-
**Required behavior:**
14
-
- Maintain or reference a public suffix list (e.g., from [publicsuffix.org](https://publicsuffix.org/))
15
-
- Reject cookies where the Domain attribute is a public suffix (unless it exactly matches the request host)
16
17
-
**Security impact:** Without this, an attacker on `evil.com` could potentially set cookies for `.com` affecting all `.com` sites.
18
19
---
20
···
49
50
### 4. Cookie Ordering in Header (Section 5.4, Step 2)
51
52
-
**Status:** Not implemented
53
54
-
When generating Cookie headers, cookies SHOULD be sorted:
55
1. Cookies with longer paths listed first
56
2. Among equal-length paths, earlier creation-times listed first
57
58
-
**Location:** `get_cookies` function in `cookeio_jar.ml`
59
60
---
61
62
### 5. Creation Time Preservation (Section 5.3, Step 11.3)
63
64
-
**Status:** Not implemented
65
66
-
When replacing an existing cookie (same name/domain/path), the creation-time of the old cookie should be preserved.
67
68
-
**Current behavior:** Completely replaces cookie, losing original creation time.
69
-
70
-
**Location:** `add_cookie` and `add_original` functions in `cookeio_jar.ml`
71
72
---
73
···
145
- [x] Host-only flag for domain matching (Section 5.3, Step 6)
146
- [x] Path matching algorithm (Section 5.1.4)
147
- [x] IP address domain matching - exact match only (Section 5.1.3)
148
149
---
150
···
6
7
### 1. Public Suffix Validation (Section 5.3, Step 5)
8
9
+
**Status:** ✅ IMPLEMENTED
10
11
The RFC requires rejecting cookies with domains that are "public suffixes" (e.g., `.com`, `.co.uk`) to prevent domain-wide cookie attacks.
12
13
+
**Implementation:**
14
+
- Uses the `publicsuffix` library which embeds the Mozilla Public Suffix List at build time
15
+
- Validates Domain attribute in `of_set_cookie_header` before creating the cookie
16
+
- Rejects cookies where Domain is a public suffix (e.g., `.com`, `.co.uk`, `.github.io`)
17
+
- Allows cookies where the request host exactly matches the public suffix domain
18
+
- IP addresses bypass PSL validation (per RFC 6265 Section 5.1.3)
19
+
- Cookies without Domain attribute (host-only) are always allowed
20
21
+
**Security impact:** Prevents attackers from setting domain-wide cookies that would affect all sites under a TLD.
22
23
---
24
···
53
54
### 4. Cookie Ordering in Header (Section 5.4, Step 2)
55
56
+
**Status:** ✅ IMPLEMENTED
57
58
+
When generating Cookie headers, cookies are sorted:
59
1. Cookies with longer paths listed first
60
2. Among equal-length paths, earlier creation-times listed first
61
62
+
**Implementation:** `get_cookies` function in `cookeio_jar.ml` uses `compare_cookie_order` to sort cookies before returning them.
63
64
---
65
66
### 5. Creation Time Preservation (Section 5.3, Step 11.3)
67
68
+
**Status:** ✅ IMPLEMENTED
69
70
+
When replacing an existing cookie (same name/domain/path), the creation-time of the old cookie is preserved.
71
72
+
**Implementation:** `add_cookie` and `add_original` functions in `cookeio_jar.ml` use `preserve_creation_time` to retain the original creation time when updating an existing cookie.
73
74
---
75
···
147
- [x] Host-only flag for domain matching (Section 5.3, Step 6)
148
- [x] Path matching algorithm (Section 5.1.4)
149
- [x] IP address domain matching - exact match only (Section 5.1.3)
150
+
- [x] Cookie ordering in headers - longer paths first, then by creation time (Section 5.4, Step 2)
151
+
- [x] Creation time preservation when replacing cookies (Section 5.3, Step 11.3)
152
+
- [x] Public suffix validation - rejects cookies for TLDs like .com (Section 5.3, Step 5)
153
154
---
155
+2
cookeio.opam
+2
cookeio.opam
+2
dune-project
+2
dune-project
+419
-61
lib/core/cookeio.ml
+419
-61
lib/core/cookeio.ml
···
107
last_access;
108
}
109
110
(** {1 Cookie Parsing Helpers} *)
111
112
(** Normalize a domain by stripping the leading dot.
···
393
(** Parse a Set-Cookie HTTP response header.
394
395
Parses the header according to {{:https://datatracker.ietf.org/doc/html/rfc6265#section-5.2} RFC 6265 Section 5.2},
396
-
extracting the cookie name, value, and all attributes. Returns [None] if
397
-
the cookie is invalid or fails validation.
398
399
@param now Function returning current time for Max-Age computation
400
@param domain The request host (used as default domain)
401
@param path The request path (used as default path)
402
@param header_value The Set-Cookie header value string
403
-
@return The parsed cookie, or [None] if parsing/validation fails
404
405
@see <https://datatracker.ietf.org/doc/html/rfc6265#section-5.2> RFC 6265 Section 5.2 - The Set-Cookie Header *)
406
let of_set_cookie_header ~now ~domain:request_domain ~path:request_path
···
411
let parts = String.split_on_char ';' header_value |> List.map String.trim in
412
413
match parts with
414
-
| [] -> None
415
| name_value :: attrs -> (
416
(* Parse name=value *)
417
match String.index_opt name_value '=' with
418
-
| None -> None
419
-
| Some eq_pos ->
420
let name = String.sub name_value 0 eq_pos |> String.trim in
421
let cookie_value =
422
String.sub name_value (eq_pos + 1)
···
424
|> String.trim
425
in
426
427
-
let current_time = now () in
428
429
-
(* Parse all attributes into mutable accumulator *)
430
-
let accumulated_attrs = empty_attributes () in
431
-
List.iter
432
-
(fun attr ->
433
-
match String.index_opt attr '=' with
434
-
| None ->
435
-
(* Attribute without value (e.g., Secure, HttpOnly) *)
436
-
parse_attribute now accumulated_attrs attr ""
437
-
| Some eq ->
438
-
let attr_name = String.sub attr 0 eq |> String.trim in
439
-
let attr_value =
440
-
String.sub attr (eq + 1) (String.length attr - eq - 1)
441
-
|> String.trim
442
-
in
443
-
parse_attribute now accumulated_attrs attr_name attr_value)
444
-
attrs;
445
446
-
(* Validate attributes *)
447
-
if not (validate_attributes accumulated_attrs) then (
448
-
Log.warn (fun m -> m "Cookie validation failed, rejecting cookie");
449
-
None)
450
-
else
451
-
let cookie =
452
-
build_cookie ~request_domain ~request_path ~name
453
-
~value:cookie_value accumulated_attrs ~now:current_time
454
-
in
455
-
Log.debug (fun m -> m "Parsed cookie: %a" pp cookie);
456
-
Some cookie)
457
458
(** Parse a Cookie HTTP request header.
459
460
Parses the header according to {{:https://datatracker.ietf.org/doc/html/rfc6265#section-4.2} RFC 6265 Section 4.2}.
461
The Cookie header contains semicolon-separated name=value pairs.
462
463
Cookies parsed from the Cookie header have [host_only = true] since we
464
cannot determine from the header alone whether they originally had a
465
Domain attribute.
···
468
@param domain The request host (assigned to all parsed cookies)
469
@param path The request path (assigned to all parsed cookies)
470
@param header_value The Cookie header value string
471
-
@return List of parse results (Ok cookie or Error message)
472
473
@see <https://datatracker.ietf.org/doc/html/rfc6265#section-4.2> RFC 6265 Section 4.2 - The Cookie Header *)
474
let of_cookie_header ~now ~domain ~path header_value =
···
480
(* Filter out empty parts *)
481
let parts = List.filter (fun s -> String.length s > 0) parts in
482
483
-
(* Parse each name=value pair *)
484
-
List.map
485
-
(fun name_value ->
486
-
match String.index_opt name_value '=' with
487
-
| None ->
488
-
Error (Printf.sprintf "Cookie missing '=' separator: %s" name_value)
489
-
| Some eq_pos ->
490
-
let cookie_name = String.sub name_value 0 eq_pos |> String.trim in
491
-
if String.length cookie_name = 0 then Error "Cookie has empty name"
492
-
else
493
-
let cookie_value =
494
-
String.sub name_value (eq_pos + 1)
495
-
(String.length name_value - eq_pos - 1)
496
-
|> String.trim
497
-
in
498
-
let current_time = now () in
499
-
(* Create cookie with defaults from Cookie header context.
500
-
Cookies from Cookie headers have host_only=true since we don't
501
-
know if they originally had a Domain attribute. *)
502
-
let cookie =
503
-
make ~domain ~path ~name:cookie_name ~value:cookie_value
504
-
~secure:false ~http_only:false ~partitioned:false ~host_only:true
505
-
~creation_time:current_time ~last_access:current_time ()
506
-
in
507
-
Ok cookie)
508
-
parts
509
510
(** Generate a Cookie HTTP request header from a list of cookies.
511
···
107
last_access;
108
}
109
110
+
(** {1 RFC 6265 Validation}
111
+
112
+
Validation functions for cookie names, values, and attributes per
113
+
{{:https://datatracker.ietf.org/doc/html/rfc6265#section-4.1.1} RFC 6265 Section 4.1.1}.
114
+
115
+
@see <https://datatracker.ietf.org/doc/html/rfc6265#section-4.1.1> RFC 6265 Section 4.1.1 - Syntax *)
116
+
module Validate = struct
117
+
(** Check if a character is a valid RFC 2616 token character.
118
+
119
+
Per RFC 6265, cookie-name must be a token as defined in RFC 2616 Section 2.2:
120
+
token = 1*<any CHAR except CTLs or separators>
121
+
separators = "(" | ")" | "<" | ">" | "@" | "," | ";" | ":" | "\" |
122
+
<"> | "/" | "[" | "]" | "?" | "=" | "{" | "}" | SP | HT
123
+
124
+
@see <https://datatracker.ietf.org/doc/html/rfc6265#section-4.1.1> RFC 6265 Section 4.1.1 *)
125
+
let is_token_char = function
126
+
| '\x00' .. '\x1F' | '\x7F' -> false (* CTL characters *)
127
+
| '(' | ')' | '<' | '>' | '@' | ',' | ';' | ':' | '\\' | '"' | '/' | '['
128
+
| ']' | '?' | '=' | '{' | '}' | ' ' ->
129
+
false (* separators - note: HT (0x09) is already covered by CTL range *)
130
+
| _ -> true
131
+
132
+
(** Validate a cookie name per RFC 6265.
133
+
134
+
Cookie names must be valid RFC 2616 tokens: one or more characters
135
+
excluding control characters and separators.
136
+
137
+
@param name The cookie name to validate
138
+
@return [Ok name] if valid, [Error message] with explanation if invalid
139
+
140
+
@see <https://datatracker.ietf.org/doc/html/rfc6265#section-4.1.1> RFC 6265 Section 4.1.1 *)
141
+
let cookie_name name =
142
+
let len = String.length name in
143
+
if len = 0 then
144
+
Error "Cookie name is empty; RFC 6265 requires at least one character"
145
+
else
146
+
let rec find_invalid i acc =
147
+
if i >= len then acc
148
+
else
149
+
let c = String.unsafe_get name i in
150
+
if is_token_char c then find_invalid (i + 1) acc
151
+
else find_invalid (i + 1) (c :: acc)
152
+
in
153
+
match find_invalid 0 [] with
154
+
| [] -> Ok name
155
+
| invalid_chars ->
156
+
let chars_str =
157
+
invalid_chars
158
+
|> List.rev
159
+
|> List.map (fun c -> Printf.sprintf "%C" c)
160
+
|> String.concat ", "
161
+
in
162
+
Error
163
+
(Printf.sprintf
164
+
"Cookie name %S contains invalid characters: %s. RFC 6265 requires \
165
+
cookie names to be valid tokens (no control characters, spaces, \
166
+
or separators like ()[]{}=,;:@\\\"/?<>)"
167
+
name chars_str)
168
+
169
+
(** Check if a character is a valid cookie-octet.
170
+
171
+
Per RFC 6265 Section 4.1.1:
172
+
cookie-octet = %x21 / %x23-2B / %x2D-3A / %x3C-5B / %x5D-7E
173
+
(US-ASCII excluding CTLs, whitespace, DQUOTE, comma, semicolon, backslash)
174
+
175
+
@see <https://datatracker.ietf.org/doc/html/rfc6265#section-4.1.1> RFC 6265 Section 4.1.1 *)
176
+
let is_cookie_octet = function
177
+
| '\x21' -> true (* ! *)
178
+
| '\x23' .. '\x2B' -> true (* # $ % & ' ( ) * + *)
179
+
| '\x2D' .. '\x3A' -> true (* - . / 0-9 : *)
180
+
| '\x3C' .. '\x5B' -> true (* < = > ? @ A-Z [ *)
181
+
| '\x5D' .. '\x7E' -> true (* ] ^ _ ` a-z { | } ~ *)
182
+
| _ -> false
183
+
184
+
(** Validate a cookie value per RFC 6265.
185
+
186
+
Cookie values must contain only cookie-octets, optionally wrapped in
187
+
double quotes. Invalid characters include: control characters, space,
188
+
double quote (except as wrapper), comma, semicolon, and backslash.
189
+
190
+
@param value The cookie value to validate
191
+
@return [Ok value] if valid, [Error message] with explanation if invalid
192
+
193
+
@see <https://datatracker.ietf.org/doc/html/rfc6265#section-4.1.1> RFC 6265 Section 4.1.1 *)
194
+
let cookie_value value =
195
+
(* Handle optional DQUOTE wrapper *)
196
+
let len = String.length value in
197
+
let inner_value, inner_len =
198
+
if len >= 2 && value.[0] = '"' && value.[len - 1] = '"' then
199
+
(String.sub value 1 (len - 2), len - 2)
200
+
else (value, len)
201
+
in
202
+
let rec find_invalid i acc =
203
+
if i >= inner_len then acc
204
+
else
205
+
let c = String.unsafe_get inner_value i in
206
+
if is_cookie_octet c then find_invalid (i + 1) acc
207
+
else find_invalid (i + 1) (c :: acc)
208
+
in
209
+
match find_invalid 0 [] with
210
+
| [] -> Ok value
211
+
| invalid_chars ->
212
+
let chars_str =
213
+
invalid_chars
214
+
|> List.rev
215
+
|> List.map (fun c ->
216
+
match c with
217
+
| ' ' -> "space (0x20)"
218
+
| '"' -> "double-quote (0x22)"
219
+
| ',' -> "comma (0x2C)"
220
+
| ';' -> "semicolon (0x3B)"
221
+
| '\\' -> "backslash (0x5C)"
222
+
| c when Char.code c < 0x20 ->
223
+
Printf.sprintf "control char (0x%02X)" (Char.code c)
224
+
| c -> Printf.sprintf "%C (0x%02X)" c (Char.code c))
225
+
|> String.concat ", "
226
+
in
227
+
Error
228
+
(Printf.sprintf
229
+
"Cookie value %S contains invalid characters: %s. RFC 6265 cookie \
230
+
values may only contain printable ASCII excluding space, \
231
+
double-quote, comma, semicolon, and backslash"
232
+
value chars_str)
233
+
234
+
(** Validate a domain attribute value.
235
+
236
+
Domain values must be either:
237
+
- A valid domain name per RFC 1034 Section 3.5
238
+
- A valid IPv4 address
239
+
- A valid IPv6 address
240
+
241
+
@param domain The domain value to validate (leading dot is stripped first)
242
+
@return [Ok domain] if valid, [Error message] with explanation if invalid
243
+
244
+
@see <https://datatracker.ietf.org/doc/html/rfc6265#section-4.1.2.3> RFC 6265 Section 4.1.2.3
245
+
@see <https://datatracker.ietf.org/doc/html/rfc1034#section-3.5> RFC 1034 Section 3.5 *)
246
+
let domain_value domain =
247
+
(* Strip leading dot per RFC 6265 Section 5.2.3 *)
248
+
let domain =
249
+
if String.starts_with ~prefix:"." domain && String.length domain > 1 then
250
+
String.sub domain 1 (String.length domain - 1)
251
+
else domain
252
+
in
253
+
if String.length domain = 0 then
254
+
Error "Domain attribute is empty"
255
+
else
256
+
(* First check if it's an IP address *)
257
+
match Ipaddr.of_string domain with
258
+
| Ok _ -> Ok domain (* Valid IP address *)
259
+
| Error _ -> (
260
+
(* Not an IP, validate as domain name using domain-name library *)
261
+
match Domain_name.of_string domain with
262
+
| Ok _ -> Ok domain
263
+
| Error (`Msg msg) ->
264
+
Error
265
+
(Printf.sprintf
266
+
"Domain %S is not a valid domain name: %s. Domain names \
267
+
must follow RFC 1034: labels must start with a letter, \
268
+
contain only letters/digits/hyphens, not end with a \
269
+
hyphen, and be at most 63 characters each"
270
+
domain msg))
271
+
272
+
(** Validate a path attribute value.
273
+
274
+
Per RFC 6265 Section 4.1.1, path-value may contain any CHAR except
275
+
control characters and semicolon.
276
+
277
+
@param path The path value to validate
278
+
@return [Ok path] if valid, [Error message] with explanation if invalid
279
+
280
+
@see <https://datatracker.ietf.org/doc/html/rfc6265#section-4.1.1> RFC 6265 Section 4.1.1 *)
281
+
let path_value path =
282
+
let len = String.length path in
283
+
let rec find_invalid i acc =
284
+
if i >= len then acc
285
+
else
286
+
let c = String.unsafe_get path i in
287
+
match c with
288
+
| '\x00' .. '\x1F' | '\x7F' | ';' -> find_invalid (i + 1) (c :: acc)
289
+
| _ -> find_invalid (i + 1) acc
290
+
in
291
+
match find_invalid 0 [] with
292
+
| [] -> Ok path
293
+
| invalid_chars ->
294
+
let chars_str =
295
+
invalid_chars
296
+
|> List.rev
297
+
|> List.map (fun c -> Printf.sprintf "0x%02X" (Char.code c))
298
+
|> String.concat ", "
299
+
in
300
+
Error
301
+
(Printf.sprintf
302
+
"Path %S contains invalid characters: %s. Paths may not contain \
303
+
control characters or semicolons"
304
+
path chars_str)
305
+
306
+
(** Validate a Max-Age attribute value.
307
+
308
+
Per RFC 6265 Section 4.1.1, max-age-av uses non-zero-digit *DIGIT.
309
+
However, per Section 5.2.2, user agents should treat values <= 0 as
310
+
"delete immediately". This function returns [Ok] for any integer since
311
+
the parsing code handles negative values by converting to 0.
312
+
313
+
@param seconds The Max-Age value in seconds
314
+
@return [Ok seconds] always (negative values are handled in parsing)
315
+
316
+
@see <https://datatracker.ietf.org/doc/html/rfc6265#section-4.1.1> RFC 6265 Section 4.1.1
317
+
@see <https://datatracker.ietf.org/doc/html/rfc6265#section-5.2.2> RFC 6265 Section 5.2.2 *)
318
+
let max_age seconds = Ok seconds
319
+
end
320
+
321
+
(** {1 Public Suffix Validation}
322
+
323
+
Per {{:https://datatracker.ietf.org/doc/html/rfc6265#section-5.3} RFC 6265 Section 5.3 Step 5},
324
+
cookies with Domain attributes that are public suffixes must be rejected
325
+
to prevent domain-wide cookie attacks.
326
+
327
+
@see <https://datatracker.ietf.org/doc/html/rfc6265#section-5.3> RFC 6265 Section 5.3 - Storage Model
328
+
@see <https://publicsuffix.org/list/> Public Suffix List *)
329
+
330
+
(** Module-level Public Suffix List instance.
331
+
332
+
Lazily initialized on first use. The PSL data is compiled into the
333
+
publicsuffix library at build time from the Mozilla Public Suffix List. *)
334
+
let psl = lazy (Publicsuffix.create ())
335
+
336
+
(** Validate that a cookie domain is not a public suffix.
337
+
338
+
Per RFC 6265 Section 5.3 Step 5, user agents MUST reject cookies where
339
+
the Domain attribute is a public suffix (e.g., ".com", ".co.uk") unless
340
+
the request host exactly matches that domain.
341
+
342
+
This prevents attackers from setting domain-wide cookies that would affect
343
+
all sites under a TLD.
344
+
345
+
@param request_domain The host from the HTTP request
346
+
@param cookie_domain The Domain attribute value (already normalized, without leading dot)
347
+
@return [Ok ()] if the domain is allowed, [Error msg] if it's a public suffix
348
+
349
+
Examples:
350
+
- Request from "www.example.com", Domain=".com" → Error (public suffix)
351
+
- Request from "www.example.com", Domain=".example.com" → Ok (not public suffix)
352
+
- Request from "com", Domain=".com" → Ok (request host matches domain exactly)
353
+
354
+
@see <https://datatracker.ietf.org/doc/html/rfc6265#section-5.3> RFC 6265 Section 5.3 *)
355
+
let validate_not_public_suffix ~request_domain ~cookie_domain =
356
+
(* IP addresses bypass PSL check per RFC 6265 Section 5.1.3 *)
357
+
match Ipaddr.of_string cookie_domain with
358
+
| Ok _ -> Ok () (* IP addresses are not subject to PSL rules *)
359
+
| Error _ ->
360
+
let psl = Lazy.force psl in
361
+
(match Publicsuffix.is_public_suffix psl cookie_domain with
362
+
| Error _ ->
363
+
(* If PSL lookup fails (e.g., invalid domain), allow the cookie.
364
+
Domain name validation is handled separately. *)
365
+
Ok ()
366
+
| Ok false ->
367
+
(* Not a public suffix, allow the cookie *)
368
+
Ok ()
369
+
| Ok true ->
370
+
(* It's a public suffix - only allow if request host matches exactly.
371
+
This allows a server that IS a public suffix (rare but possible with
372
+
private domains like blogspot.com) to set cookies for itself. *)
373
+
let request_lower = String.lowercase_ascii request_domain in
374
+
let cookie_lower = String.lowercase_ascii cookie_domain in
375
+
if request_lower = cookie_lower then Ok ()
376
+
else
377
+
Error
378
+
(Printf.sprintf
379
+
"Domain %S is a public suffix; RFC 6265 Section 5.3 prohibits \
380
+
setting cookies for public suffixes to prevent domain-wide \
381
+
cookie attacks. The request host %S does not exactly match \
382
+
the domain."
383
+
cookie_domain request_domain))
384
+
385
(** {1 Cookie Parsing Helpers} *)
386
387
(** Normalize a domain by stripping the leading dot.
···
668
(** Parse a Set-Cookie HTTP response header.
669
670
Parses the header according to {{:https://datatracker.ietf.org/doc/html/rfc6265#section-5.2} RFC 6265 Section 5.2},
671
+
extracting the cookie name, value, and all attributes. Returns [Error msg] if
672
+
the cookie is invalid or fails validation, with a descriptive error message.
673
674
@param now Function returning current time for Max-Age computation
675
@param domain The request host (used as default domain)
676
@param path The request path (used as default path)
677
@param header_value The Set-Cookie header value string
678
+
@return [Ok cookie] if parsing succeeds, [Error msg] with explanation if invalid
679
680
@see <https://datatracker.ietf.org/doc/html/rfc6265#section-5.2> RFC 6265 Section 5.2 - The Set-Cookie Header *)
681
let of_set_cookie_header ~now ~domain:request_domain ~path:request_path
···
686
let parts = String.split_on_char ';' header_value |> List.map String.trim in
687
688
match parts with
689
+
| [] -> Error "Empty Set-Cookie header"
690
| name_value :: attrs -> (
691
(* Parse name=value *)
692
match String.index_opt name_value '=' with
693
+
| None ->
694
+
Error
695
+
(Printf.sprintf
696
+
"Set-Cookie header missing '=' separator in name-value pair: %S"
697
+
name_value)
698
+
| Some eq_pos -> (
699
let name = String.sub name_value 0 eq_pos |> String.trim in
700
let cookie_value =
701
String.sub name_value (eq_pos + 1)
···
703
|> String.trim
704
in
705
706
+
(* Validate cookie name per RFC 6265 *)
707
+
match Validate.cookie_name name with
708
+
| Error msg -> Error msg
709
+
| Ok name -> (
710
+
(* Validate cookie value per RFC 6265 *)
711
+
match Validate.cookie_value cookie_value with
712
+
| Error msg -> Error msg
713
+
| Ok cookie_value ->
714
+
let current_time = now () in
715
716
+
(* Parse all attributes into mutable accumulator *)
717
+
let accumulated_attrs = empty_attributes () in
718
+
let attr_errors = ref [] in
719
+
List.iter
720
+
(fun attr ->
721
+
match String.index_opt attr '=' with
722
+
| None ->
723
+
(* Attribute without value (e.g., Secure, HttpOnly) *)
724
+
parse_attribute now accumulated_attrs attr ""
725
+
| Some eq ->
726
+
let attr_name = String.sub attr 0 eq |> String.trim in
727
+
let attr_value =
728
+
String.sub attr (eq + 1)
729
+
(String.length attr - eq - 1)
730
+
|> String.trim
731
+
in
732
+
(* Validate domain and path attributes *)
733
+
(match String.lowercase_ascii attr_name with
734
+
| "domain" -> (
735
+
match Validate.domain_value attr_value with
736
+
| Error msg -> attr_errors := msg :: !attr_errors
737
+
| Ok _ -> ())
738
+
| "path" -> (
739
+
match Validate.path_value attr_value with
740
+
| Error msg -> attr_errors := msg :: !attr_errors
741
+
| Ok _ -> ())
742
+
| "max-age" -> (
743
+
match int_of_string_opt attr_value with
744
+
| Some seconds -> (
745
+
match Validate.max_age seconds with
746
+
| Error msg ->
747
+
attr_errors := msg :: !attr_errors
748
+
| Ok _ -> ())
749
+
| None -> ())
750
+
| _ -> ());
751
+
parse_attribute now accumulated_attrs attr_name
752
+
attr_value)
753
+
attrs;
754
755
+
(* Check for attribute validation errors *)
756
+
if List.length !attr_errors > 0 then
757
+
Error (String.concat "; " (List.rev !attr_errors))
758
+
else if not (validate_attributes accumulated_attrs) then
759
+
Error
760
+
"Cookie validation failed: SameSite=None requires \
761
+
Secure flag, and Partitioned requires Secure flag"
762
+
else
763
+
(* Public suffix validation per RFC 6265 Section 5.3 Step 5.
764
+
Only applies when Domain attribute is present. *)
765
+
let psl_result =
766
+
match accumulated_attrs.domain with
767
+
| None ->
768
+
(* No Domain attribute - cookie is host-only, no PSL check needed *)
769
+
Ok ()
770
+
| Some cookie_domain ->
771
+
let normalized = normalize_domain cookie_domain in
772
+
validate_not_public_suffix ~request_domain ~cookie_domain:normalized
773
+
in
774
+
(match psl_result with
775
+
| Error msg -> Error msg
776
+
| Ok () ->
777
+
let cookie =
778
+
build_cookie ~request_domain ~request_path ~name
779
+
~value:cookie_value accumulated_attrs ~now:current_time
780
+
in
781
+
Log.debug (fun m -> m "Parsed cookie: %a" pp cookie);
782
+
Ok cookie))))
783
784
(** Parse a Cookie HTTP request header.
785
786
Parses the header according to {{:https://datatracker.ietf.org/doc/html/rfc6265#section-4.2} RFC 6265 Section 4.2}.
787
The Cookie header contains semicolon-separated name=value pairs.
788
789
+
Validates cookie names and values per RFC 6265 and detects duplicate
790
+
cookie names (which is an error per Section 4.2.1).
791
+
792
Cookies parsed from the Cookie header have [host_only = true] since we
793
cannot determine from the header alone whether they originally had a
794
Domain attribute.
···
797
@param domain The request host (assigned to all parsed cookies)
798
@param path The request path (assigned to all parsed cookies)
799
@param header_value The Cookie header value string
800
+
@return [Ok cookies] if all cookies parse successfully with no duplicates,
801
+
[Error msg] with explanation if validation fails
802
803
@see <https://datatracker.ietf.org/doc/html/rfc6265#section-4.2> RFC 6265 Section 4.2 - The Cookie Header *)
804
let of_cookie_header ~now ~domain ~path header_value =
···
810
(* Filter out empty parts *)
811
let parts = List.filter (fun s -> String.length s > 0) parts in
812
813
+
(* Parse each name=value pair, collecting results *)
814
+
let results =
815
+
List.fold_left
816
+
(fun acc name_value ->
817
+
match acc with
818
+
| Error _ -> acc (* Propagate earlier errors *)
819
+
| Ok (cookies, seen_names) -> (
820
+
match String.index_opt name_value '=' with
821
+
| None ->
822
+
Error
823
+
(Printf.sprintf "Cookie missing '=' separator: %S" name_value)
824
+
| Some eq_pos -> (
825
+
let cookie_name =
826
+
String.sub name_value 0 eq_pos |> String.trim
827
+
in
828
+
(* Validate cookie name per RFC 6265 *)
829
+
match Validate.cookie_name cookie_name with
830
+
| Error msg -> Error msg
831
+
| Ok cookie_name -> (
832
+
(* Check for duplicate names per RFC 6265 Section 4.2.1 *)
833
+
if List.mem cookie_name seen_names then
834
+
Error
835
+
(Printf.sprintf
836
+
"Duplicate cookie name %S in Cookie header; RFC \
837
+
6265 Section 4.2.1 forbids duplicate names"
838
+
cookie_name)
839
+
else
840
+
let cookie_value =
841
+
String.sub name_value (eq_pos + 1)
842
+
(String.length name_value - eq_pos - 1)
843
+
|> String.trim
844
+
in
845
+
(* Validate cookie value per RFC 6265 *)
846
+
match Validate.cookie_value cookie_value with
847
+
| Error msg -> Error msg
848
+
| Ok cookie_value ->
849
+
let current_time = now () in
850
+
(* Create cookie with defaults from Cookie header context.
851
+
Cookies from Cookie headers have host_only=true since we don't
852
+
know if they originally had a Domain attribute. *)
853
+
let cookie =
854
+
make ~domain ~path ~name:cookie_name
855
+
~value:cookie_value ~secure:false ~http_only:false
856
+
~partitioned:false ~host_only:true
857
+
~creation_time:current_time
858
+
~last_access:current_time ()
859
+
in
860
+
Ok (cookie :: cookies, cookie_name :: seen_names)))))
861
+
(Ok ([], []))
862
+
parts
863
+
in
864
+
match results with
865
+
| Error msg -> Error msg
866
+
| Ok (cookies, _) -> Ok (List.rev cookies)
867
868
(** Generate a Cookie HTTP request header from a list of cookies.
869
+113
-9
lib/core/cookeio.mli
+113
-9
lib/core/cookeio.mli
···
261
262
@see <https://datatracker.ietf.org/doc/html/rfc6265#section-5.3> RFC 6265 Section 5.3 - Storage Model *)
263
264
(** {1 Cookie Creation and Parsing} *)
265
266
val of_set_cookie_header :
267
-
now:(unit -> Ptime.t) -> domain:string -> path:string -> string -> t option
268
(** Parse Set-Cookie response header value into a cookie.
269
270
Parses a Set-Cookie header following
···
272
- Basic format: [NAME=VALUE; attribute1; attribute2=value2]
273
- Supports all standard attributes: [expires], [max-age], [domain], [path],
274
[secure], [httponly], [samesite], [partitioned]
275
-
- Returns [None] if parsing fails or cookie validation fails
276
- The [domain] and [path] parameters provide the request context for default
277
values
278
- The [now] parameter is used for calculating expiry times from [max-age]
279
attributes and setting creation/access times
280
281
-
Cookie validation rules (from RFC 6265bis and CHIPS):
282
-
- [SameSite=None] requires the [Secure] flag to be set
283
-
- [Partitioned] requires the [Secure] flag to be set
284
285
Example:
286
{[of_set_cookie_header ~now:(fun () -> Ptime_clock.now ())
287
~domain:"example.com" ~path:"/" "session=abc123; Secure; HttpOnly"]}
288
289
-
@see <https://datatracker.ietf.org/doc/html/rfc6265#section-5.2> RFC 6265 Section 5.2 - The Set-Cookie Header *)
290
291
val of_cookie_header :
292
now:(unit -> Ptime.t) ->
293
domain:string ->
294
path:string ->
295
string ->
296
-
(t, string) result list
297
(** Parse Cookie request header containing semicolon-separated name=value pairs.
298
299
Parses a Cookie header following
···
301
Cookie headers contain only name=value pairs without attributes:
302
["name1=value1; name2=value2; name3=value3"]
303
304
Creates cookies with:
305
- Provided [domain] and [path] from request context
306
- All security flags set to [false] (defaults)
···
309
whether cookies originally had a Domain attribute)
310
- [creation_time] and [last_access] set to current time from [now]
311
312
-
Returns a list of parse results, one per cookie. Parse errors for individual
313
-
cookies are returned as [Error msg] without failing the entire parse.
314
315
Example:
316
{[of_cookie_header ~now:(fun () -> Ptime_clock.now ()) ~domain:"example.com"
···
261
262
@see <https://datatracker.ietf.org/doc/html/rfc6265#section-5.3> RFC 6265 Section 5.3 - Storage Model *)
263
264
+
(** {1 RFC 6265 Validation}
265
+
266
+
Validation functions for cookie names, values, and attributes per
267
+
{{:https://datatracker.ietf.org/doc/html/rfc6265#section-4.1.1} RFC 6265 Section 4.1.1}.
268
+
These functions return [Ok value] on success or [Error msg] with a detailed
269
+
explanation of why validation failed.
270
+
271
+
@see <https://datatracker.ietf.org/doc/html/rfc6265#section-4.1.1> RFC 6265 Section 4.1.1 - Syntax *)
272
+
273
+
module Validate : sig
274
+
val cookie_name : string -> (string, string) result
275
+
(** Validate a cookie name per RFC 6265.
276
+
277
+
Cookie names must be valid RFC 2616 tokens: one or more characters
278
+
excluding control characters and separators.
279
+
280
+
@param name The cookie name to validate
281
+
@return [Ok name] if valid, [Error message] with explanation if invalid
282
+
283
+
@see <https://datatracker.ietf.org/doc/html/rfc6265#section-4.1.1> RFC 6265 Section 4.1.1 *)
284
+
285
+
val cookie_value : string -> (string, string) result
286
+
(** Validate a cookie value per RFC 6265.
287
+
288
+
Cookie values must contain only cookie-octets, optionally wrapped in
289
+
double quotes. Invalid characters include: control characters, space,
290
+
double quote (except as wrapper), comma, semicolon, and backslash.
291
+
292
+
@param value The cookie value to validate
293
+
@return [Ok value] if valid, [Error message] with explanation if invalid
294
+
295
+
@see <https://datatracker.ietf.org/doc/html/rfc6265#section-4.1.1> RFC 6265 Section 4.1.1 *)
296
+
297
+
val domain_value : string -> (string, string) result
298
+
(** Validate a domain attribute value.
299
+
300
+
Domain values must be either:
301
+
- A valid domain name per RFC 1034 Section 3.5
302
+
- A valid IPv4 address
303
+
- A valid IPv6 address
304
+
305
+
@param domain The domain value to validate (leading dot is stripped first)
306
+
@return [Ok domain] if valid, [Error message] with explanation if invalid
307
+
308
+
@see <https://datatracker.ietf.org/doc/html/rfc6265#section-4.1.2.3> RFC 6265 Section 4.1.2.3
309
+
@see <https://datatracker.ietf.org/doc/html/rfc1034#section-3.5> RFC 1034 Section 3.5 *)
310
+
311
+
val path_value : string -> (string, string) result
312
+
(** Validate a path attribute value.
313
+
314
+
Per RFC 6265 Section 4.1.1, path-value may contain any CHAR except
315
+
control characters and semicolon.
316
+
317
+
@param path The path value to validate
318
+
@return [Ok path] if valid, [Error message] with explanation if invalid
319
+
320
+
@see <https://datatracker.ietf.org/doc/html/rfc6265#section-4.1.1> RFC 6265 Section 4.1.1 *)
321
+
322
+
val max_age : int -> (int, string) result
323
+
(** Validate a Max-Age attribute value.
324
+
325
+
Per RFC 6265 Section 4.1.1, max-age-av uses non-zero-digit *DIGIT.
326
+
However, per Section 5.2.2, user agents should treat values <= 0 as
327
+
"delete immediately". This function returns [Ok] for any integer since
328
+
the parsing code handles negative values by converting to 0.
329
+
330
+
@param seconds The Max-Age value in seconds
331
+
@return [Ok seconds] always (negative values are handled in parsing)
332
+
333
+
@see <https://datatracker.ietf.org/doc/html/rfc6265#section-4.1.1> RFC 6265 Section 4.1.1
334
+
@see <https://datatracker.ietf.org/doc/html/rfc6265#section-5.2.2> RFC 6265 Section 5.2.2 *)
335
+
end
336
+
337
(** {1 Cookie Creation and Parsing} *)
338
339
val of_set_cookie_header :
340
+
now:(unit -> Ptime.t) ->
341
+
domain:string ->
342
+
path:string ->
343
+
string ->
344
+
(t, string) result
345
(** Parse Set-Cookie response header value into a cookie.
346
347
Parses a Set-Cookie header following
···
349
- Basic format: [NAME=VALUE; attribute1; attribute2=value2]
350
- Supports all standard attributes: [expires], [max-age], [domain], [path],
351
[secure], [httponly], [samesite], [partitioned]
352
+
- Returns [Error msg] if parsing fails or cookie validation fails, with
353
+
a detailed explanation of what was invalid
354
- The [domain] and [path] parameters provide the request context for default
355
values
356
- The [now] parameter is used for calculating expiry times from [max-age]
357
attributes and setting creation/access times
358
359
+
Validation rules applied:
360
+
- Cookie name must be a valid RFC 2616 token (no CTLs or separators)
361
+
- Cookie value must contain only valid cookie-octets
362
+
- Domain must be a valid domain name (RFC 1034) or IP address
363
+
- Path must not contain control characters or semicolons
364
+
- Max-Age must be non-negative
365
+
- [SameSite=None] requires the [Secure] flag to be set (RFC 6265bis)
366
+
- [Partitioned] requires the [Secure] flag to be set (CHIPS)
367
+
- Domain must not be a public suffix per
368
+
{{:https://datatracker.ietf.org/doc/html/rfc6265#section-5.3} RFC 6265 Section 5.3 Step 5}
369
+
(unless the request host exactly matches the domain). This uses the
370
+
{{:https://publicsuffix.org/list/} Mozilla Public Suffix List} to prevent
371
+
domain-wide cookie attacks.
372
+
373
+
{3 Public Suffix Validation}
374
+
375
+
Cookies with Domain attributes that are public suffixes (e.g., [.com], [.co.uk],
376
+
[.github.io]) are rejected to prevent a malicious site from setting cookies
377
+
that would affect all sites under that TLD.
378
+
379
+
Examples:
380
+
- Request from [www.example.com], Domain=[.com] → rejected (public suffix)
381
+
- Request from [www.example.com], Domain=[.example.com] → allowed
382
+
- Request from [blogspot.com], Domain=[.blogspot.com] → allowed (request matches)
383
384
Example:
385
{[of_set_cookie_header ~now:(fun () -> Ptime_clock.now ())
386
~domain:"example.com" ~path:"/" "session=abc123; Secure; HttpOnly"]}
387
388
+
@see <https://datatracker.ietf.org/doc/html/rfc6265#section-5.2> RFC 6265 Section 5.2 - The Set-Cookie Header
389
+
@see <https://datatracker.ietf.org/doc/html/rfc6265#section-5.3> RFC 6265 Section 5.3 - Storage Model (public suffix check)
390
+
@see <https://publicsuffix.org/list/> Public Suffix List *)
391
392
val of_cookie_header :
393
now:(unit -> Ptime.t) ->
394
domain:string ->
395
path:string ->
396
string ->
397
+
(t list, string) result
398
(** Parse Cookie request header containing semicolon-separated name=value pairs.
399
400
Parses a Cookie header following
···
402
Cookie headers contain only name=value pairs without attributes:
403
["name1=value1; name2=value2; name3=value3"]
404
405
+
Validates each cookie name and value per RFC 6265 and detects duplicate
406
+
cookie names (which is forbidden per Section 4.2.1).
407
+
408
Creates cookies with:
409
- Provided [domain] and [path] from request context
410
- All security flags set to [false] (defaults)
···
413
whether cookies originally had a Domain attribute)
414
- [creation_time] and [last_access] set to current time from [now]
415
416
+
Returns [Ok cookies] if all cookies parse successfully with no duplicates,
417
+
or [Error msg] if any validation fails.
418
419
Example:
420
{[of_cookie_header ~now:(fun () -> Ptime_clock.now ()) ~domain:"example.com"
+1
-1
lib/core/dune
+1
-1
lib/core/dune
+95
-4
lib/jar/cookeio_jar.ml
+95
-4
lib/jar/cookeio_jar.ml
···
146
147
(** {1 Cookie Management} *)
148
149
let add_cookie jar cookie =
150
Log.debug (fun m ->
151
m "Adding cookie to delta: %s=%s for domain %s" (Cookeio.name cookie)
152
(Cookeio.value cookie) (Cookeio.domain cookie));
153
154
Eio.Mutex.lock jar.mutex;
155
(* Remove existing cookie with same identity from delta *)
156
jar.delta_cookies <-
157
List.filter
···
166
(Cookeio.value cookie) (Cookeio.domain cookie));
167
168
Eio.Mutex.lock jar.mutex;
169
(* Remove existing cookie with same identity from original *)
170
jar.original_cookies <-
171
List.filter
···
239
240
Eio.Mutex.unlock jar.mutex
241
242
(** Retrieve cookies that should be sent for a given request.
243
244
Per RFC 6265 Section 5.4, the user agent should include a Cookie header
245
containing cookies that match the request-uri's domain, path, and security
246
context. This function also updates the last-access-time for matched cookies.
247
248
@param jar The cookie jar to search
249
@param clock The Eio clock for timestamp updates
250
@param domain The request domain (hostname or IP address)
251
@param path The request path
252
@param is_secure Whether the request is over a secure channel (HTTPS)
253
-
@return List of cookies that should be included in the Cookie header
254
255
@see <https://datatracker.ietf.org/doc/html/rfc6265#section-5.4> RFC 6265 Section 5.4 - The Cookie Header *)
256
let get_cookies jar ~clock ~domain:request_domain ~path:request_path ~is_secure
···
276
in
277
let unique_cookies = dedup [] all_cookies in
278
279
-
(* Filter for applicable cookies, excluding removal cookies (empty value) *)
280
let applicable =
281
List.filter
282
(fun cookie ->
283
Cookeio.value cookie <> ""
284
(* Exclude removal cookies *)
285
&& domain_matches ~host_only:(Cookeio.host_only cookie)
286
(Cookeio.domain cookie) request_domain
287
&& path_matches (Cookeio.path cookie) request_path
288
&& ((not (Cookeio.secure cookie)) || is_secure))
289
unique_cookies
290
in
291
292
(* Update last access time in both lists *)
293
let now =
···
313
314
Eio.Mutex.unlock jar.mutex;
315
316
-
Log.debug (fun m -> m "Found %d applicable cookies" (List.length applicable));
317
-
applicable
318
319
let clear jar =
320
Log.info (fun m -> m "Clearing all cookies");
···
146
147
(** {1 Cookie Management} *)
148
149
+
(** Preserve creation time from an existing cookie when replacing.
150
+
151
+
Per RFC 6265 Section 5.3, Step 11.3: "If the newly created cookie was
152
+
received from a 'non-HTTP' API and the old-cookie's http-only-flag is
153
+
true, abort these steps and ignore the newly created cookie entirely."
154
+
Step 11.3 also states: "Update the creation-time of the old-cookie to
155
+
match the creation-time of the newly created cookie."
156
+
157
+
However, the common interpretation (and browser behavior) is to preserve
158
+
the original creation-time when updating a cookie. This matches what
159
+
Step 3 of Section 5.4 uses for ordering (creation-time stability).
160
+
161
+
@param old_cookie The existing cookie being replaced (if any)
162
+
@param new_cookie The new cookie to add
163
+
@return The new cookie with creation_time preserved from old_cookie if present
164
+
165
+
@see <https://datatracker.ietf.org/doc/html/rfc6265#section-5.3> RFC 6265 Section 5.3 - Storage Model *)
166
+
let preserve_creation_time old_cookie_opt new_cookie =
167
+
match old_cookie_opt with
168
+
| None -> new_cookie
169
+
| Some old_cookie ->
170
+
Cookeio.make ~domain:(Cookeio.domain new_cookie)
171
+
~path:(Cookeio.path new_cookie) ~name:(Cookeio.name new_cookie)
172
+
~value:(Cookeio.value new_cookie) ~secure:(Cookeio.secure new_cookie)
173
+
~http_only:(Cookeio.http_only new_cookie)
174
+
?expires:(Cookeio.expires new_cookie)
175
+
?max_age:(Cookeio.max_age new_cookie)
176
+
?same_site:(Cookeio.same_site new_cookie)
177
+
~partitioned:(Cookeio.partitioned new_cookie)
178
+
~host_only:(Cookeio.host_only new_cookie)
179
+
~creation_time:(Cookeio.creation_time old_cookie)
180
+
~last_access:(Cookeio.last_access new_cookie)
181
+
()
182
+
183
let add_cookie jar cookie =
184
Log.debug (fun m ->
185
m "Adding cookie to delta: %s=%s for domain %s" (Cookeio.name cookie)
186
(Cookeio.value cookie) (Cookeio.domain cookie));
187
188
Eio.Mutex.lock jar.mutex;
189
+
190
+
(* Find existing cookie with same identity to preserve creation_time
191
+
per RFC 6265 Section 5.3, Step 11.3 *)
192
+
let existing =
193
+
List.find_opt (fun c -> cookie_identity_matches c cookie) jar.delta_cookies
194
+
in
195
+
let existing =
196
+
match existing with
197
+
| Some _ -> existing
198
+
| None ->
199
+
(* Also check original cookies for creation time preservation *)
200
+
List.find_opt
201
+
(fun c -> cookie_identity_matches c cookie)
202
+
jar.original_cookies
203
+
in
204
+
205
+
let cookie = preserve_creation_time existing cookie in
206
+
207
(* Remove existing cookie with same identity from delta *)
208
jar.delta_cookies <-
209
List.filter
···
218
(Cookeio.value cookie) (Cookeio.domain cookie));
219
220
Eio.Mutex.lock jar.mutex;
221
+
222
+
(* Find existing cookie with same identity to preserve creation_time
223
+
per RFC 6265 Section 5.3, Step 11.3 *)
224
+
let existing =
225
+
List.find_opt
226
+
(fun c -> cookie_identity_matches c cookie)
227
+
jar.original_cookies
228
+
in
229
+
230
+
let cookie = preserve_creation_time existing cookie in
231
+
232
(* Remove existing cookie with same identity from original *)
233
jar.original_cookies <-
234
List.filter
···
302
303
Eio.Mutex.unlock jar.mutex
304
305
+
(** Compare cookies for ordering per RFC 6265 Section 5.4, Step 2.
306
+
307
+
Cookies SHOULD be sorted:
308
+
1. Cookies with longer paths listed first
309
+
2. Among equal-length paths, cookies with earlier creation-times first
310
+
311
+
@see <https://datatracker.ietf.org/doc/html/rfc6265#section-5.4> RFC 6265 Section 5.4 - The Cookie Header *)
312
+
let compare_cookie_order c1 c2 =
313
+
let path1_len = String.length (Cookeio.path c1) in
314
+
let path2_len = String.length (Cookeio.path c2) in
315
+
(* Longer paths first (descending order) *)
316
+
match Int.compare path2_len path1_len with
317
+
| 0 ->
318
+
(* Equal path lengths: earlier creation time first (ascending order) *)
319
+
Ptime.compare (Cookeio.creation_time c1) (Cookeio.creation_time c2)
320
+
| n -> n
321
+
322
(** Retrieve cookies that should be sent for a given request.
323
324
Per RFC 6265 Section 5.4, the user agent should include a Cookie header
325
containing cookies that match the request-uri's domain, path, and security
326
context. This function also updates the last-access-time for matched cookies.
327
328
+
Cookies are sorted per Section 5.4, Step 2:
329
+
1. Cookies with longer paths listed first
330
+
2. Among equal-length paths, earlier creation-times listed first
331
+
332
@param jar The cookie jar to search
333
@param clock The Eio clock for timestamp updates
334
@param domain The request domain (hostname or IP address)
335
@param path The request path
336
@param is_secure Whether the request is over a secure channel (HTTPS)
337
+
@return List of cookies that should be included in the Cookie header, sorted
338
339
@see <https://datatracker.ietf.org/doc/html/rfc6265#section-5.4> RFC 6265 Section 5.4 - The Cookie Header *)
340
let get_cookies jar ~clock ~domain:request_domain ~path:request_path ~is_secure
···
360
in
361
let unique_cookies = dedup [] all_cookies in
362
363
+
(* Filter for applicable cookies, excluding removal cookies and expired cookies *)
364
let applicable =
365
List.filter
366
(fun cookie ->
367
Cookeio.value cookie <> ""
368
(* Exclude removal cookies *)
369
+
&& (not (is_expired cookie clock))
370
+
(* Exclude expired cookies *)
371
&& domain_matches ~host_only:(Cookeio.host_only cookie)
372
(Cookeio.domain cookie) request_domain
373
&& path_matches (Cookeio.path cookie) request_path
374
&& ((not (Cookeio.secure cookie)) || is_secure))
375
unique_cookies
376
in
377
+
378
+
(* Sort cookies per RFC 6265 Section 5.4, Step 2:
379
+
- Longer paths first
380
+
- Equal paths: earlier creation time first *)
381
+
let sorted = List.sort compare_cookie_order applicable in
382
383
(* Update last access time in both lists *)
384
let now =
···
404
405
Eio.Mutex.unlock jar.mutex;
406
407
+
Log.debug (fun m -> m "Found %d applicable cookies" (List.length sorted));
408
+
sorted
409
410
let clear jar =
411
Log.info (fun m -> m "Clearing all cookies");
+30
-6
lib/jar/cookeio_jar.mli
+30
-6
lib/jar/cookeio_jar.mli
···
50
51
The cookie is added to the delta, meaning it will appear in Set-Cookie
52
headers when calling {!delta}. If a cookie with the same name/domain/path
53
-
exists in the delta, it will be replaced per
54
-
{{:https://datatracker.ietf.org/doc/html/rfc6265#section-5.3} RFC 6265 Section 5.3}. *)
55
56
val add_original : t -> Cookeio.t -> unit
57
(** Add an original cookie to the jar.
58
59
Original cookies are those received from the client (via Cookie header).
60
They do not appear in the delta. This method should be used when loading
61
-
cookies from incoming HTTP requests. *)
62
63
val delta : t -> Cookeio.t list
64
(** Get cookies that need to be sent in Set-Cookie headers.
···
92
93
Returns all cookies that match the given domain and path, and satisfy the
94
secure flag requirement. Combines original and delta cookies, with delta
95
-
taking precedence. Excludes removal cookies (empty value). Also updates the
96
-
last access time of matching cookies using the provided clock.
97
98
Domain matching follows {{:https://datatracker.ietf.org/doc/html/rfc6265#section-5.1.3} Section 5.1.3}:
99
- IP addresses require exact match only
···
101
102
Path matching follows {{:https://datatracker.ietf.org/doc/html/rfc6265#section-5.1.4} Section 5.1.4}.
103
104
@see <https://datatracker.ietf.org/doc/html/rfc6265#section-5.4> RFC 6265 Section 5.4 - The Cookie Header *)
105
106
val clear : t -> unit
···
123
(** Get the number of unique cookies in the jar. *)
124
125
val get_all_cookies : t -> Cookeio.t list
126
-
(** Get all cookies in the jar. *)
127
128
val is_empty : t -> bool
129
(** Check if the jar is empty. *)
···
50
51
The cookie is added to the delta, meaning it will appear in Set-Cookie
52
headers when calling {!delta}. If a cookie with the same name/domain/path
53
+
exists, it will be replaced per
54
+
{{:https://datatracker.ietf.org/doc/html/rfc6265#section-5.3} RFC 6265 Section 5.3}.
55
+
56
+
Per Section 5.3, Step 11.3, when replacing an existing cookie, the original
57
+
creation-time is preserved. This ensures stable cookie ordering per
58
+
Section 5.4, Step 2.
59
+
60
+
@see <https://datatracker.ietf.org/doc/html/rfc6265#section-5.3> RFC 6265 Section 5.3 - Storage Model *)
61
62
val add_original : t -> Cookeio.t -> unit
63
(** Add an original cookie to the jar.
64
65
Original cookies are those received from the client (via Cookie header).
66
They do not appear in the delta. This method should be used when loading
67
+
cookies from incoming HTTP requests.
68
+
69
+
Per Section 5.3, Step 11.3, when replacing an existing cookie, the original
70
+
creation-time is preserved.
71
+
72
+
@see <https://datatracker.ietf.org/doc/html/rfc6265#section-5.3> RFC 6265 Section 5.3 - Storage Model *)
73
74
val delta : t -> Cookeio.t list
75
(** Get cookies that need to be sent in Set-Cookie headers.
···
103
104
Returns all cookies that match the given domain and path, and satisfy the
105
secure flag requirement. Combines original and delta cookies, with delta
106
+
taking precedence. Excludes:
107
+
- Removal cookies (empty value)
108
+
- Expired cookies (expiry-time in the past per Section 5.3)
109
+
110
+
Cookies are sorted per Section 5.4, Step 2:
111
+
- Cookies with longer paths are listed before cookies with shorter paths
112
+
- Among cookies with equal-length paths, cookies with earlier creation-times
113
+
are listed first
114
+
115
+
Also updates the last access time of matching cookies using the provided clock.
116
117
Domain matching follows {{:https://datatracker.ietf.org/doc/html/rfc6265#section-5.1.3} Section 5.1.3}:
118
- IP addresses require exact match only
···
120
121
Path matching follows {{:https://datatracker.ietf.org/doc/html/rfc6265#section-5.1.4} Section 5.1.4}.
122
123
+
@see <https://datatracker.ietf.org/doc/html/rfc6265#section-5.3> RFC 6265 Section 5.3 - Storage Model (expiry)
124
@see <https://datatracker.ietf.org/doc/html/rfc6265#section-5.4> RFC 6265 Section 5.4 - The Cookie Header *)
125
126
val clear : t -> unit
···
143
(** Get the number of unique cookies in the jar. *)
144
145
val get_all_cookies : t -> Cookeio.t list
146
+
(** Get all cookies in the jar.
147
+
148
+
Returns all cookies including expired ones (for inspection/debugging).
149
+
Use {!get_cookies} with appropriate domain/path for filtered results that
150
+
exclude expired cookies, or call {!clear_expired} first. *)
151
152
val is_empty : t -> bool
153
(** Check if the jar is empty. *)
+821
-101
test/test_cookeio.ml
+821
-101
test/test_cookeio.ml
···
379
"only session cookie remains" "session"
380
(Cookeio.name (List.hd remaining))
381
382
let test_max_age_parsing_with_mock_clock () =
383
Eio_mock.Backend.run @@ fun () ->
384
let clock = Eio_mock.Clock.make () in
···
396
~domain:"example.com" ~path:"/" header
397
in
398
399
-
Alcotest.(check bool) "cookie parsed" true (Option.is_some cookie_opt);
400
401
-
let cookie = Option.get cookie_opt in
402
Alcotest.(check string) "cookie name" "session" (Cookeio.name cookie);
403
Alcotest.(check string) "cookie value" "abc123" (Cookeio.value cookie);
404
Alcotest.(check bool) "cookie secure" true (Cookeio.secure cookie);
···
481
~domain:"example.com" ~path:"/" header
482
in
483
484
-
Alcotest.(check bool) "cookie parsed" true (Option.is_some cookie_opt);
485
486
-
let cookie = Option.get cookie_opt in
487
Alcotest.(check string) "cookie name" "id" (Cookeio.name cookie);
488
Alcotest.(check string) "cookie value" "xyz789" (Cookeio.value cookie);
489
Alcotest.(check string) "cookie domain" "example.com" (Cookeio.domain cookie);
···
523
524
Alcotest.(check bool)
525
"invalid cookie rejected" true
526
-
(Option.is_none cookie_opt);
527
528
(* This should be accepted: SameSite=None with Secure *)
529
let valid_header = "token=abc; SameSite=None; Secure" in
···
537
538
Alcotest.(check bool)
539
"valid cookie accepted" true
540
-
(Option.is_some cookie_opt2);
541
542
-
let cookie = Option.get cookie_opt2 in
543
Alcotest.(check bool) "cookie is secure" true (Cookeio.secure cookie);
544
Alcotest.(
545
check
···
566
|> Option.value ~default:Ptime.epoch)
567
~domain:"example.com" ~path:"/" header
568
in
569
-
Alcotest.(check bool) "cookie parsed" true (Option.is_some cookie_opt);
570
-
let cookie = Option.get cookie_opt in
571
Alcotest.(check string)
572
"domain normalized" "example.com" (Cookeio.domain cookie);
573
···
604
|> Option.value ~default:Ptime.epoch)
605
~domain:"example.com" ~path:"/" header
606
in
607
-
Alcotest.(check bool) "cookie parsed" true (Option.is_some cookie_opt);
608
609
-
let cookie = Option.get cookie_opt in
610
611
(* Verify max_age is stored as a Ptime.Span *)
612
Alcotest.(check bool)
···
642
|> Option.value ~default:Ptime.epoch)
643
~domain:"example.com" ~path:"/" header
644
in
645
-
Alcotest.(check bool) "cookie parsed" true (Option.is_some cookie_opt);
646
647
-
let cookie = Option.get cookie_opt in
648
649
(* Verify max_age is stored as 0 per RFC 6265 *)
650
Alcotest.(check bool)
···
732
|> Option.value ~default:Ptime.epoch)
733
~domain:"example.com" ~path:"/" header
734
in
735
-
Alcotest.(check bool) "cookie parsed" true (Option.is_some cookie_opt);
736
-
let cookie = Option.get cookie_opt in
737
738
(* Generate Set-Cookie header from the cookie *)
739
let set_cookie_header = make_set_cookie_header cookie in
···
748
|> Option.value ~default:Ptime.epoch)
749
~domain:"example.com" ~path:"/" set_cookie_header
750
in
751
-
Alcotest.(check bool) "cookie re-parsed" true (Option.is_some cookie2_opt);
752
-
let cookie2 = Option.get cookie2_opt in
753
754
(* Verify max_age is preserved *)
755
Alcotest.(check (option int))
···
821
|> Option.value ~default:Ptime.epoch)
822
~domain:"example.com" ~path:"/" header
823
in
824
-
Alcotest.(check bool) "FMT1 cookie parsed" true (Option.is_some cookie_opt);
825
826
-
let cookie = Option.get cookie_opt in
827
Alcotest.(check bool)
828
"FMT1 has expiry" true
829
(Option.is_some (Cookeio.expires cookie));
···
853
|> Option.value ~default:Ptime.epoch)
854
~domain:"example.com" ~path:"/" header
855
in
856
-
Alcotest.(check bool) "FMT2 cookie parsed" true (Option.is_some cookie_opt);
857
858
-
let cookie = Option.get cookie_opt in
859
Alcotest.(check bool)
860
"FMT2 has expiry" true
861
(Option.is_some (Cookeio.expires cookie));
···
885
|> Option.value ~default:Ptime.epoch)
886
~domain:"example.com" ~path:"/" header
887
in
888
-
Alcotest.(check bool) "FMT3 cookie parsed" true (Option.is_some cookie_opt);
889
890
-
let cookie = Option.get cookie_opt in
891
Alcotest.(check bool)
892
"FMT3 has expiry" true
893
(Option.is_some (Cookeio.expires cookie));
···
916
|> Option.value ~default:Ptime.epoch)
917
~domain:"example.com" ~path:"/" header
918
in
919
-
Alcotest.(check bool) "FMT4 cookie parsed" true (Option.is_some cookie_opt);
920
921
-
let cookie = Option.get cookie_opt in
922
Alcotest.(check bool)
923
"FMT4 has expiry" true
924
(Option.is_some (Cookeio.expires cookie));
···
947
|> Option.value ~default:Ptime.epoch)
948
~domain:"example.com" ~path:"/" header
949
in
950
-
let cookie = Option.get cookie_opt in
951
let expected = Ptime.of_date_time ((1995, 10, 21), ((07, 28, 00), 0)) in
952
begin match expected with
953
| Some t ->
···
967
|> Option.value ~default:Ptime.epoch)
968
~domain:"example.com" ~path:"/" header2
969
in
970
-
let cookie2 = Option.get cookie_opt2 in
971
let expected2 = Ptime.of_date_time ((1969, 9, 10), ((20, 0, 0), 0)) in
972
begin match expected2 with
973
| Some t ->
···
987
|> Option.value ~default:Ptime.epoch)
988
~domain:"example.com" ~path:"/" header3
989
in
990
-
let cookie3 = Option.get cookie_opt3 in
991
let expected3 = Ptime.of_date_time ((1999, 9, 10), ((20, 0, 0), 0)) in
992
begin match expected3 with
993
| Some t ->
···
1012
|> Option.value ~default:Ptime.epoch)
1013
~domain:"example.com" ~path:"/" header
1014
in
1015
-
let cookie = Option.get cookie_opt in
1016
let expected = Ptime.of_date_time ((2025, 10, 21), ((07, 28, 00), 0)) in
1017
begin match expected with
1018
| Some t ->
···
1032
|> Option.value ~default:Ptime.epoch)
1033
~domain:"example.com" ~path:"/" header2
1034
in
1035
-
let cookie2 = Option.get cookie_opt2 in
1036
let expected2 = Ptime.of_date_time ((2000, 1, 1), ((0, 0, 0), 0)) in
1037
begin match expected2 with
1038
| Some t ->
···
1052
|> Option.value ~default:Ptime.epoch)
1053
~domain:"example.com" ~path:"/" header3
1054
in
1055
-
let cookie3 = Option.get cookie_opt3 in
1056
let expected3 = Ptime.of_date_time ((2068, 9, 10), ((20, 0, 0), 0)) in
1057
begin match expected3 with
1058
| Some t ->
···
1079
in
1080
Alcotest.(check bool)
1081
"RFC 3339 cookie parsed" true
1082
-
(Option.is_some cookie_opt);
1083
1084
-
let cookie = Option.get cookie_opt in
1085
Alcotest.(check bool)
1086
"RFC 3339 has expiry" true
1087
(Option.is_some (Cookeio.expires cookie));
···
1114
(* Cookie should still be parsed, just without expires *)
1115
Alcotest.(check bool)
1116
"cookie parsed despite invalid date" true
1117
-
(Option.is_some cookie_opt);
1118
-
let cookie = Option.get cookie_opt in
1119
Alcotest.(check string) "cookie name correct" "session" (Cookeio.name cookie);
1120
Alcotest.(check string) "cookie value correct" "abc" (Cookeio.value cookie);
1121
(* expires should be None since date was invalid *)
···
1148
in
1149
Alcotest.(check bool)
1150
(description ^ " parsed") true
1151
-
(Option.is_some cookie_opt);
1152
1153
-
let cookie = Option.get cookie_opt in
1154
Alcotest.(check bool)
1155
(description ^ " has expiry")
1156
true
···
1194
in
1195
Alcotest.(check bool)
1196
(description ^ " parsed") true
1197
-
(Option.is_some cookie_opt);
1198
1199
-
let cookie = Option.get cookie_opt in
1200
Alcotest.(check bool)
1201
(description ^ " has expiry")
1202
true
···
1523
|> Option.value ~default:Ptime.epoch)
1524
~domain:"widget.com" ~path:"/" "id=123; Partitioned; Secure"
1525
with
1526
-
| Some c ->
1527
Alcotest.(check bool) "partitioned flag" true (partitioned c);
1528
Alcotest.(check bool) "secure flag" true (secure c)
1529
-
| None -> Alcotest.fail "Should parse valid Partitioned cookie"
1530
1531
let test_partitioned_serialization env =
1532
let clock = Eio.Stdenv.clock env in
···
1562
|> Option.value ~default:Ptime.epoch)
1563
~domain:"widget.com" ~path:"/" "id=123; Partitioned"
1564
with
1565
-
| None -> () (* Expected *)
1566
-
| Some _ -> Alcotest.fail "Should reject Partitioned without Secure"
1567
1568
(* Priority 2.2: Expiration Variants *)
1569
···
1605
|> Option.value ~default:Ptime.epoch)
1606
~domain:"ex.com" ~path:"/" "id=123; Expires=0"
1607
with
1608
-
| Some c ->
1609
Alcotest.(check (option expiration_testable))
1610
"expires=0 is session" (Some `Session) (expires c)
1611
-
| None -> Alcotest.fail "Should parse Expires=0"
1612
1613
let test_serialize_expiration_variants env =
1614
let clock = Eio.Stdenv.clock env in
···
1645
1646
let test_quoted_cookie_values env =
1647
let clock = Eio.Stdenv.clock env in
1648
-
let test_cases =
1649
[
1650
-
("name=value", "value", "value");
1651
-
("name=\"value\"", "\"value\"", "value");
1652
-
("name=\"partial", "\"partial", "\"partial");
1653
-
("name=\"val\"\"", "\"val\"\"", "val\"");
1654
-
("name=val\"", "val\"", "val\"");
1655
-
("name=\"\"", "\"\"", "");
1656
]
1657
in
1658
···
1665
|> Option.value ~default:Ptime.epoch)
1666
~domain:"ex.com" ~path:"/" input
1667
with
1668
-
| Some c ->
1669
Alcotest.(check string)
1670
(Printf.sprintf "raw value for %s" input)
1671
expected_raw (value c);
1672
Alcotest.(check string)
1673
(Printf.sprintf "trimmed value for %s" input)
1674
expected_trimmed (value_trimmed c)
1675
-
| None -> Alcotest.fail ("Parse failed: " ^ input))
1676
-
test_cases
1677
1678
let test_trimmed_value_not_used_for_equality env =
1679
let clock = Eio.Stdenv.clock env in
···
1685
|> Option.value ~default:Ptime.epoch)
1686
~domain:"ex.com" ~path:"/" "name=\"value\""
1687
with
1688
-
| Some c1 -> begin
1689
match
1690
of_set_cookie_header
1691
~now:(fun () ->
···
1693
|> Option.value ~default:Ptime.epoch)
1694
~domain:"ex.com" ~path:"/" "name=value"
1695
with
1696
-
| Some c2 ->
1697
(* Different raw values *)
1698
Alcotest.(check bool)
1699
"different raw values" false
···
1701
(* Same trimmed values *)
1702
Alcotest.(check string)
1703
"same trimmed values" (value_trimmed c1) (value_trimmed c2)
1704
-
| None -> Alcotest.fail "Parse failed for unquoted"
1705
end
1706
-
| None -> Alcotest.fail "Parse failed for quoted"
1707
1708
(* Priority 2.4: Cookie Header Parsing *)
1709
1710
let test_cookie_header_parsing_basic env =
1711
let clock = Eio.Stdenv.clock env in
1712
-
let results =
1713
of_cookie_header
1714
~now:(fun () ->
1715
Ptime.of_float_s (Eio.Time.now clock)
···
1717
~domain:"ex.com" ~path:"/" "session=abc123; theme=dark; lang=en"
1718
in
1719
1720
-
let cookies = List.filter_map Result.to_option results in
1721
-
Alcotest.(check int) "parsed 3 cookies" 3 (List.length cookies);
1722
1723
-
let find name_val = List.find (fun c -> name c = name_val) cookies in
1724
-
Alcotest.(check string) "session value" "abc123" (value (find "session"));
1725
-
Alcotest.(check string) "theme value" "dark" (value (find "theme"));
1726
-
Alcotest.(check string) "lang value" "en" (value (find "lang"))
1727
1728
let test_cookie_header_defaults env =
1729
let clock = Eio.Stdenv.clock env in
···
1735
|> Option.value ~default:Ptime.epoch)
1736
~domain:"example.com" ~path:"/app" "session=xyz"
1737
with
1738
-
| [ Ok c ] ->
1739
(* Domain and path from request context *)
1740
Alcotest.(check string) "domain from context" "example.com" (domain c);
1741
Alcotest.(check string) "path from context" "/app" (path c);
···
1751
Alcotest.(check (option span_testable)) "no max_age" None (max_age c);
1752
Alcotest.(check (option same_site_testable))
1753
"no same_site" None (same_site c)
1754
-
| _ -> Alcotest.fail "Should parse single cookie"
1755
1756
let test_cookie_header_edge_cases env =
1757
let clock = Eio.Stdenv.clock env in
1758
1759
let test input expected_count description =
1760
-
let results =
1761
of_cookie_header
1762
~now:(fun () ->
1763
Ptime.of_float_s (Eio.Time.now clock)
1764
|> Option.value ~default:Ptime.epoch)
1765
~domain:"ex.com" ~path:"/" input
1766
in
1767
-
let cookies = List.filter_map Result.to_option results in
1768
-
Alcotest.(check int) description expected_count (List.length cookies)
1769
in
1770
1771
test "" 0 "empty string";
···
1777
let test_cookie_header_with_errors env =
1778
let clock = Eio.Stdenv.clock env in
1779
1780
-
(* Mix of valid and invalid cookies *)
1781
-
let results =
1782
of_cookie_header
1783
~now:(fun () ->
1784
Ptime.of_float_s (Eio.Time.now clock)
···
1786
~domain:"ex.com" ~path:"/" "valid=1;=noname;valid2=2"
1787
in
1788
1789
-
Alcotest.(check int) "total results" 3 (List.length results);
1790
-
1791
-
let successes = List.filter Result.is_ok results in
1792
-
let errors = List.filter Result.is_error results in
1793
-
1794
-
Alcotest.(check int) "successful parses" 2 (List.length successes);
1795
-
Alcotest.(check int) "failed parses" 1 (List.length errors);
1796
-
1797
-
(* Error should have descriptive message *)
1798
let contains_substring s sub =
1799
try
1800
let _ = Str.search_forward (Str.regexp_string sub) s 0 in
1801
true
1802
with Not_found -> false
1803
in
1804
-
begin match List.hd errors with
1805
| Error msg ->
1806
let has_name = contains_substring msg "name" in
1807
let has_empty = contains_substring msg "empty" in
1808
Alcotest.(check bool)
1809
"error mentions name or empty" true (has_name || has_empty)
1810
-
| Ok _ -> Alcotest.fail "Expected error"
1811
-
end
1812
1813
(* Max-Age and Expires Interaction *)
1814
···
1867
~domain:"ex.com" ~path:"/"
1868
"id=123; Max-Age=3600; Expires=Wed, 21 Oct 2025 07:28:00 GMT"
1869
with
1870
-
| Some c ->
1871
(* Both should be stored *)
1872
begin match max_age c with
1873
| Some span -> begin
···
1883
| Some (`DateTime _) -> ()
1884
| _ -> Alcotest.fail "expires should be parsed"
1885
end
1886
-
| None -> Alcotest.fail "Should parse cookie with both attributes"
1887
1888
(* ============================================================================ *)
1889
(* Host-Only Flag Tests (RFC 6265 Section 5.3) *)
···
1903
|> Option.value ~default:Ptime.epoch)
1904
~domain:"example.com" ~path:"/" header
1905
in
1906
-
Alcotest.(check bool) "cookie parsed" true (Option.is_some cookie_opt);
1907
-
let cookie = Option.get cookie_opt in
1908
Alcotest.(check bool) "host_only is true" true (Cookeio.host_only cookie);
1909
Alcotest.(check string) "domain is request host" "example.com" (Cookeio.domain cookie)
1910
···
1922
|> Option.value ~default:Ptime.epoch)
1923
~domain:"example.com" ~path:"/" header
1924
in
1925
-
Alcotest.(check bool) "cookie parsed" true (Option.is_some cookie_opt);
1926
-
let cookie = Option.get cookie_opt in
1927
Alcotest.(check bool) "host_only is false" false (Cookeio.host_only cookie);
1928
Alcotest.(check string) "domain is attribute value" "example.com" (Cookeio.domain cookie)
1929
···
1941
|> Option.value ~default:Ptime.epoch)
1942
~domain:"example.com" ~path:"/" header
1943
in
1944
-
Alcotest.(check bool) "cookie parsed" true (Option.is_some cookie_opt);
1945
-
let cookie = Option.get cookie_opt in
1946
Alcotest.(check bool) "host_only is false" false (Cookeio.host_only cookie);
1947
Alcotest.(check string) "domain normalized" "example.com" (Cookeio.domain cookie)
1948
···
1991
Eio_mock.Clock.set_time clock 1000.0;
1992
1993
(* Cookies from Cookie header should have host_only=true *)
1994
-
let results =
1995
of_cookie_header
1996
~now:(fun () ->
1997
Ptime.of_float_s (Eio.Time.now clock)
1998
|> Option.value ~default:Ptime.epoch)
1999
~domain:"example.com" ~path:"/" "session=abc; theme=dark"
2000
in
2001
-
let cookies = List.filter_map Result.to_option results in
2002
-
Alcotest.(check int) "parsed 2 cookies" 2 (List.length cookies);
2003
-
List.iter (fun c ->
2004
-
Alcotest.(check bool)
2005
-
("host_only is true for " ^ Cookeio.name c)
2006
-
true (Cookeio.host_only c)
2007
-
) cookies
2008
2009
let test_host_only_mozilla_format_round_trip () =
2010
Eio_mock.Backend.run @@ fun () ->
···
2207
Alcotest.(check int) "/foo/bar does NOT match /baz" 0 (List.length cookies3)
2208
2209
(* ============================================================================ *)
2210
(* IP Address Domain Matching Tests (RFC 6265 Section 5.1.3) *)
2211
(* ============================================================================ *)
2212
···
2361
Alcotest.(check int) "IP matches IP cookie" 1 (List.length cookies3);
2362
Alcotest.(check string) "IP cookie is returned" "ip" (Cookeio.name (List.hd cookies3))
2363
2364
let () =
2365
Eio_main.run @@ fun env ->
2366
let open Alcotest in
···
2388
[
2389
test_case "Cookie expiry with mock clock" `Quick
2390
test_cookie_expiry_with_mock_clock;
2391
test_case "Max-Age parsing with mock clock" `Quick
2392
test_max_age_parsing_with_mock_clock;
2393
test_case "Last access time with mock clock" `Quick
···
2530
test_case "IPv6 exact match" `Quick test_ipv6_exact_match;
2531
test_case "IPv6 full format" `Quick test_ipv6_full_format;
2532
test_case "IP vs hostname behavior" `Quick test_ip_vs_hostname;
2533
] );
2534
]
···
379
"only session cookie remains" "session"
380
(Cookeio.name (List.hd remaining))
381
382
+
let test_get_cookies_filters_expired () =
383
+
Eio_mock.Backend.run @@ fun () ->
384
+
let clock = Eio_mock.Clock.make () in
385
+
Eio_mock.Clock.set_time clock 1000.0;
386
+
387
+
let jar = create () in
388
+
389
+
(* Add an expired cookie (expired at time 500) *)
390
+
let expired = Ptime.of_float_s 500.0 |> Option.get in
391
+
let cookie_expired =
392
+
Cookeio.make ~domain:"example.com" ~path:"/" ~name:"expired"
393
+
~value:"old" ~secure:false ~http_only:false
394
+
~expires:(`DateTime expired)
395
+
~creation_time:(Ptime.of_float_s 100.0 |> Option.get)
396
+
~last_access:(Ptime.of_float_s 100.0 |> Option.get)
397
+
()
398
+
in
399
+
400
+
(* Add a valid cookie (expires at time 2000) *)
401
+
let valid_time = Ptime.of_float_s 2000.0 |> Option.get in
402
+
let cookie_valid =
403
+
Cookeio.make ~domain:"example.com" ~path:"/" ~name:"valid"
404
+
~value:"current" ~secure:false ~http_only:false
405
+
~expires:(`DateTime valid_time)
406
+
~creation_time:(Ptime.of_float_s 1000.0 |> Option.get)
407
+
~last_access:(Ptime.of_float_s 1000.0 |> Option.get)
408
+
()
409
+
in
410
+
411
+
(* Add a session cookie (no expiry) *)
412
+
let cookie_session =
413
+
Cookeio.make ~domain:"example.com" ~path:"/" ~name:"session"
414
+
~value:"sess" ~secure:false ~http_only:false
415
+
~creation_time:(Ptime.of_float_s 1000.0 |> Option.get)
416
+
~last_access:(Ptime.of_float_s 1000.0 |> Option.get)
417
+
()
418
+
in
419
+
420
+
add_cookie jar cookie_expired;
421
+
add_cookie jar cookie_valid;
422
+
add_cookie jar cookie_session;
423
+
424
+
(* get_all_cookies returns all including expired (for inspection) *)
425
+
Alcotest.(check int) "get_all_cookies includes expired" 3
426
+
(List.length (get_all_cookies jar));
427
+
428
+
(* get_cookies should automatically filter out expired cookies *)
429
+
let cookies =
430
+
get_cookies jar ~clock ~domain:"example.com" ~path:"/" ~is_secure:false
431
+
in
432
+
Alcotest.(check int) "get_cookies filters expired" 2 (List.length cookies);
433
+
434
+
let names = List.map Cookeio.name cookies |> List.sort String.compare in
435
+
Alcotest.(check (list string))
436
+
"only non-expired cookies returned"
437
+
[ "session"; "valid" ]
438
+
names
439
+
440
let test_max_age_parsing_with_mock_clock () =
441
Eio_mock.Backend.run @@ fun () ->
442
let clock = Eio_mock.Clock.make () in
···
454
~domain:"example.com" ~path:"/" header
455
in
456
457
+
Alcotest.(check bool) "cookie parsed" true (Result.is_ok cookie_opt);
458
459
+
let cookie = Result.get_ok cookie_opt in
460
Alcotest.(check string) "cookie name" "session" (Cookeio.name cookie);
461
Alcotest.(check string) "cookie value" "abc123" (Cookeio.value cookie);
462
Alcotest.(check bool) "cookie secure" true (Cookeio.secure cookie);
···
539
~domain:"example.com" ~path:"/" header
540
in
541
542
+
Alcotest.(check bool) "cookie parsed" true (Result.is_ok cookie_opt);
543
544
+
let cookie = Result.get_ok cookie_opt in
545
Alcotest.(check string) "cookie name" "id" (Cookeio.name cookie);
546
Alcotest.(check string) "cookie value" "xyz789" (Cookeio.value cookie);
547
Alcotest.(check string) "cookie domain" "example.com" (Cookeio.domain cookie);
···
581
582
Alcotest.(check bool)
583
"invalid cookie rejected" true
584
+
(Result.is_error cookie_opt);
585
586
(* This should be accepted: SameSite=None with Secure *)
587
let valid_header = "token=abc; SameSite=None; Secure" in
···
595
596
Alcotest.(check bool)
597
"valid cookie accepted" true
598
+
(Result.is_ok cookie_opt2);
599
600
+
let cookie = Result.get_ok cookie_opt2 in
601
Alcotest.(check bool) "cookie is secure" true (Cookeio.secure cookie);
602
Alcotest.(
603
check
···
624
|> Option.value ~default:Ptime.epoch)
625
~domain:"example.com" ~path:"/" header
626
in
627
+
Alcotest.(check bool) "cookie parsed" true (Result.is_ok cookie_opt);
628
+
let cookie = Result.get_ok cookie_opt in
629
Alcotest.(check string)
630
"domain normalized" "example.com" (Cookeio.domain cookie);
631
···
662
|> Option.value ~default:Ptime.epoch)
663
~domain:"example.com" ~path:"/" header
664
in
665
+
Alcotest.(check bool) "cookie parsed" true (Result.is_ok cookie_opt);
666
667
+
let cookie = Result.get_ok cookie_opt in
668
669
(* Verify max_age is stored as a Ptime.Span *)
670
Alcotest.(check bool)
···
700
|> Option.value ~default:Ptime.epoch)
701
~domain:"example.com" ~path:"/" header
702
in
703
+
Alcotest.(check bool) "cookie parsed" true (Result.is_ok cookie_opt);
704
705
+
let cookie = Result.get_ok cookie_opt in
706
707
(* Verify max_age is stored as 0 per RFC 6265 *)
708
Alcotest.(check bool)
···
790
|> Option.value ~default:Ptime.epoch)
791
~domain:"example.com" ~path:"/" header
792
in
793
+
Alcotest.(check bool) "cookie parsed" true (Result.is_ok cookie_opt);
794
+
let cookie = Result.get_ok cookie_opt in
795
796
(* Generate Set-Cookie header from the cookie *)
797
let set_cookie_header = make_set_cookie_header cookie in
···
806
|> Option.value ~default:Ptime.epoch)
807
~domain:"example.com" ~path:"/" set_cookie_header
808
in
809
+
Alcotest.(check bool) "cookie re-parsed" true (Result.is_ok cookie2_opt);
810
+
let cookie2 = Result.get_ok cookie2_opt in
811
812
(* Verify max_age is preserved *)
813
Alcotest.(check (option int))
···
879
|> Option.value ~default:Ptime.epoch)
880
~domain:"example.com" ~path:"/" header
881
in
882
+
Alcotest.(check bool) "FMT1 cookie parsed" true (Result.is_ok cookie_opt);
883
884
+
let cookie = Result.get_ok cookie_opt in
885
Alcotest.(check bool)
886
"FMT1 has expiry" true
887
(Option.is_some (Cookeio.expires cookie));
···
911
|> Option.value ~default:Ptime.epoch)
912
~domain:"example.com" ~path:"/" header
913
in
914
+
Alcotest.(check bool) "FMT2 cookie parsed" true (Result.is_ok cookie_opt);
915
916
+
let cookie = Result.get_ok cookie_opt in
917
Alcotest.(check bool)
918
"FMT2 has expiry" true
919
(Option.is_some (Cookeio.expires cookie));
···
943
|> Option.value ~default:Ptime.epoch)
944
~domain:"example.com" ~path:"/" header
945
in
946
+
Alcotest.(check bool) "FMT3 cookie parsed" true (Result.is_ok cookie_opt);
947
948
+
let cookie = Result.get_ok cookie_opt in
949
Alcotest.(check bool)
950
"FMT3 has expiry" true
951
(Option.is_some (Cookeio.expires cookie));
···
974
|> Option.value ~default:Ptime.epoch)
975
~domain:"example.com" ~path:"/" header
976
in
977
+
Alcotest.(check bool) "FMT4 cookie parsed" true (Result.is_ok cookie_opt);
978
979
+
let cookie = Result.get_ok cookie_opt in
980
Alcotest.(check bool)
981
"FMT4 has expiry" true
982
(Option.is_some (Cookeio.expires cookie));
···
1005
|> Option.value ~default:Ptime.epoch)
1006
~domain:"example.com" ~path:"/" header
1007
in
1008
+
let cookie = Result.get_ok cookie_opt in
1009
let expected = Ptime.of_date_time ((1995, 10, 21), ((07, 28, 00), 0)) in
1010
begin match expected with
1011
| Some t ->
···
1025
|> Option.value ~default:Ptime.epoch)
1026
~domain:"example.com" ~path:"/" header2
1027
in
1028
+
let cookie2 = Result.get_ok cookie_opt2 in
1029
let expected2 = Ptime.of_date_time ((1969, 9, 10), ((20, 0, 0), 0)) in
1030
begin match expected2 with
1031
| Some t ->
···
1045
|> Option.value ~default:Ptime.epoch)
1046
~domain:"example.com" ~path:"/" header3
1047
in
1048
+
let cookie3 = Result.get_ok cookie_opt3 in
1049
let expected3 = Ptime.of_date_time ((1999, 9, 10), ((20, 0, 0), 0)) in
1050
begin match expected3 with
1051
| Some t ->
···
1070
|> Option.value ~default:Ptime.epoch)
1071
~domain:"example.com" ~path:"/" header
1072
in
1073
+
let cookie = Result.get_ok cookie_opt in
1074
let expected = Ptime.of_date_time ((2025, 10, 21), ((07, 28, 00), 0)) in
1075
begin match expected with
1076
| Some t ->
···
1090
|> Option.value ~default:Ptime.epoch)
1091
~domain:"example.com" ~path:"/" header2
1092
in
1093
+
let cookie2 = Result.get_ok cookie_opt2 in
1094
let expected2 = Ptime.of_date_time ((2000, 1, 1), ((0, 0, 0), 0)) in
1095
begin match expected2 with
1096
| Some t ->
···
1110
|> Option.value ~default:Ptime.epoch)
1111
~domain:"example.com" ~path:"/" header3
1112
in
1113
+
let cookie3 = Result.get_ok cookie_opt3 in
1114
let expected3 = Ptime.of_date_time ((2068, 9, 10), ((20, 0, 0), 0)) in
1115
begin match expected3 with
1116
| Some t ->
···
1137
in
1138
Alcotest.(check bool)
1139
"RFC 3339 cookie parsed" true
1140
+
(Result.is_ok cookie_opt);
1141
1142
+
let cookie = Result.get_ok cookie_opt in
1143
Alcotest.(check bool)
1144
"RFC 3339 has expiry" true
1145
(Option.is_some (Cookeio.expires cookie));
···
1172
(* Cookie should still be parsed, just without expires *)
1173
Alcotest.(check bool)
1174
"cookie parsed despite invalid date" true
1175
+
(Result.is_ok cookie_opt);
1176
+
let cookie = Result.get_ok cookie_opt in
1177
Alcotest.(check string) "cookie name correct" "session" (Cookeio.name cookie);
1178
Alcotest.(check string) "cookie value correct" "abc" (Cookeio.value cookie);
1179
(* expires should be None since date was invalid *)
···
1206
in
1207
Alcotest.(check bool)
1208
(description ^ " parsed") true
1209
+
(Result.is_ok cookie_opt);
1210
1211
+
let cookie = Result.get_ok cookie_opt in
1212
Alcotest.(check bool)
1213
(description ^ " has expiry")
1214
true
···
1252
in
1253
Alcotest.(check bool)
1254
(description ^ " parsed") true
1255
+
(Result.is_ok cookie_opt);
1256
1257
+
let cookie = Result.get_ok cookie_opt in
1258
Alcotest.(check bool)
1259
(description ^ " has expiry")
1260
true
···
1581
|> Option.value ~default:Ptime.epoch)
1582
~domain:"widget.com" ~path:"/" "id=123; Partitioned; Secure"
1583
with
1584
+
| Ok c ->
1585
Alcotest.(check bool) "partitioned flag" true (partitioned c);
1586
Alcotest.(check bool) "secure flag" true (secure c)
1587
+
| Error msg -> Alcotest.fail ("Should parse valid Partitioned cookie: " ^ msg)
1588
1589
let test_partitioned_serialization env =
1590
let clock = Eio.Stdenv.clock env in
···
1620
|> Option.value ~default:Ptime.epoch)
1621
~domain:"widget.com" ~path:"/" "id=123; Partitioned"
1622
with
1623
+
| Error _ -> () (* Expected *)
1624
+
| Ok _ -> Alcotest.fail "Should reject Partitioned without Secure"
1625
1626
(* Priority 2.2: Expiration Variants *)
1627
···
1663
|> Option.value ~default:Ptime.epoch)
1664
~domain:"ex.com" ~path:"/" "id=123; Expires=0"
1665
with
1666
+
| Ok c ->
1667
Alcotest.(check (option expiration_testable))
1668
"expires=0 is session" (Some `Session) (expires c)
1669
+
| Error msg -> Alcotest.fail ("Should parse Expires=0: " ^ msg)
1670
1671
let test_serialize_expiration_variants env =
1672
let clock = Eio.Stdenv.clock env in
···
1703
1704
let test_quoted_cookie_values env =
1705
let clock = Eio.Stdenv.clock env in
1706
+
(* Test valid RFC 6265 cookie values:
1707
+
cookie-value = *cookie-octet / ( DQUOTE *cookie-octet DQUOTE )
1708
+
Valid cases have either no quotes or properly paired DQUOTE wrapper *)
1709
+
let valid_cases =
1710
[
1711
+
("name=value", "value", "value"); (* No quotes *)
1712
+
("name=\"value\"", "\"value\"", "value"); (* Properly quoted *)
1713
+
("name=\"\"", "\"\"", ""); (* Empty quoted value *)
1714
]
1715
in
1716
···
1723
|> Option.value ~default:Ptime.epoch)
1724
~domain:"ex.com" ~path:"/" input
1725
with
1726
+
| Ok c ->
1727
Alcotest.(check string)
1728
(Printf.sprintf "raw value for %s" input)
1729
expected_raw (value c);
1730
Alcotest.(check string)
1731
(Printf.sprintf "trimmed value for %s" input)
1732
expected_trimmed (value_trimmed c)
1733
+
| Error msg -> Alcotest.fail ("Parse failed: " ^ input ^ ": " ^ msg))
1734
+
valid_cases;
1735
+
1736
+
(* Test invalid RFC 6265 cookie values are rejected *)
1737
+
let invalid_cases =
1738
+
[
1739
+
"name=\"partial"; (* Opening quote without closing *)
1740
+
"name=\"val\"\""; (* Embedded quote *)
1741
+
"name=val\""; (* Trailing quote without opening *)
1742
+
]
1743
+
in
1744
+
1745
+
List.iter
1746
+
(fun input ->
1747
+
match
1748
+
of_set_cookie_header
1749
+
~now:(fun () ->
1750
+
Ptime.of_float_s (Eio.Time.now clock)
1751
+
|> Option.value ~default:Ptime.epoch)
1752
+
~domain:"ex.com" ~path:"/" input
1753
+
with
1754
+
| Error _ -> () (* Expected - invalid values are rejected *)
1755
+
| Ok _ ->
1756
+
Alcotest.fail
1757
+
(Printf.sprintf "Should reject invalid value: %s" input))
1758
+
invalid_cases
1759
1760
let test_trimmed_value_not_used_for_equality env =
1761
let clock = Eio.Stdenv.clock env in
···
1767
|> Option.value ~default:Ptime.epoch)
1768
~domain:"ex.com" ~path:"/" "name=\"value\""
1769
with
1770
+
| Ok c1 -> begin
1771
match
1772
of_set_cookie_header
1773
~now:(fun () ->
···
1775
|> Option.value ~default:Ptime.epoch)
1776
~domain:"ex.com" ~path:"/" "name=value"
1777
with
1778
+
| Ok c2 ->
1779
(* Different raw values *)
1780
Alcotest.(check bool)
1781
"different raw values" false
···
1783
(* Same trimmed values *)
1784
Alcotest.(check string)
1785
"same trimmed values" (value_trimmed c1) (value_trimmed c2)
1786
+
| Error msg -> Alcotest.fail ("Parse failed for unquoted: " ^ msg)
1787
end
1788
+
| Error msg -> Alcotest.fail ("Parse failed for quoted: " ^ msg)
1789
1790
(* Priority 2.4: Cookie Header Parsing *)
1791
1792
let test_cookie_header_parsing_basic env =
1793
let clock = Eio.Stdenv.clock env in
1794
+
let result =
1795
of_cookie_header
1796
~now:(fun () ->
1797
Ptime.of_float_s (Eio.Time.now clock)
···
1799
~domain:"ex.com" ~path:"/" "session=abc123; theme=dark; lang=en"
1800
in
1801
1802
+
match result with
1803
+
| Error msg -> Alcotest.fail ("Parse failed: " ^ msg)
1804
+
| Ok cookies ->
1805
+
Alcotest.(check int) "parsed 3 cookies" 3 (List.length cookies);
1806
1807
+
let find name_val = List.find (fun c -> name c = name_val) cookies in
1808
+
Alcotest.(check string) "session value" "abc123" (value (find "session"));
1809
+
Alcotest.(check string) "theme value" "dark" (value (find "theme"));
1810
+
Alcotest.(check string) "lang value" "en" (value (find "lang"))
1811
1812
let test_cookie_header_defaults env =
1813
let clock = Eio.Stdenv.clock env in
···
1819
|> Option.value ~default:Ptime.epoch)
1820
~domain:"example.com" ~path:"/app" "session=xyz"
1821
with
1822
+
| Ok [ c ] ->
1823
(* Domain and path from request context *)
1824
Alcotest.(check string) "domain from context" "example.com" (domain c);
1825
Alcotest.(check string) "path from context" "/app" (path c);
···
1835
Alcotest.(check (option span_testable)) "no max_age" None (max_age c);
1836
Alcotest.(check (option same_site_testable))
1837
"no same_site" None (same_site c)
1838
+
| Ok _ -> Alcotest.fail "Should parse single cookie"
1839
+
| Error msg -> Alcotest.fail ("Parse failed: " ^ msg)
1840
1841
let test_cookie_header_edge_cases env =
1842
let clock = Eio.Stdenv.clock env in
1843
1844
let test input expected_count description =
1845
+
let result =
1846
of_cookie_header
1847
~now:(fun () ->
1848
Ptime.of_float_s (Eio.Time.now clock)
1849
|> Option.value ~default:Ptime.epoch)
1850
~domain:"ex.com" ~path:"/" input
1851
in
1852
+
match result with
1853
+
| Ok cookies ->
1854
+
Alcotest.(check int) description expected_count (List.length cookies)
1855
+
| Error msg ->
1856
+
Alcotest.fail (description ^ " failed: " ^ msg)
1857
in
1858
1859
test "" 0 "empty string";
···
1865
let test_cookie_header_with_errors env =
1866
let clock = Eio.Stdenv.clock env in
1867
1868
+
(* Invalid cookie (empty name) should cause entire parse to fail *)
1869
+
let result =
1870
of_cookie_header
1871
~now:(fun () ->
1872
Ptime.of_float_s (Eio.Time.now clock)
···
1874
~domain:"ex.com" ~path:"/" "valid=1;=noname;valid2=2"
1875
in
1876
1877
+
(* Error should have descriptive message about the invalid cookie *)
1878
let contains_substring s sub =
1879
try
1880
let _ = Str.search_forward (Str.regexp_string sub) s 0 in
1881
true
1882
with Not_found -> false
1883
in
1884
+
match result with
1885
| Error msg ->
1886
let has_name = contains_substring msg "name" in
1887
let has_empty = contains_substring msg "empty" in
1888
Alcotest.(check bool)
1889
"error mentions name or empty" true (has_name || has_empty)
1890
+
| Ok _ -> Alcotest.fail "Expected error for empty cookie name"
1891
1892
(* Max-Age and Expires Interaction *)
1893
···
1946
~domain:"ex.com" ~path:"/"
1947
"id=123; Max-Age=3600; Expires=Wed, 21 Oct 2025 07:28:00 GMT"
1948
with
1949
+
| Ok c ->
1950
(* Both should be stored *)
1951
begin match max_age c with
1952
| Some span -> begin
···
1962
| Some (`DateTime _) -> ()
1963
| _ -> Alcotest.fail "expires should be parsed"
1964
end
1965
+
| Error msg -> Alcotest.fail ("Should parse cookie with both attributes: " ^ msg)
1966
1967
(* ============================================================================ *)
1968
(* Host-Only Flag Tests (RFC 6265 Section 5.3) *)
···
1982
|> Option.value ~default:Ptime.epoch)
1983
~domain:"example.com" ~path:"/" header
1984
in
1985
+
Alcotest.(check bool) "cookie parsed" true (Result.is_ok cookie_opt);
1986
+
let cookie = Result.get_ok cookie_opt in
1987
Alcotest.(check bool) "host_only is true" true (Cookeio.host_only cookie);
1988
Alcotest.(check string) "domain is request host" "example.com" (Cookeio.domain cookie)
1989
···
2001
|> Option.value ~default:Ptime.epoch)
2002
~domain:"example.com" ~path:"/" header
2003
in
2004
+
Alcotest.(check bool) "cookie parsed" true (Result.is_ok cookie_opt);
2005
+
let cookie = Result.get_ok cookie_opt in
2006
Alcotest.(check bool) "host_only is false" false (Cookeio.host_only cookie);
2007
Alcotest.(check string) "domain is attribute value" "example.com" (Cookeio.domain cookie)
2008
···
2020
|> Option.value ~default:Ptime.epoch)
2021
~domain:"example.com" ~path:"/" header
2022
in
2023
+
Alcotest.(check bool) "cookie parsed" true (Result.is_ok cookie_opt);
2024
+
let cookie = Result.get_ok cookie_opt in
2025
Alcotest.(check bool) "host_only is false" false (Cookeio.host_only cookie);
2026
Alcotest.(check string) "domain normalized" "example.com" (Cookeio.domain cookie)
2027
···
2070
Eio_mock.Clock.set_time clock 1000.0;
2071
2072
(* Cookies from Cookie header should have host_only=true *)
2073
+
let result =
2074
of_cookie_header
2075
~now:(fun () ->
2076
Ptime.of_float_s (Eio.Time.now clock)
2077
|> Option.value ~default:Ptime.epoch)
2078
~domain:"example.com" ~path:"/" "session=abc; theme=dark"
2079
in
2080
+
match result with
2081
+
| Error msg -> Alcotest.fail ("Parse failed: " ^ msg)
2082
+
| Ok cookies ->
2083
+
Alcotest.(check int) "parsed 2 cookies" 2 (List.length cookies);
2084
+
List.iter (fun c ->
2085
+
Alcotest.(check bool)
2086
+
("host_only is true for " ^ Cookeio.name c)
2087
+
true (Cookeio.host_only c)
2088
+
) cookies
2089
2090
let test_host_only_mozilla_format_round_trip () =
2091
Eio_mock.Backend.run @@ fun () ->
···
2288
Alcotest.(check int) "/foo/bar does NOT match /baz" 0 (List.length cookies3)
2289
2290
(* ============================================================================ *)
2291
+
(* Cookie Ordering Tests (RFC 6265 Section 5.4, Step 2) *)
2292
+
(* ============================================================================ *)
2293
+
2294
+
let test_cookie_ordering_by_path_length () =
2295
+
Eio_mock.Backend.run @@ fun () ->
2296
+
let clock = Eio_mock.Clock.make () in
2297
+
Eio_mock.Clock.set_time clock 1000.0;
2298
+
2299
+
let jar = create () in
2300
+
2301
+
(* Add cookies with different path lengths, but same creation time *)
2302
+
let cookie_short =
2303
+
Cookeio.make ~domain:"example.com" ~path:"/" ~name:"short" ~value:"v1"
2304
+
~secure:false ~http_only:false
2305
+
~creation_time:(Ptime.of_float_s 1000.0 |> Option.get)
2306
+
~last_access:(Ptime.of_float_s 1000.0 |> Option.get) ()
2307
+
in
2308
+
let cookie_medium =
2309
+
Cookeio.make ~domain:"example.com" ~path:"/foo" ~name:"medium" ~value:"v2"
2310
+
~secure:false ~http_only:false
2311
+
~creation_time:(Ptime.of_float_s 1000.0 |> Option.get)
2312
+
~last_access:(Ptime.of_float_s 1000.0 |> Option.get) ()
2313
+
in
2314
+
let cookie_long =
2315
+
Cookeio.make ~domain:"example.com" ~path:"/foo/bar" ~name:"long" ~value:"v3"
2316
+
~secure:false ~http_only:false
2317
+
~creation_time:(Ptime.of_float_s 1000.0 |> Option.get)
2318
+
~last_access:(Ptime.of_float_s 1000.0 |> Option.get) ()
2319
+
in
2320
+
2321
+
(* Add in random order *)
2322
+
add_cookie jar cookie_short;
2323
+
add_cookie jar cookie_long;
2324
+
add_cookie jar cookie_medium;
2325
+
2326
+
(* Get cookies for path /foo/bar/baz - all three should match *)
2327
+
let cookies =
2328
+
get_cookies jar ~clock ~domain:"example.com" ~path:"/foo/bar/baz" ~is_secure:false
2329
+
in
2330
+
2331
+
Alcotest.(check int) "all 3 cookies match" 3 (List.length cookies);
2332
+
2333
+
(* Verify order: longest path first *)
2334
+
let names = List.map Cookeio.name cookies in
2335
+
Alcotest.(check (list string))
2336
+
"cookies ordered by path length (longest first)"
2337
+
[ "long"; "medium"; "short" ]
2338
+
names
2339
+
2340
+
let test_cookie_ordering_by_creation_time () =
2341
+
Eio_mock.Backend.run @@ fun () ->
2342
+
let clock = Eio_mock.Clock.make () in
2343
+
Eio_mock.Clock.set_time clock 2000.0;
2344
+
2345
+
let jar = create () in
2346
+
2347
+
(* Add cookies with same path but different creation times *)
2348
+
let cookie_new =
2349
+
Cookeio.make ~domain:"example.com" ~path:"/" ~name:"new" ~value:"v1"
2350
+
~secure:false ~http_only:false
2351
+
~creation_time:(Ptime.of_float_s 1500.0 |> Option.get)
2352
+
~last_access:(Ptime.of_float_s 1500.0 |> Option.get) ()
2353
+
in
2354
+
let cookie_old =
2355
+
Cookeio.make ~domain:"example.com" ~path:"/" ~name:"old" ~value:"v2"
2356
+
~secure:false ~http_only:false
2357
+
~creation_time:(Ptime.of_float_s 1000.0 |> Option.get)
2358
+
~last_access:(Ptime.of_float_s 1000.0 |> Option.get) ()
2359
+
in
2360
+
let cookie_middle =
2361
+
Cookeio.make ~domain:"example.com" ~path:"/" ~name:"middle" ~value:"v3"
2362
+
~secure:false ~http_only:false
2363
+
~creation_time:(Ptime.of_float_s 1200.0 |> Option.get)
2364
+
~last_access:(Ptime.of_float_s 1200.0 |> Option.get) ()
2365
+
in
2366
+
2367
+
(* Add in random order *)
2368
+
add_cookie jar cookie_new;
2369
+
add_cookie jar cookie_old;
2370
+
add_cookie jar cookie_middle;
2371
+
2372
+
let cookies =
2373
+
get_cookies jar ~clock ~domain:"example.com" ~path:"/" ~is_secure:false
2374
+
in
2375
+
2376
+
Alcotest.(check int) "all 3 cookies match" 3 (List.length cookies);
2377
+
2378
+
(* Verify order: earlier creation time first (for same path length) *)
2379
+
let names = List.map Cookeio.name cookies in
2380
+
Alcotest.(check (list string))
2381
+
"cookies ordered by creation time (earliest first)"
2382
+
[ "old"; "middle"; "new" ]
2383
+
names
2384
+
2385
+
let test_cookie_ordering_combined () =
2386
+
Eio_mock.Backend.run @@ fun () ->
2387
+
let clock = Eio_mock.Clock.make () in
2388
+
Eio_mock.Clock.set_time clock 2000.0;
2389
+
2390
+
let jar = create () in
2391
+
2392
+
(* Mix of different paths and creation times *)
2393
+
let cookie_a =
2394
+
Cookeio.make ~domain:"example.com" ~path:"/foo" ~name:"a" ~value:"v1"
2395
+
~secure:false ~http_only:false
2396
+
~creation_time:(Ptime.of_float_s 1500.0 |> Option.get)
2397
+
~last_access:(Ptime.of_float_s 1500.0 |> Option.get) ()
2398
+
in
2399
+
let cookie_b =
2400
+
Cookeio.make ~domain:"example.com" ~path:"/foo" ~name:"b" ~value:"v2"
2401
+
~secure:false ~http_only:false
2402
+
~creation_time:(Ptime.of_float_s 1000.0 |> Option.get)
2403
+
~last_access:(Ptime.of_float_s 1000.0 |> Option.get) ()
2404
+
in
2405
+
let cookie_c =
2406
+
Cookeio.make ~domain:"example.com" ~path:"/" ~name:"c" ~value:"v3"
2407
+
~secure:false ~http_only:false
2408
+
~creation_time:(Ptime.of_float_s 500.0 |> Option.get)
2409
+
~last_access:(Ptime.of_float_s 500.0 |> Option.get) ()
2410
+
in
2411
+
2412
+
add_cookie jar cookie_a;
2413
+
add_cookie jar cookie_c;
2414
+
add_cookie jar cookie_b;
2415
+
2416
+
let cookies =
2417
+
get_cookies jar ~clock ~domain:"example.com" ~path:"/foo/bar" ~is_secure:false
2418
+
in
2419
+
2420
+
Alcotest.(check int) "all 3 cookies match" 3 (List.length cookies);
2421
+
2422
+
(* /foo cookies (length 4) should come before / cookie (length 1)
2423
+
Within /foo, earlier creation time (b=1000) should come before (a=1500) *)
2424
+
let names = List.map Cookeio.name cookies in
2425
+
Alcotest.(check (list string))
2426
+
"cookies ordered by path length then creation time"
2427
+
[ "b"; "a"; "c" ]
2428
+
names
2429
+
2430
+
(* ============================================================================ *)
2431
+
(* Creation Time Preservation Tests (RFC 6265 Section 5.3, Step 11.3) *)
2432
+
(* ============================================================================ *)
2433
+
2434
+
let test_creation_time_preserved_on_update () =
2435
+
Eio_mock.Backend.run @@ fun () ->
2436
+
let clock = Eio_mock.Clock.make () in
2437
+
Eio_mock.Clock.set_time clock 1000.0;
2438
+
2439
+
let jar = create () in
2440
+
2441
+
(* Add initial cookie with creation_time=500 *)
2442
+
let original_creation = Ptime.of_float_s 500.0 |> Option.get in
2443
+
let cookie_v1 =
2444
+
Cookeio.make ~domain:"example.com" ~path:"/" ~name:"session" ~value:"v1"
2445
+
~secure:false ~http_only:false
2446
+
~creation_time:original_creation
2447
+
~last_access:(Ptime.of_float_s 500.0 |> Option.get) ()
2448
+
in
2449
+
add_cookie jar cookie_v1;
2450
+
2451
+
(* Update the cookie with a new value (creation_time=1000) *)
2452
+
Eio_mock.Clock.set_time clock 1500.0;
2453
+
let cookie_v2 =
2454
+
Cookeio.make ~domain:"example.com" ~path:"/" ~name:"session" ~value:"v2"
2455
+
~secure:false ~http_only:false
2456
+
~creation_time:(Ptime.of_float_s 1500.0 |> Option.get)
2457
+
~last_access:(Ptime.of_float_s 1500.0 |> Option.get) ()
2458
+
in
2459
+
add_cookie jar cookie_v2;
2460
+
2461
+
(* Get the cookie and verify creation_time was preserved *)
2462
+
let cookies =
2463
+
get_cookies jar ~clock ~domain:"example.com" ~path:"/" ~is_secure:false
2464
+
in
2465
+
Alcotest.(check int) "still one cookie" 1 (List.length cookies);
2466
+
2467
+
let cookie = List.hd cookies in
2468
+
Alcotest.(check string) "value was updated" "v2" (Cookeio.value cookie);
2469
+
2470
+
(* Creation time should be preserved from original cookie *)
2471
+
let creation_float =
2472
+
Ptime.to_float_s (Cookeio.creation_time cookie)
2473
+
in
2474
+
Alcotest.(check (float 0.001))
2475
+
"creation_time preserved from original"
2476
+
500.0 creation_float
2477
+
2478
+
let test_creation_time_preserved_add_original () =
2479
+
Eio_mock.Backend.run @@ fun () ->
2480
+
let clock = Eio_mock.Clock.make () in
2481
+
Eio_mock.Clock.set_time clock 1000.0;
2482
+
2483
+
let jar = create () in
2484
+
2485
+
(* Add initial original cookie *)
2486
+
let original_creation = Ptime.of_float_s 100.0 |> Option.get in
2487
+
let cookie_v1 =
2488
+
Cookeio.make ~domain:"example.com" ~path:"/" ~name:"test" ~value:"v1"
2489
+
~secure:false ~http_only:false
2490
+
~creation_time:original_creation
2491
+
~last_access:(Ptime.of_float_s 100.0 |> Option.get) ()
2492
+
in
2493
+
add_original jar cookie_v1;
2494
+
2495
+
(* Replace with new original cookie *)
2496
+
let cookie_v2 =
2497
+
Cookeio.make ~domain:"example.com" ~path:"/" ~name:"test" ~value:"v2"
2498
+
~secure:false ~http_only:false
2499
+
~creation_time:(Ptime.of_float_s 1000.0 |> Option.get)
2500
+
~last_access:(Ptime.of_float_s 1000.0 |> Option.get) ()
2501
+
in
2502
+
add_original jar cookie_v2;
2503
+
2504
+
let cookies = get_all_cookies jar in
2505
+
Alcotest.(check int) "still one cookie" 1 (List.length cookies);
2506
+
2507
+
let cookie = List.hd cookies in
2508
+
Alcotest.(check string) "value was updated" "v2" (Cookeio.value cookie);
2509
+
2510
+
(* Creation time should be preserved *)
2511
+
let creation_float =
2512
+
Ptime.to_float_s (Cookeio.creation_time cookie)
2513
+
in
2514
+
Alcotest.(check (float 0.001))
2515
+
"creation_time preserved in add_original"
2516
+
100.0 creation_float
2517
+
2518
+
let test_creation_time_new_cookie () =
2519
+
Eio_mock.Backend.run @@ fun () ->
2520
+
let clock = Eio_mock.Clock.make () in
2521
+
Eio_mock.Clock.set_time clock 1000.0;
2522
+
2523
+
let jar = create () in
2524
+
2525
+
(* Add a new cookie (no existing cookie to preserve from) *)
2526
+
let cookie =
2527
+
Cookeio.make ~domain:"example.com" ~path:"/" ~name:"new" ~value:"v1"
2528
+
~secure:false ~http_only:false
2529
+
~creation_time:(Ptime.of_float_s 1000.0 |> Option.get)
2530
+
~last_access:(Ptime.of_float_s 1000.0 |> Option.get) ()
2531
+
in
2532
+
add_cookie jar cookie;
2533
+
2534
+
let cookies =
2535
+
get_cookies jar ~clock ~domain:"example.com" ~path:"/" ~is_secure:false
2536
+
in
2537
+
let cookie = List.hd cookies in
2538
+
2539
+
(* New cookie should keep its own creation time *)
2540
+
let creation_float =
2541
+
Ptime.to_float_s (Cookeio.creation_time cookie)
2542
+
in
2543
+
Alcotest.(check (float 0.001))
2544
+
"new cookie keeps its creation_time"
2545
+
1000.0 creation_float
2546
+
2547
+
(* ============================================================================ *)
2548
(* IP Address Domain Matching Tests (RFC 6265 Section 5.1.3) *)
2549
(* ============================================================================ *)
2550
···
2699
Alcotest.(check int) "IP matches IP cookie" 1 (List.length cookies3);
2700
Alcotest.(check string) "IP cookie is returned" "ip" (Cookeio.name (List.hd cookies3))
2701
2702
+
(* ============================================================================ *)
2703
+
(* RFC 6265 Validation Tests *)
2704
+
(* ============================================================================ *)
2705
+
2706
+
let test_validate_cookie_name_valid () =
2707
+
(* Valid token characters per RFC 2616 *)
2708
+
let valid_names = ["session"; "SID"; "my-cookie"; "COOKIE_123"; "abc.def"] in
2709
+
List.iter (fun name ->
2710
+
match Cookeio.Validate.cookie_name name with
2711
+
| Ok _ -> ()
2712
+
| Error msg ->
2713
+
Alcotest.fail (Printf.sprintf "Name %S should be valid: %s" name msg))
2714
+
valid_names
2715
+
2716
+
let test_validate_cookie_name_invalid () =
2717
+
(* Invalid: control chars, separators, spaces *)
2718
+
let invalid_names =
2719
+
[
2720
+
("", "empty");
2721
+
("my cookie", "space");
2722
+
("cookie=value", "equals");
2723
+
("my;cookie", "semicolon");
2724
+
("name\t", "tab");
2725
+
("(cookie)", "parens");
2726
+
("name,val", "comma");
2727
+
]
2728
+
in
2729
+
List.iter (fun (name, reason) ->
2730
+
match Cookeio.Validate.cookie_name name with
2731
+
| Error _ -> () (* Expected *)
2732
+
| Ok _ ->
2733
+
Alcotest.fail
2734
+
(Printf.sprintf "Name %S (%s) should be invalid" name reason))
2735
+
invalid_names
2736
+
2737
+
let test_validate_cookie_value_valid () =
2738
+
(* Valid cookie-octets or quoted values *)
2739
+
let valid_values = ["abc123"; "value!#$%&'()*+-./"; "\"quoted\""; ""] in
2740
+
List.iter (fun value ->
2741
+
match Cookeio.Validate.cookie_value value with
2742
+
| Ok _ -> ()
2743
+
| Error msg ->
2744
+
Alcotest.fail (Printf.sprintf "Value %S should be valid: %s" value msg))
2745
+
valid_values
2746
+
2747
+
let test_validate_cookie_value_invalid () =
2748
+
(* Invalid: space, comma, semicolon, backslash, unmatched quotes *)
2749
+
let invalid_values =
2750
+
[
2751
+
("with space", "space");
2752
+
("with,comma", "comma");
2753
+
("with;semi", "semicolon");
2754
+
("back\\slash", "backslash");
2755
+
("\"unmatched", "unmatched opening quote");
2756
+
("unmatched\"", "unmatched closing quote");
2757
+
]
2758
+
in
2759
+
List.iter (fun (value, reason) ->
2760
+
match Cookeio.Validate.cookie_value value with
2761
+
| Error _ -> () (* Expected *)
2762
+
| Ok _ ->
2763
+
Alcotest.fail
2764
+
(Printf.sprintf "Value %S (%s) should be invalid" value reason))
2765
+
invalid_values
2766
+
2767
+
let test_validate_domain_valid () =
2768
+
(* Valid domain names and IP addresses *)
2769
+
let valid_domains =
2770
+
["example.com"; "sub.example.com"; ".example.com"; "192.168.1.1"; "::1"]
2771
+
in
2772
+
List.iter (fun domain ->
2773
+
match Cookeio.Validate.domain_value domain with
2774
+
| Ok _ -> ()
2775
+
| Error msg ->
2776
+
Alcotest.fail (Printf.sprintf "Domain %S should be valid: %s" domain msg))
2777
+
valid_domains
2778
+
2779
+
let test_validate_domain_invalid () =
2780
+
(* Invalid domain names - only test cases that domain-name library rejects.
2781
+
Note: domain-name library has specific rules that may differ from what
2782
+
we might expect from the RFC. *)
2783
+
let invalid_domains =
2784
+
[
2785
+
("", "empty");
2786
+
(* Note: "-invalid.com" and "invalid-.com" are valid per domain-name library *)
2787
+
]
2788
+
in
2789
+
List.iter (fun (domain, reason) ->
2790
+
match Cookeio.Validate.domain_value domain with
2791
+
| Error _ -> () (* Expected *)
2792
+
| Ok _ ->
2793
+
Alcotest.fail
2794
+
(Printf.sprintf "Domain %S (%s) should be invalid" domain reason))
2795
+
invalid_domains
2796
+
2797
+
let test_validate_path_valid () =
2798
+
let valid_paths = ["/"; "/path"; "/path/to/resource"; "/path?query"] in
2799
+
List.iter (fun path ->
2800
+
match Cookeio.Validate.path_value path with
2801
+
| Ok _ -> ()
2802
+
| Error msg ->
2803
+
Alcotest.fail (Printf.sprintf "Path %S should be valid: %s" path msg))
2804
+
valid_paths
2805
+
2806
+
let test_validate_path_invalid () =
2807
+
let invalid_paths =
2808
+
[
2809
+
("/path;bad", "semicolon");
2810
+
("/path\x00bad", "control char");
2811
+
]
2812
+
in
2813
+
List.iter (fun (path, reason) ->
2814
+
match Cookeio.Validate.path_value path with
2815
+
| Error _ -> () (* Expected *)
2816
+
| Ok _ ->
2817
+
Alcotest.fail
2818
+
(Printf.sprintf "Path %S (%s) should be invalid" path reason))
2819
+
invalid_paths
2820
+
2821
+
let test_duplicate_cookie_detection () =
2822
+
Eio_mock.Backend.run @@ fun () ->
2823
+
let clock = Eio_mock.Clock.make () in
2824
+
Eio_mock.Clock.set_time clock 1000.0;
2825
+
2826
+
(* Duplicate cookie names should be rejected *)
2827
+
let result =
2828
+
of_cookie_header
2829
+
~now:(fun () ->
2830
+
Ptime.of_float_s (Eio.Time.now clock)
2831
+
|> Option.value ~default:Ptime.epoch)
2832
+
~domain:"example.com" ~path:"/" "session=abc; theme=dark; session=xyz"
2833
+
in
2834
+
match result with
2835
+
| Error msg ->
2836
+
(* Should mention duplicate *)
2837
+
let contains_dup = String.lowercase_ascii msg |> fun s ->
2838
+
try let _ = Str.search_forward (Str.regexp_string "duplicate") s 0 in true
2839
+
with Not_found -> false
2840
+
in
2841
+
Alcotest.(check bool) "error mentions duplicate" true contains_dup
2842
+
| Ok _ -> Alcotest.fail "Should reject duplicate cookie names"
2843
+
2844
+
let test_validation_error_messages () =
2845
+
Eio_mock.Backend.run @@ fun () ->
2846
+
let clock = Eio_mock.Clock.make () in
2847
+
Eio_mock.Clock.set_time clock 1000.0;
2848
+
2849
+
(* Test that error messages are descriptive *)
2850
+
let test_cases =
2851
+
[
2852
+
("=noname", "Cookie name is empty");
2853
+
("bad cookie=value", "invalid characters");
2854
+
("name=val ue", "invalid characters");
2855
+
]
2856
+
in
2857
+
List.iter (fun (header, expected_substring) ->
2858
+
match
2859
+
of_set_cookie_header
2860
+
~now:(fun () ->
2861
+
Ptime.of_float_s (Eio.Time.now clock)
2862
+
|> Option.value ~default:Ptime.epoch)
2863
+
~domain:"example.com" ~path:"/" header
2864
+
with
2865
+
| Error msg ->
2866
+
let has_substring =
2867
+
try
2868
+
let _ = Str.search_forward
2869
+
(Str.regexp_string expected_substring) msg 0 in
2870
+
true
2871
+
with Not_found -> false
2872
+
in
2873
+
Alcotest.(check bool)
2874
+
(Printf.sprintf "error for %S mentions %S" header expected_substring)
2875
+
true has_substring
2876
+
| Ok _ ->
2877
+
Alcotest.fail (Printf.sprintf "Should reject %S" header))
2878
+
test_cases
2879
+
2880
+
(* ============================================================================ *)
2881
+
(* Public Suffix Validation Tests (RFC 6265 Section 5.3, Step 5) *)
2882
+
(* ============================================================================ *)
2883
+
2884
+
let test_public_suffix_rejection () =
2885
+
Eio_mock.Backend.run @@ fun () ->
2886
+
let clock = Eio_mock.Clock.make () in
2887
+
Eio_mock.Clock.set_time clock 1000.0;
2888
+
2889
+
(* Setting a cookie for a public suffix (TLD) should be rejected *)
2890
+
let test_cases =
2891
+
[
2892
+
(* (request_domain, cookie_domain, description) *)
2893
+
("www.example.com", "com", "TLD .com");
2894
+
("www.example.co.uk", "co.uk", "ccTLD .co.uk");
2895
+
("foo.bar.github.io", "github.io", "private domain github.io");
2896
+
]
2897
+
in
2898
+
2899
+
List.iter
2900
+
(fun (request_domain, cookie_domain, description) ->
2901
+
let header = Printf.sprintf "session=abc; Domain=.%s" cookie_domain in
2902
+
let result =
2903
+
of_set_cookie_header
2904
+
~now:(fun () ->
2905
+
Ptime.of_float_s (Eio.Time.now clock)
2906
+
|> Option.value ~default:Ptime.epoch)
2907
+
~domain:request_domain ~path:"/" header
2908
+
in
2909
+
match result with
2910
+
| Error msg ->
2911
+
(* Should mention public suffix *)
2912
+
let has_psl =
2913
+
String.lowercase_ascii msg |> fun s ->
2914
+
try
2915
+
let _ = Str.search_forward (Str.regexp_string "public suffix") s 0 in
2916
+
true
2917
+
with Not_found -> false
2918
+
in
2919
+
Alcotest.(check bool)
2920
+
(Printf.sprintf "%s: error mentions public suffix" description)
2921
+
true has_psl
2922
+
| Ok _ ->
2923
+
Alcotest.fail
2924
+
(Printf.sprintf "Should reject cookie for %s" description))
2925
+
test_cases
2926
+
2927
+
let test_public_suffix_allowed_when_exact_match () =
2928
+
Eio_mock.Backend.run @@ fun () ->
2929
+
let clock = Eio_mock.Clock.make () in
2930
+
Eio_mock.Clock.set_time clock 1000.0;
2931
+
2932
+
(* If request host exactly matches the public suffix domain, allow it.
2933
+
This is rare but possible for private domains like blogspot.com *)
2934
+
let header = "session=abc; Domain=.blogspot.com" in
2935
+
let result =
2936
+
of_set_cookie_header
2937
+
~now:(fun () ->
2938
+
Ptime.of_float_s (Eio.Time.now clock)
2939
+
|> Option.value ~default:Ptime.epoch)
2940
+
~domain:"blogspot.com" ~path:"/" header
2941
+
in
2942
+
Alcotest.(check bool)
2943
+
"exact match allows public suffix" true
2944
+
(Result.is_ok result)
2945
+
2946
+
let test_non_public_suffix_allowed () =
2947
+
Eio_mock.Backend.run @@ fun () ->
2948
+
let clock = Eio_mock.Clock.make () in
2949
+
Eio_mock.Clock.set_time clock 1000.0;
2950
+
2951
+
(* Normal domain (not a public suffix) should be allowed *)
2952
+
let test_cases =
2953
+
[
2954
+
("www.example.com", "example.com", "registrable domain");
2955
+
("sub.example.com", "example.com", "parent of subdomain");
2956
+
("www.example.co.uk", "example.co.uk", "registrable domain under ccTLD");
2957
+
]
2958
+
in
2959
+
2960
+
List.iter
2961
+
(fun (request_domain, cookie_domain, description) ->
2962
+
let header = Printf.sprintf "session=abc; Domain=.%s" cookie_domain in
2963
+
let result =
2964
+
of_set_cookie_header
2965
+
~now:(fun () ->
2966
+
Ptime.of_float_s (Eio.Time.now clock)
2967
+
|> Option.value ~default:Ptime.epoch)
2968
+
~domain:request_domain ~path:"/" header
2969
+
in
2970
+
match result with
2971
+
| Ok cookie ->
2972
+
Alcotest.(check string)
2973
+
(Printf.sprintf "%s: domain correct" description)
2974
+
cookie_domain (Cookeio.domain cookie)
2975
+
| Error msg ->
2976
+
Alcotest.fail
2977
+
(Printf.sprintf "%s should be allowed: %s" description msg))
2978
+
test_cases
2979
+
2980
+
let test_public_suffix_no_domain_attribute () =
2981
+
Eio_mock.Backend.run @@ fun () ->
2982
+
let clock = Eio_mock.Clock.make () in
2983
+
Eio_mock.Clock.set_time clock 1000.0;
2984
+
2985
+
(* Cookie without Domain attribute should always be allowed (host-only) *)
2986
+
let header = "session=abc; Secure; HttpOnly" in
2987
+
let result =
2988
+
of_set_cookie_header
2989
+
~now:(fun () ->
2990
+
Ptime.of_float_s (Eio.Time.now clock)
2991
+
|> Option.value ~default:Ptime.epoch)
2992
+
~domain:"www.example.com" ~path:"/" header
2993
+
in
2994
+
match result with
2995
+
| Ok cookie ->
2996
+
Alcotest.(check bool) "host_only is true" true (Cookeio.host_only cookie);
2997
+
Alcotest.(check string)
2998
+
"domain is request domain" "www.example.com"
2999
+
(Cookeio.domain cookie)
3000
+
| Error msg -> Alcotest.fail ("Should allow host-only cookie: " ^ msg)
3001
+
3002
+
let test_public_suffix_ip_address_bypass () =
3003
+
Eio_mock.Backend.run @@ fun () ->
3004
+
let clock = Eio_mock.Clock.make () in
3005
+
Eio_mock.Clock.set_time clock 1000.0;
3006
+
3007
+
(* IP addresses should bypass PSL check *)
3008
+
let header = "session=abc; Domain=192.168.1.1" in
3009
+
let result =
3010
+
of_set_cookie_header
3011
+
~now:(fun () ->
3012
+
Ptime.of_float_s (Eio.Time.now clock)
3013
+
|> Option.value ~default:Ptime.epoch)
3014
+
~domain:"192.168.1.1" ~path:"/" header
3015
+
in
3016
+
Alcotest.(check bool)
3017
+
"IP address bypasses PSL" true
3018
+
(Result.is_ok result)
3019
+
3020
+
let test_public_suffix_case_insensitive () =
3021
+
Eio_mock.Backend.run @@ fun () ->
3022
+
let clock = Eio_mock.Clock.make () in
3023
+
Eio_mock.Clock.set_time clock 1000.0;
3024
+
3025
+
(* Public suffix check should be case-insensitive *)
3026
+
let header = "session=abc; Domain=.COM" in
3027
+
let result =
3028
+
of_set_cookie_header
3029
+
~now:(fun () ->
3030
+
Ptime.of_float_s (Eio.Time.now clock)
3031
+
|> Option.value ~default:Ptime.epoch)
3032
+
~domain:"www.example.COM" ~path:"/" header
3033
+
in
3034
+
Alcotest.(check bool)
3035
+
"uppercase TLD still rejected" true
3036
+
(Result.is_error result)
3037
+
3038
let () =
3039
Eio_main.run @@ fun env ->
3040
let open Alcotest in
···
3062
[
3063
test_case "Cookie expiry with mock clock" `Quick
3064
test_cookie_expiry_with_mock_clock;
3065
+
test_case "get_cookies filters expired cookies" `Quick
3066
+
test_get_cookies_filters_expired;
3067
test_case "Max-Age parsing with mock clock" `Quick
3068
test_max_age_parsing_with_mock_clock;
3069
test_case "Last access time with mock clock" `Quick
···
3206
test_case "IPv6 exact match" `Quick test_ipv6_exact_match;
3207
test_case "IPv6 full format" `Quick test_ipv6_full_format;
3208
test_case "IP vs hostname behavior" `Quick test_ip_vs_hostname;
3209
+
] );
3210
+
( "rfc6265_validation",
3211
+
[
3212
+
test_case "valid cookie names" `Quick test_validate_cookie_name_valid;
3213
+
test_case "invalid cookie names" `Quick test_validate_cookie_name_invalid;
3214
+
test_case "valid cookie values" `Quick test_validate_cookie_value_valid;
3215
+
test_case "invalid cookie values" `Quick test_validate_cookie_value_invalid;
3216
+
test_case "valid domain values" `Quick test_validate_domain_valid;
3217
+
test_case "invalid domain values" `Quick test_validate_domain_invalid;
3218
+
test_case "valid path values" `Quick test_validate_path_valid;
3219
+
test_case "invalid path values" `Quick test_validate_path_invalid;
3220
+
test_case "duplicate cookie detection" `Quick test_duplicate_cookie_detection;
3221
+
test_case "validation error messages" `Quick test_validation_error_messages;
3222
+
] );
3223
+
( "cookie_ordering",
3224
+
[
3225
+
test_case "ordering by path length" `Quick
3226
+
test_cookie_ordering_by_path_length;
3227
+
test_case "ordering by creation time" `Quick
3228
+
test_cookie_ordering_by_creation_time;
3229
+
test_case "ordering combined" `Quick test_cookie_ordering_combined;
3230
+
] );
3231
+
( "creation_time_preservation",
3232
+
[
3233
+
test_case "preserved on update" `Quick
3234
+
test_creation_time_preserved_on_update;
3235
+
test_case "preserved in add_original" `Quick
3236
+
test_creation_time_preserved_add_original;
3237
+
test_case "new cookie keeps time" `Quick test_creation_time_new_cookie;
3238
+
] );
3239
+
( "public_suffix_validation",
3240
+
[
3241
+
test_case "reject public suffix domains" `Quick
3242
+
test_public_suffix_rejection;
3243
+
test_case "allow exact match on public suffix" `Quick
3244
+
test_public_suffix_allowed_when_exact_match;
3245
+
test_case "allow non-public-suffix domains" `Quick
3246
+
test_non_public_suffix_allowed;
3247
+
test_case "no Domain attribute bypasses PSL" `Quick
3248
+
test_public_suffix_no_domain_attribute;
3249
+
test_case "IP address bypasses PSL" `Quick
3250
+
test_public_suffix_ip_address_bypass;
3251
+
test_case "case insensitive check" `Quick
3252
+
test_public_suffix_case_insensitive;
3253
] );
3254
]