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
6
7
7
### 1. Public Suffix Validation (Section 5.3, Step 5)
8
8
9
-
**Status:** Not implemented
9
+
**Status:** ✅ IMPLEMENTED
10
10
11
11
The RFC requires rejecting cookies with domains that are "public suffixes" (e.g., `.com`, `.co.uk`) to prevent domain-wide cookie attacks.
12
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)
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
16
20
17
-
**Security impact:** Without this, an attacker on `evil.com` could potentially set cookies for `.com` affecting all `.com` sites.
21
+
**Security impact:** Prevents attackers from setting domain-wide cookies that would affect all sites under a TLD.
18
22
19
23
---
20
24
···
49
53
50
54
### 4. Cookie Ordering in Header (Section 5.4, Step 2)
51
55
52
-
**Status:** Not implemented
56
+
**Status:** ✅ IMPLEMENTED
53
57
54
-
When generating Cookie headers, cookies SHOULD be sorted:
58
+
When generating Cookie headers, cookies are sorted:
55
59
1. Cookies with longer paths listed first
56
60
2. Among equal-length paths, earlier creation-times listed first
57
61
58
-
**Location:** `get_cookies` function in `cookeio_jar.ml`
62
+
**Implementation:** `get_cookies` function in `cookeio_jar.ml` uses `compare_cookie_order` to sort cookies before returning them.
59
63
60
64
---
61
65
62
66
### 5. Creation Time Preservation (Section 5.3, Step 11.3)
63
67
64
-
**Status:** Not implemented
68
+
**Status:** ✅ IMPLEMENTED
65
69
66
-
When replacing an existing cookie (same name/domain/path), the creation-time of the old cookie should be preserved.
70
+
When replacing an existing cookie (same name/domain/path), the creation-time of the old cookie is preserved.
67
71
68
-
**Current behavior:** Completely replaces cookie, losing original creation time.
69
-
70
-
**Location:** `add_cookie` and `add_original` functions in `cookeio_jar.ml`
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.
71
73
72
74
---
73
75
···
145
147
- [x] Host-only flag for domain matching (Section 5.3, Step 6)
146
148
- [x] Path matching algorithm (Section 5.1.4)
147
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)
148
153
149
154
---
150
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
107
last_access;
108
108
}
109
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
+
110
385
(** {1 Cookie Parsing Helpers} *)
111
386
112
387
(** Normalize a domain by stripping the leading dot.
···
393
668
(** Parse a Set-Cookie HTTP response header.
394
669
395
670
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.
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.
398
673
399
674
@param now Function returning current time for Max-Age computation
400
675
@param domain The request host (used as default domain)
401
676
@param path The request path (used as default path)
402
677
@param header_value The Set-Cookie header value string
403
-
@return The parsed cookie, or [None] if parsing/validation fails
678
+
@return [Ok cookie] if parsing succeeds, [Error msg] with explanation if invalid
404
679
405
680
@see <https://datatracker.ietf.org/doc/html/rfc6265#section-5.2> RFC 6265 Section 5.2 - The Set-Cookie Header *)
406
681
let of_set_cookie_header ~now ~domain:request_domain ~path:request_path
···
411
686
let parts = String.split_on_char ';' header_value |> List.map String.trim in
412
687
413
688
match parts with
414
-
| [] -> None
689
+
| [] -> Error "Empty Set-Cookie header"
415
690
| name_value :: attrs -> (
416
691
(* Parse name=value *)
417
692
match String.index_opt name_value '=' with
418
-
| None -> None
419
-
| Some eq_pos ->
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 -> (
420
699
let name = String.sub name_value 0 eq_pos |> String.trim in
421
700
let cookie_value =
422
701
String.sub name_value (eq_pos + 1)
···
424
703
|> String.trim
425
704
in
426
705
427
-
let current_time = now () in
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
428
715
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;
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;
445
754
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)
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))))
457
783
458
784
(** Parse a Cookie HTTP request header.
459
785
460
786
Parses the header according to {{:https://datatracker.ietf.org/doc/html/rfc6265#section-4.2} RFC 6265 Section 4.2}.
461
787
The Cookie header contains semicolon-separated name=value pairs.
462
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
+
463
792
Cookies parsed from the Cookie header have [host_only = true] since we
464
793
cannot determine from the header alone whether they originally had a
465
794
Domain attribute.
···
468
797
@param domain The request host (assigned to all parsed cookies)
469
798
@param path The request path (assigned to all parsed cookies)
470
799
@param header_value The Cookie header value string
471
-
@return List of parse results (Ok cookie or Error message)
800
+
@return [Ok cookies] if all cookies parse successfully with no duplicates,
801
+
[Error msg] with explanation if validation fails
472
802
473
803
@see <https://datatracker.ietf.org/doc/html/rfc6265#section-4.2> RFC 6265 Section 4.2 - The Cookie Header *)
474
804
let of_cookie_header ~now ~domain ~path header_value =
···
480
810
(* Filter out empty parts *)
481
811
let parts = List.filter (fun s -> String.length s > 0) parts in
482
812
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
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)
509
867
510
868
(** Generate a Cookie HTTP request header from a list of cookies.
511
869
+113
-9
lib/core/cookeio.mli
+113
-9
lib/core/cookeio.mli
···
261
261
262
262
@see <https://datatracker.ietf.org/doc/html/rfc6265#section-5.3> RFC 6265 Section 5.3 - Storage Model *)
263
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
+
264
337
(** {1 Cookie Creation and Parsing} *)
265
338
266
339
val of_set_cookie_header :
267
-
now:(unit -> Ptime.t) -> domain:string -> path:string -> string -> t option
340
+
now:(unit -> Ptime.t) ->
341
+
domain:string ->
342
+
path:string ->
343
+
string ->
344
+
(t, string) result
268
345
(** Parse Set-Cookie response header value into a cookie.
269
346
270
347
Parses a Set-Cookie header following
···
272
349
- Basic format: [NAME=VALUE; attribute1; attribute2=value2]
273
350
- Supports all standard attributes: [expires], [max-age], [domain], [path],
274
351
[secure], [httponly], [samesite], [partitioned]
275
-
- Returns [None] if parsing fails or cookie validation fails
352
+
- Returns [Error msg] if parsing fails or cookie validation fails, with
353
+
a detailed explanation of what was invalid
276
354
- The [domain] and [path] parameters provide the request context for default
277
355
values
278
356
- The [now] parameter is used for calculating expiry times from [max-age]
279
357
attributes and setting creation/access times
280
358
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
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)
284
383
285
384
Example:
286
385
{[of_set_cookie_header ~now:(fun () -> Ptime_clock.now ())
287
386
~domain:"example.com" ~path:"/" "session=abc123; Secure; HttpOnly"]}
288
387
289
-
@see <https://datatracker.ietf.org/doc/html/rfc6265#section-5.2> RFC 6265 Section 5.2 - The Set-Cookie Header *)
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 *)
290
391
291
392
val of_cookie_header :
292
393
now:(unit -> Ptime.t) ->
293
394
domain:string ->
294
395
path:string ->
295
396
string ->
296
-
(t, string) result list
397
+
(t list, string) result
297
398
(** Parse Cookie request header containing semicolon-separated name=value pairs.
298
399
299
400
Parses a Cookie header following
···
301
402
Cookie headers contain only name=value pairs without attributes:
302
403
["name1=value1; name2=value2; name3=value3"]
303
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
+
304
408
Creates cookies with:
305
409
- Provided [domain] and [path] from request context
306
410
- All security flags set to [false] (defaults)
···
309
413
whether cookies originally had a Domain attribute)
310
414
- [creation_time] and [last_access] set to current time from [now]
311
415
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.
416
+
Returns [Ok cookies] if all cookies parse successfully with no duplicates,
417
+
or [Error msg] if any validation fails.
314
418
315
419
Example:
316
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
146
147
147
(** {1 Cookie Management} *)
148
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
+
149
183
let add_cookie jar cookie =
150
184
Log.debug (fun m ->
151
185
m "Adding cookie to delta: %s=%s for domain %s" (Cookeio.name cookie)
152
186
(Cookeio.value cookie) (Cookeio.domain cookie));
153
187
154
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
+
155
207
(* Remove existing cookie with same identity from delta *)
156
208
jar.delta_cookies <-
157
209
List.filter
···
166
218
(Cookeio.value cookie) (Cookeio.domain cookie));
167
219
168
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
+
169
232
(* Remove existing cookie with same identity from original *)
170
233
jar.original_cookies <-
171
234
List.filter
···
239
302
240
303
Eio.Mutex.unlock jar.mutex
241
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
+
242
322
(** Retrieve cookies that should be sent for a given request.
243
323
244
324
Per RFC 6265 Section 5.4, the user agent should include a Cookie header
245
325
containing cookies that match the request-uri's domain, path, and security
246
326
context. This function also updates the last-access-time for matched cookies.
247
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
+
248
332
@param jar The cookie jar to search
249
333
@param clock The Eio clock for timestamp updates
250
334
@param domain The request domain (hostname or IP address)
251
335
@param path The request path
252
336
@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
337
+
@return List of cookies that should be included in the Cookie header, sorted
254
338
255
339
@see <https://datatracker.ietf.org/doc/html/rfc6265#section-5.4> RFC 6265 Section 5.4 - The Cookie Header *)
256
340
let get_cookies jar ~clock ~domain:request_domain ~path:request_path ~is_secure
···
276
360
in
277
361
let unique_cookies = dedup [] all_cookies in
278
362
279
-
(* Filter for applicable cookies, excluding removal cookies (empty value) *)
363
+
(* Filter for applicable cookies, excluding removal cookies and expired cookies *)
280
364
let applicable =
281
365
List.filter
282
366
(fun cookie ->
283
367
Cookeio.value cookie <> ""
284
368
(* Exclude removal cookies *)
369
+
&& (not (is_expired cookie clock))
370
+
(* Exclude expired cookies *)
285
371
&& domain_matches ~host_only:(Cookeio.host_only cookie)
286
372
(Cookeio.domain cookie) request_domain
287
373
&& path_matches (Cookeio.path cookie) request_path
288
374
&& ((not (Cookeio.secure cookie)) || is_secure))
289
375
unique_cookies
290
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
291
382
292
383
(* Update last access time in both lists *)
293
384
let now =
···
313
404
314
405
Eio.Mutex.unlock jar.mutex;
315
406
316
-
Log.debug (fun m -> m "Found %d applicable cookies" (List.length applicable));
317
-
applicable
407
+
Log.debug (fun m -> m "Found %d applicable cookies" (List.length sorted));
408
+
sorted
318
409
319
410
let clear jar =
320
411
Log.info (fun m -> m "Clearing all cookies");
+30
-6
lib/jar/cookeio_jar.mli
+30
-6
lib/jar/cookeio_jar.mli
···
50
50
51
51
The cookie is added to the delta, meaning it will appear in Set-Cookie
52
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}. *)
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 *)
55
61
56
62
val add_original : t -> Cookeio.t -> unit
57
63
(** Add an original cookie to the jar.
58
64
59
65
Original cookies are those received from the client (via Cookie header).
60
66
They do not appear in the delta. This method should be used when loading
61
-
cookies from incoming HTTP requests. *)
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 *)
62
73
63
74
val delta : t -> Cookeio.t list
64
75
(** Get cookies that need to be sent in Set-Cookie headers.
···
92
103
93
104
Returns all cookies that match the given domain and path, and satisfy the
94
105
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.
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.
97
116
98
117
Domain matching follows {{:https://datatracker.ietf.org/doc/html/rfc6265#section-5.1.3} Section 5.1.3}:
99
118
- IP addresses require exact match only
···
101
120
102
121
Path matching follows {{:https://datatracker.ietf.org/doc/html/rfc6265#section-5.1.4} Section 5.1.4}.
103
122
123
+
@see <https://datatracker.ietf.org/doc/html/rfc6265#section-5.3> RFC 6265 Section 5.3 - Storage Model (expiry)
104
124
@see <https://datatracker.ietf.org/doc/html/rfc6265#section-5.4> RFC 6265 Section 5.4 - The Cookie Header *)
105
125
106
126
val clear : t -> unit
···
123
143
(** Get the number of unique cookies in the jar. *)
124
144
125
145
val get_all_cookies : t -> Cookeio.t list
126
-
(** Get all cookies in the jar. *)
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. *)
127
151
128
152
val is_empty : t -> bool
129
153
(** Check if the jar is empty. *)
+821
-101
test/test_cookeio.ml
+821
-101
test/test_cookeio.ml
···
379
379
"only session cookie remains" "session"
380
380
(Cookeio.name (List.hd remaining))
381
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
+
382
440
let test_max_age_parsing_with_mock_clock () =
383
441
Eio_mock.Backend.run @@ fun () ->
384
442
let clock = Eio_mock.Clock.make () in
···
396
454
~domain:"example.com" ~path:"/" header
397
455
in
398
456
399
-
Alcotest.(check bool) "cookie parsed" true (Option.is_some cookie_opt);
457
+
Alcotest.(check bool) "cookie parsed" true (Result.is_ok cookie_opt);
400
458
401
-
let cookie = Option.get cookie_opt in
459
+
let cookie = Result.get_ok cookie_opt in
402
460
Alcotest.(check string) "cookie name" "session" (Cookeio.name cookie);
403
461
Alcotest.(check string) "cookie value" "abc123" (Cookeio.value cookie);
404
462
Alcotest.(check bool) "cookie secure" true (Cookeio.secure cookie);
···
481
539
~domain:"example.com" ~path:"/" header
482
540
in
483
541
484
-
Alcotest.(check bool) "cookie parsed" true (Option.is_some cookie_opt);
542
+
Alcotest.(check bool) "cookie parsed" true (Result.is_ok cookie_opt);
485
543
486
-
let cookie = Option.get cookie_opt in
544
+
let cookie = Result.get_ok cookie_opt in
487
545
Alcotest.(check string) "cookie name" "id" (Cookeio.name cookie);
488
546
Alcotest.(check string) "cookie value" "xyz789" (Cookeio.value cookie);
489
547
Alcotest.(check string) "cookie domain" "example.com" (Cookeio.domain cookie);
···
523
581
524
582
Alcotest.(check bool)
525
583
"invalid cookie rejected" true
526
-
(Option.is_none cookie_opt);
584
+
(Result.is_error cookie_opt);
527
585
528
586
(* This should be accepted: SameSite=None with Secure *)
529
587
let valid_header = "token=abc; SameSite=None; Secure" in
···
537
595
538
596
Alcotest.(check bool)
539
597
"valid cookie accepted" true
540
-
(Option.is_some cookie_opt2);
598
+
(Result.is_ok cookie_opt2);
541
599
542
-
let cookie = Option.get cookie_opt2 in
600
+
let cookie = Result.get_ok cookie_opt2 in
543
601
Alcotest.(check bool) "cookie is secure" true (Cookeio.secure cookie);
544
602
Alcotest.(
545
603
check
···
566
624
|> Option.value ~default:Ptime.epoch)
567
625
~domain:"example.com" ~path:"/" header
568
626
in
569
-
Alcotest.(check bool) "cookie parsed" true (Option.is_some cookie_opt);
570
-
let cookie = Option.get cookie_opt in
627
+
Alcotest.(check bool) "cookie parsed" true (Result.is_ok cookie_opt);
628
+
let cookie = Result.get_ok cookie_opt in
571
629
Alcotest.(check string)
572
630
"domain normalized" "example.com" (Cookeio.domain cookie);
573
631
···
604
662
|> Option.value ~default:Ptime.epoch)
605
663
~domain:"example.com" ~path:"/" header
606
664
in
607
-
Alcotest.(check bool) "cookie parsed" true (Option.is_some cookie_opt);
665
+
Alcotest.(check bool) "cookie parsed" true (Result.is_ok cookie_opt);
608
666
609
-
let cookie = Option.get cookie_opt in
667
+
let cookie = Result.get_ok cookie_opt in
610
668
611
669
(* Verify max_age is stored as a Ptime.Span *)
612
670
Alcotest.(check bool)
···
642
700
|> Option.value ~default:Ptime.epoch)
643
701
~domain:"example.com" ~path:"/" header
644
702
in
645
-
Alcotest.(check bool) "cookie parsed" true (Option.is_some cookie_opt);
703
+
Alcotest.(check bool) "cookie parsed" true (Result.is_ok cookie_opt);
646
704
647
-
let cookie = Option.get cookie_opt in
705
+
let cookie = Result.get_ok cookie_opt in
648
706
649
707
(* Verify max_age is stored as 0 per RFC 6265 *)
650
708
Alcotest.(check bool)
···
732
790
|> Option.value ~default:Ptime.epoch)
733
791
~domain:"example.com" ~path:"/" header
734
792
in
735
-
Alcotest.(check bool) "cookie parsed" true (Option.is_some cookie_opt);
736
-
let cookie = Option.get cookie_opt in
793
+
Alcotest.(check bool) "cookie parsed" true (Result.is_ok cookie_opt);
794
+
let cookie = Result.get_ok cookie_opt in
737
795
738
796
(* Generate Set-Cookie header from the cookie *)
739
797
let set_cookie_header = make_set_cookie_header cookie in
···
748
806
|> Option.value ~default:Ptime.epoch)
749
807
~domain:"example.com" ~path:"/" set_cookie_header
750
808
in
751
-
Alcotest.(check bool) "cookie re-parsed" true (Option.is_some cookie2_opt);
752
-
let cookie2 = Option.get cookie2_opt in
809
+
Alcotest.(check bool) "cookie re-parsed" true (Result.is_ok cookie2_opt);
810
+
let cookie2 = Result.get_ok cookie2_opt in
753
811
754
812
(* Verify max_age is preserved *)
755
813
Alcotest.(check (option int))
···
821
879
|> Option.value ~default:Ptime.epoch)
822
880
~domain:"example.com" ~path:"/" header
823
881
in
824
-
Alcotest.(check bool) "FMT1 cookie parsed" true (Option.is_some cookie_opt);
882
+
Alcotest.(check bool) "FMT1 cookie parsed" true (Result.is_ok cookie_opt);
825
883
826
-
let cookie = Option.get cookie_opt in
884
+
let cookie = Result.get_ok cookie_opt in
827
885
Alcotest.(check bool)
828
886
"FMT1 has expiry" true
829
887
(Option.is_some (Cookeio.expires cookie));
···
853
911
|> Option.value ~default:Ptime.epoch)
854
912
~domain:"example.com" ~path:"/" header
855
913
in
856
-
Alcotest.(check bool) "FMT2 cookie parsed" true (Option.is_some cookie_opt);
914
+
Alcotest.(check bool) "FMT2 cookie parsed" true (Result.is_ok cookie_opt);
857
915
858
-
let cookie = Option.get cookie_opt in
916
+
let cookie = Result.get_ok cookie_opt in
859
917
Alcotest.(check bool)
860
918
"FMT2 has expiry" true
861
919
(Option.is_some (Cookeio.expires cookie));
···
885
943
|> Option.value ~default:Ptime.epoch)
886
944
~domain:"example.com" ~path:"/" header
887
945
in
888
-
Alcotest.(check bool) "FMT3 cookie parsed" true (Option.is_some cookie_opt);
946
+
Alcotest.(check bool) "FMT3 cookie parsed" true (Result.is_ok cookie_opt);
889
947
890
-
let cookie = Option.get cookie_opt in
948
+
let cookie = Result.get_ok cookie_opt in
891
949
Alcotest.(check bool)
892
950
"FMT3 has expiry" true
893
951
(Option.is_some (Cookeio.expires cookie));
···
916
974
|> Option.value ~default:Ptime.epoch)
917
975
~domain:"example.com" ~path:"/" header
918
976
in
919
-
Alcotest.(check bool) "FMT4 cookie parsed" true (Option.is_some cookie_opt);
977
+
Alcotest.(check bool) "FMT4 cookie parsed" true (Result.is_ok cookie_opt);
920
978
921
-
let cookie = Option.get cookie_opt in
979
+
let cookie = Result.get_ok cookie_opt in
922
980
Alcotest.(check bool)
923
981
"FMT4 has expiry" true
924
982
(Option.is_some (Cookeio.expires cookie));
···
947
1005
|> Option.value ~default:Ptime.epoch)
948
1006
~domain:"example.com" ~path:"/" header
949
1007
in
950
-
let cookie = Option.get cookie_opt in
1008
+
let cookie = Result.get_ok cookie_opt in
951
1009
let expected = Ptime.of_date_time ((1995, 10, 21), ((07, 28, 00), 0)) in
952
1010
begin match expected with
953
1011
| Some t ->
···
967
1025
|> Option.value ~default:Ptime.epoch)
968
1026
~domain:"example.com" ~path:"/" header2
969
1027
in
970
-
let cookie2 = Option.get cookie_opt2 in
1028
+
let cookie2 = Result.get_ok cookie_opt2 in
971
1029
let expected2 = Ptime.of_date_time ((1969, 9, 10), ((20, 0, 0), 0)) in
972
1030
begin match expected2 with
973
1031
| Some t ->
···
987
1045
|> Option.value ~default:Ptime.epoch)
988
1046
~domain:"example.com" ~path:"/" header3
989
1047
in
990
-
let cookie3 = Option.get cookie_opt3 in
1048
+
let cookie3 = Result.get_ok cookie_opt3 in
991
1049
let expected3 = Ptime.of_date_time ((1999, 9, 10), ((20, 0, 0), 0)) in
992
1050
begin match expected3 with
993
1051
| Some t ->
···
1012
1070
|> Option.value ~default:Ptime.epoch)
1013
1071
~domain:"example.com" ~path:"/" header
1014
1072
in
1015
-
let cookie = Option.get cookie_opt in
1073
+
let cookie = Result.get_ok cookie_opt in
1016
1074
let expected = Ptime.of_date_time ((2025, 10, 21), ((07, 28, 00), 0)) in
1017
1075
begin match expected with
1018
1076
| Some t ->
···
1032
1090
|> Option.value ~default:Ptime.epoch)
1033
1091
~domain:"example.com" ~path:"/" header2
1034
1092
in
1035
-
let cookie2 = Option.get cookie_opt2 in
1093
+
let cookie2 = Result.get_ok cookie_opt2 in
1036
1094
let expected2 = Ptime.of_date_time ((2000, 1, 1), ((0, 0, 0), 0)) in
1037
1095
begin match expected2 with
1038
1096
| Some t ->
···
1052
1110
|> Option.value ~default:Ptime.epoch)
1053
1111
~domain:"example.com" ~path:"/" header3
1054
1112
in
1055
-
let cookie3 = Option.get cookie_opt3 in
1113
+
let cookie3 = Result.get_ok cookie_opt3 in
1056
1114
let expected3 = Ptime.of_date_time ((2068, 9, 10), ((20, 0, 0), 0)) in
1057
1115
begin match expected3 with
1058
1116
| Some t ->
···
1079
1137
in
1080
1138
Alcotest.(check bool)
1081
1139
"RFC 3339 cookie parsed" true
1082
-
(Option.is_some cookie_opt);
1140
+
(Result.is_ok cookie_opt);
1083
1141
1084
-
let cookie = Option.get cookie_opt in
1142
+
let cookie = Result.get_ok cookie_opt in
1085
1143
Alcotest.(check bool)
1086
1144
"RFC 3339 has expiry" true
1087
1145
(Option.is_some (Cookeio.expires cookie));
···
1114
1172
(* Cookie should still be parsed, just without expires *)
1115
1173
Alcotest.(check bool)
1116
1174
"cookie parsed despite invalid date" true
1117
-
(Option.is_some cookie_opt);
1118
-
let cookie = Option.get cookie_opt in
1175
+
(Result.is_ok cookie_opt);
1176
+
let cookie = Result.get_ok cookie_opt in
1119
1177
Alcotest.(check string) "cookie name correct" "session" (Cookeio.name cookie);
1120
1178
Alcotest.(check string) "cookie value correct" "abc" (Cookeio.value cookie);
1121
1179
(* expires should be None since date was invalid *)
···
1148
1206
in
1149
1207
Alcotest.(check bool)
1150
1208
(description ^ " parsed") true
1151
-
(Option.is_some cookie_opt);
1209
+
(Result.is_ok cookie_opt);
1152
1210
1153
-
let cookie = Option.get cookie_opt in
1211
+
let cookie = Result.get_ok cookie_opt in
1154
1212
Alcotest.(check bool)
1155
1213
(description ^ " has expiry")
1156
1214
true
···
1194
1252
in
1195
1253
Alcotest.(check bool)
1196
1254
(description ^ " parsed") true
1197
-
(Option.is_some cookie_opt);
1255
+
(Result.is_ok cookie_opt);
1198
1256
1199
-
let cookie = Option.get cookie_opt in
1257
+
let cookie = Result.get_ok cookie_opt in
1200
1258
Alcotest.(check bool)
1201
1259
(description ^ " has expiry")
1202
1260
true
···
1523
1581
|> Option.value ~default:Ptime.epoch)
1524
1582
~domain:"widget.com" ~path:"/" "id=123; Partitioned; Secure"
1525
1583
with
1526
-
| Some c ->
1584
+
| Ok c ->
1527
1585
Alcotest.(check bool) "partitioned flag" true (partitioned c);
1528
1586
Alcotest.(check bool) "secure flag" true (secure c)
1529
-
| None -> Alcotest.fail "Should parse valid Partitioned cookie"
1587
+
| Error msg -> Alcotest.fail ("Should parse valid Partitioned cookie: " ^ msg)
1530
1588
1531
1589
let test_partitioned_serialization env =
1532
1590
let clock = Eio.Stdenv.clock env in
···
1562
1620
|> Option.value ~default:Ptime.epoch)
1563
1621
~domain:"widget.com" ~path:"/" "id=123; Partitioned"
1564
1622
with
1565
-
| None -> () (* Expected *)
1566
-
| Some _ -> Alcotest.fail "Should reject Partitioned without Secure"
1623
+
| Error _ -> () (* Expected *)
1624
+
| Ok _ -> Alcotest.fail "Should reject Partitioned without Secure"
1567
1625
1568
1626
(* Priority 2.2: Expiration Variants *)
1569
1627
···
1605
1663
|> Option.value ~default:Ptime.epoch)
1606
1664
~domain:"ex.com" ~path:"/" "id=123; Expires=0"
1607
1665
with
1608
-
| Some c ->
1666
+
| Ok c ->
1609
1667
Alcotest.(check (option expiration_testable))
1610
1668
"expires=0 is session" (Some `Session) (expires c)
1611
-
| None -> Alcotest.fail "Should parse Expires=0"
1669
+
| Error msg -> Alcotest.fail ("Should parse Expires=0: " ^ msg)
1612
1670
1613
1671
let test_serialize_expiration_variants env =
1614
1672
let clock = Eio.Stdenv.clock env in
···
1645
1703
1646
1704
let test_quoted_cookie_values env =
1647
1705
let clock = Eio.Stdenv.clock env in
1648
-
let test_cases =
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 =
1649
1710
[
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=\"\"", "\"\"", "");
1711
+
("name=value", "value", "value"); (* No quotes *)
1712
+
("name=\"value\"", "\"value\"", "value"); (* Properly quoted *)
1713
+
("name=\"\"", "\"\"", ""); (* Empty quoted value *)
1656
1714
]
1657
1715
in
1658
1716
···
1665
1723
|> Option.value ~default:Ptime.epoch)
1666
1724
~domain:"ex.com" ~path:"/" input
1667
1725
with
1668
-
| Some c ->
1726
+
| Ok c ->
1669
1727
Alcotest.(check string)
1670
1728
(Printf.sprintf "raw value for %s" input)
1671
1729
expected_raw (value c);
1672
1730
Alcotest.(check string)
1673
1731
(Printf.sprintf "trimmed value for %s" input)
1674
1732
expected_trimmed (value_trimmed c)
1675
-
| None -> Alcotest.fail ("Parse failed: " ^ input))
1676
-
test_cases
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
1677
1759
1678
1760
let test_trimmed_value_not_used_for_equality env =
1679
1761
let clock = Eio.Stdenv.clock env in
···
1685
1767
|> Option.value ~default:Ptime.epoch)
1686
1768
~domain:"ex.com" ~path:"/" "name=\"value\""
1687
1769
with
1688
-
| Some c1 -> begin
1770
+
| Ok c1 -> begin
1689
1771
match
1690
1772
of_set_cookie_header
1691
1773
~now:(fun () ->
···
1693
1775
|> Option.value ~default:Ptime.epoch)
1694
1776
~domain:"ex.com" ~path:"/" "name=value"
1695
1777
with
1696
-
| Some c2 ->
1778
+
| Ok c2 ->
1697
1779
(* Different raw values *)
1698
1780
Alcotest.(check bool)
1699
1781
"different raw values" false
···
1701
1783
(* Same trimmed values *)
1702
1784
Alcotest.(check string)
1703
1785
"same trimmed values" (value_trimmed c1) (value_trimmed c2)
1704
-
| None -> Alcotest.fail "Parse failed for unquoted"
1786
+
| Error msg -> Alcotest.fail ("Parse failed for unquoted: " ^ msg)
1705
1787
end
1706
-
| None -> Alcotest.fail "Parse failed for quoted"
1788
+
| Error msg -> Alcotest.fail ("Parse failed for quoted: " ^ msg)
1707
1789
1708
1790
(* Priority 2.4: Cookie Header Parsing *)
1709
1791
1710
1792
let test_cookie_header_parsing_basic env =
1711
1793
let clock = Eio.Stdenv.clock env in
1712
-
let results =
1794
+
let result =
1713
1795
of_cookie_header
1714
1796
~now:(fun () ->
1715
1797
Ptime.of_float_s (Eio.Time.now clock)
···
1717
1799
~domain:"ex.com" ~path:"/" "session=abc123; theme=dark; lang=en"
1718
1800
in
1719
1801
1720
-
let cookies = List.filter_map Result.to_option results in
1721
-
Alcotest.(check int) "parsed 3 cookies" 3 (List.length cookies);
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);
1722
1806
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"))
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"))
1727
1811
1728
1812
let test_cookie_header_defaults env =
1729
1813
let clock = Eio.Stdenv.clock env in
···
1735
1819
|> Option.value ~default:Ptime.epoch)
1736
1820
~domain:"example.com" ~path:"/app" "session=xyz"
1737
1821
with
1738
-
| [ Ok c ] ->
1822
+
| Ok [ c ] ->
1739
1823
(* Domain and path from request context *)
1740
1824
Alcotest.(check string) "domain from context" "example.com" (domain c);
1741
1825
Alcotest.(check string) "path from context" "/app" (path c);
···
1751
1835
Alcotest.(check (option span_testable)) "no max_age" None (max_age c);
1752
1836
Alcotest.(check (option same_site_testable))
1753
1837
"no same_site" None (same_site c)
1754
-
| _ -> Alcotest.fail "Should parse single cookie"
1838
+
| Ok _ -> Alcotest.fail "Should parse single cookie"
1839
+
| Error msg -> Alcotest.fail ("Parse failed: " ^ msg)
1755
1840
1756
1841
let test_cookie_header_edge_cases env =
1757
1842
let clock = Eio.Stdenv.clock env in
1758
1843
1759
1844
let test input expected_count description =
1760
-
let results =
1845
+
let result =
1761
1846
of_cookie_header
1762
1847
~now:(fun () ->
1763
1848
Ptime.of_float_s (Eio.Time.now clock)
1764
1849
|> Option.value ~default:Ptime.epoch)
1765
1850
~domain:"ex.com" ~path:"/" input
1766
1851
in
1767
-
let cookies = List.filter_map Result.to_option results in
1768
-
Alcotest.(check int) description expected_count (List.length cookies)
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)
1769
1857
in
1770
1858
1771
1859
test "" 0 "empty string";
···
1777
1865
let test_cookie_header_with_errors env =
1778
1866
let clock = Eio.Stdenv.clock env in
1779
1867
1780
-
(* Mix of valid and invalid cookies *)
1781
-
let results =
1868
+
(* Invalid cookie (empty name) should cause entire parse to fail *)
1869
+
let result =
1782
1870
of_cookie_header
1783
1871
~now:(fun () ->
1784
1872
Ptime.of_float_s (Eio.Time.now clock)
···
1786
1874
~domain:"ex.com" ~path:"/" "valid=1;=noname;valid2=2"
1787
1875
in
1788
1876
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 *)
1877
+
(* Error should have descriptive message about the invalid cookie *)
1798
1878
let contains_substring s sub =
1799
1879
try
1800
1880
let _ = Str.search_forward (Str.regexp_string sub) s 0 in
1801
1881
true
1802
1882
with Not_found -> false
1803
1883
in
1804
-
begin match List.hd errors with
1884
+
match result with
1805
1885
| Error msg ->
1806
1886
let has_name = contains_substring msg "name" in
1807
1887
let has_empty = contains_substring msg "empty" in
1808
1888
Alcotest.(check bool)
1809
1889
"error mentions name or empty" true (has_name || has_empty)
1810
-
| Ok _ -> Alcotest.fail "Expected error"
1811
-
end
1890
+
| Ok _ -> Alcotest.fail "Expected error for empty cookie name"
1812
1891
1813
1892
(* Max-Age and Expires Interaction *)
1814
1893
···
1867
1946
~domain:"ex.com" ~path:"/"
1868
1947
"id=123; Max-Age=3600; Expires=Wed, 21 Oct 2025 07:28:00 GMT"
1869
1948
with
1870
-
| Some c ->
1949
+
| Ok c ->
1871
1950
(* Both should be stored *)
1872
1951
begin match max_age c with
1873
1952
| Some span -> begin
···
1883
1962
| Some (`DateTime _) -> ()
1884
1963
| _ -> Alcotest.fail "expires should be parsed"
1885
1964
end
1886
-
| None -> Alcotest.fail "Should parse cookie with both attributes"
1965
+
| Error msg -> Alcotest.fail ("Should parse cookie with both attributes: " ^ msg)
1887
1966
1888
1967
(* ============================================================================ *)
1889
1968
(* Host-Only Flag Tests (RFC 6265 Section 5.3) *)
···
1903
1982
|> Option.value ~default:Ptime.epoch)
1904
1983
~domain:"example.com" ~path:"/" header
1905
1984
in
1906
-
Alcotest.(check bool) "cookie parsed" true (Option.is_some cookie_opt);
1907
-
let cookie = Option.get cookie_opt in
1985
+
Alcotest.(check bool) "cookie parsed" true (Result.is_ok cookie_opt);
1986
+
let cookie = Result.get_ok cookie_opt in
1908
1987
Alcotest.(check bool) "host_only is true" true (Cookeio.host_only cookie);
1909
1988
Alcotest.(check string) "domain is request host" "example.com" (Cookeio.domain cookie)
1910
1989
···
1922
2001
|> Option.value ~default:Ptime.epoch)
1923
2002
~domain:"example.com" ~path:"/" header
1924
2003
in
1925
-
Alcotest.(check bool) "cookie parsed" true (Option.is_some cookie_opt);
1926
-
let cookie = Option.get cookie_opt in
2004
+
Alcotest.(check bool) "cookie parsed" true (Result.is_ok cookie_opt);
2005
+
let cookie = Result.get_ok cookie_opt in
1927
2006
Alcotest.(check bool) "host_only is false" false (Cookeio.host_only cookie);
1928
2007
Alcotest.(check string) "domain is attribute value" "example.com" (Cookeio.domain cookie)
1929
2008
···
1941
2020
|> Option.value ~default:Ptime.epoch)
1942
2021
~domain:"example.com" ~path:"/" header
1943
2022
in
1944
-
Alcotest.(check bool) "cookie parsed" true (Option.is_some cookie_opt);
1945
-
let cookie = Option.get cookie_opt in
2023
+
Alcotest.(check bool) "cookie parsed" true (Result.is_ok cookie_opt);
2024
+
let cookie = Result.get_ok cookie_opt in
1946
2025
Alcotest.(check bool) "host_only is false" false (Cookeio.host_only cookie);
1947
2026
Alcotest.(check string) "domain normalized" "example.com" (Cookeio.domain cookie)
1948
2027
···
1991
2070
Eio_mock.Clock.set_time clock 1000.0;
1992
2071
1993
2072
(* Cookies from Cookie header should have host_only=true *)
1994
-
let results =
2073
+
let result =
1995
2074
of_cookie_header
1996
2075
~now:(fun () ->
1997
2076
Ptime.of_float_s (Eio.Time.now clock)
1998
2077
|> Option.value ~default:Ptime.epoch)
1999
2078
~domain:"example.com" ~path:"/" "session=abc; theme=dark"
2000
2079
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
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
2008
2089
2009
2090
let test_host_only_mozilla_format_round_trip () =
2010
2091
Eio_mock.Backend.run @@ fun () ->
···
2207
2288
Alcotest.(check int) "/foo/bar does NOT match /baz" 0 (List.length cookies3)
2208
2289
2209
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
+
(* ============================================================================ *)
2210
2548
(* IP Address Domain Matching Tests (RFC 6265 Section 5.1.3) *)
2211
2549
(* ============================================================================ *)
2212
2550
···
2361
2699
Alcotest.(check int) "IP matches IP cookie" 1 (List.length cookies3);
2362
2700
Alcotest.(check string) "IP cookie is returned" "ip" (Cookeio.name (List.hd cookies3))
2363
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
+
2364
3038
let () =
2365
3039
Eio_main.run @@ fun env ->
2366
3040
let open Alcotest in
···
2388
3062
[
2389
3063
test_case "Cookie expiry with mock clock" `Quick
2390
3064
test_cookie_expiry_with_mock_clock;
3065
+
test_case "get_cookies filters expired cookies" `Quick
3066
+
test_get_cookies_filters_expired;
2391
3067
test_case "Max-Age parsing with mock clock" `Quick
2392
3068
test_max_age_parsing_with_mock_clock;
2393
3069
test_case "Last access time with mock clock" `Quick
···
2530
3206
test_case "IPv6 exact match" `Quick test_ipv6_exact_match;
2531
3207
test_case "IPv6 full format" `Quick test_ipv6_full_format;
2532
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;
2533
3253
] );
2534
3254
]