···1313 secure : bool;
1414 http_only : bool;
1515 expires : Ptime.t option;
1616+ max_age : Ptime.Span.t option;
1617 same_site : same_site option;
1718 creation_time : Ptime.t;
1819 last_access : Ptime.t;
1920}
2021(** HTTP Cookie *)
21222222-type jar = { mutable cookies : t list; mutex : Eio.Mutex.t }
2323+type jar = {
2424+ mutable original_cookies : t list; (* from client *)
2525+ mutable delta_cookies : t list; (* to send back *)
2626+ mutex : Eio.Mutex.t;
2727+}
2328(** Cookie jar for storing and managing cookies *)
24292530(** {1 Cookie Accessors} *)
···3136let secure cookie = cookie.secure
3237let http_only cookie = cookie.http_only
3338let expires cookie = cookie.expires
3939+let max_age cookie = cookie.max_age
3440let same_site cookie = cookie.same_site
3541let creation_time cookie = cookie.creation_time
3642let last_access cookie = cookie.last_access
37433844let make ~domain ~path ~name ~value ?(secure = false) ?(http_only = false)
3939- ?expires ?same_site ~creation_time ~last_access () =
4040- { domain; path; name; value; secure; http_only; expires; same_site; creation_time; last_access }
4545+ ?expires ?max_age ?same_site ~creation_time ~last_access () =
4646+ {
4747+ domain;
4848+ path;
4949+ name;
5050+ value;
5151+ secure;
5252+ http_only;
5353+ expires;
5454+ max_age;
5555+ same_site;
5656+ creation_time;
5757+ last_access;
5858+ }
41594260(** {1 Cookie Jar Creation} *)
43614462let create () =
4563 Log.debug (fun m -> m "Creating new empty cookie jar");
4646- { cookies = []; mutex = Eio.Mutex.create () }
6464+ { original_cookies = []; delta_cookies = []; mutex = Eio.Mutex.create () }
47654866(** {1 Cookie Matching Helpers} *)
49676868+let cookie_identity_matches c1 c2 =
6969+ name c1 = name c2 && domain c1 = domain c2 && path c1 = path c2
7070+7171+let normalize_domain domain =
7272+ (* Strip leading dot per RFC 6265 *)
7373+ match String.starts_with ~prefix:"." domain with
7474+ | true when String.length domain > 1 ->
7575+ String.sub domain 1 (String.length domain - 1)
7676+ | _ -> domain
7777+5078let domain_matches cookie_domain request_domain =
5151- (* Cookie domain .example.com matches example.com and sub.example.com *)
5252- if String.starts_with ~prefix:"." cookie_domain then
5353- let domain_suffix = String.sub cookie_domain 1 (String.length cookie_domain - 1) in
5454- request_domain = domain_suffix
5555- || String.ends_with ~suffix:("." ^ domain_suffix) request_domain
5656- else cookie_domain = request_domain
7979+ (* Cookie domains are stored without leading dots per RFC 6265.
8080+ A cookie with domain "example.com" should match both "example.com" (exact)
8181+ and "sub.example.com" (subdomain). *)
8282+ request_domain = cookie_domain
8383+ || String.ends_with ~suffix:("." ^ cookie_domain) request_domain
57845885let path_matches cookie_path request_path =
5986 (* Cookie path /foo matches /foo, /foo/, /foo/bar *)
6087 String.starts_with ~prefix:cookie_path request_path
61888989+(** {1 HTTP Date Parsing} *)
6290let is_expired cookie clock =
6391 match cookie.expires with
6492 | None -> false (* Session cookie *)
···6997 in
7098 Ptime.compare now exp_time > 0
7199100100+module DateParser = struct
101101+ (** Month name to number mapping (case-insensitive) *)
102102+ let month_of_string s =
103103+ match String.lowercase_ascii s with
104104+ | "jan" -> Some 1
105105+ | "feb" -> Some 2
106106+ | "mar" -> Some 3
107107+ | "apr" -> Some 4
108108+ | "may" -> Some 5
109109+ | "jun" -> Some 6
110110+ | "jul" -> Some 7
111111+ | "aug" -> Some 8
112112+ | "sep" -> Some 9
113113+ | "oct" -> Some 10
114114+ | "nov" -> Some 11
115115+ | "dec" -> Some 12
116116+ | _ -> None
117117+118118+ (** Normalize abbreviated years:
119119+ - Years 69-99 get 1900 added (e.g., 95 → 1995)
120120+ - Years 0-68 get 2000 added (e.g., 25 → 2025)
121121+ - Years >= 100 are returned as-is *)
122122+ let normalize_year year =
123123+ if year >= 0 && year <= 68 then year + 2000
124124+ else if year >= 69 && year <= 99 then year + 1900
125125+ else year
126126+127127+ (** Parse FMT1: "Wed, 21 Oct 2015 07:28:00 GMT" (RFC 1123) *)
128128+ let parse_fmt1 s =
129129+ try
130130+ Scanf.sscanf s "%s %d %s %d %d:%d:%d %s"
131131+ (fun _wday day mon year hour min sec tz ->
132132+ (* Check timezone is GMT (case-insensitive) *)
133133+ if String.lowercase_ascii tz <> "gmt" then None
134134+ else
135135+ match month_of_string mon with
136136+ | None -> None
137137+ | Some month ->
138138+ let year = normalize_year year in
139139+ Ptime.of_date_time ((year, month, day), ((hour, min, sec), 0)))
140140+ with _ -> None
141141+142142+ (** Parse FMT2: "Wednesday, 21-Oct-15 07:28:00 GMT" (RFC 850) *)
143143+ let parse_fmt2 s =
144144+ try
145145+ Scanf.sscanf s "%[^,], %d-%3s-%d %d:%d:%d %s"
146146+ (fun _wday day mon year hour min sec tz ->
147147+ (* Check timezone is GMT (case-insensitive) *)
148148+ if String.lowercase_ascii tz <> "gmt" then None
149149+ else
150150+ match month_of_string mon with
151151+ | None -> None
152152+ | Some month ->
153153+ let year = normalize_year year in
154154+ Ptime.of_date_time ((year, month, day), ((hour, min, sec), 0)))
155155+ with _ -> None
156156+157157+ (** Parse FMT3: "Wed Oct 21 07:28:00 2015" (asctime) *)
158158+ let parse_fmt3 s =
159159+ try
160160+ Scanf.sscanf s "%s %s %d %d:%d:%d %d"
161161+ (fun _wday mon day hour min sec year ->
162162+ match month_of_string mon with
163163+ | None -> None
164164+ | Some month ->
165165+ let year = normalize_year year in
166166+ Ptime.of_date_time ((year, month, day), ((hour, min, sec), 0)))
167167+ with _ -> None
168168+169169+ (** Parse FMT4: "Wed, 21-Oct-2015 07:28:00 GMT" (variant) *)
170170+ let parse_fmt4 s =
171171+ try
172172+ Scanf.sscanf s "%s %d-%3s-%d %d:%d:%d %s"
173173+ (fun _wday day mon year hour min sec tz ->
174174+ (* Check timezone is GMT (case-insensitive) *)
175175+ if String.lowercase_ascii tz <> "gmt" then None
176176+ else
177177+ match month_of_string mon with
178178+ | None -> None
179179+ | Some month ->
180180+ let year = normalize_year year in
181181+ Ptime.of_date_time ((year, month, day), ((hour, min, sec), 0)))
182182+ with _ -> None
183183+184184+ (** Parse HTTP date by trying all supported formats in sequence *)
185185+ let parse_http_date s =
186186+ match parse_fmt1 s with
187187+ | Some t -> Some t
188188+ | None -> (
189189+ match parse_fmt2 s with
190190+ | Some t -> Some t
191191+ | None -> (
192192+ match parse_fmt3 s with Some t -> Some t | None -> parse_fmt4 s))
193193+end
194194+72195(** {1 Cookie Parsing} *)
731967474-(** Accumulated attributes from parsing Set-Cookie header *)
75197type cookie_attributes = {
76198 mutable domain : string option;
77199 mutable path : string option;
78200 mutable secure : bool;
79201 mutable http_only : bool;
80202 mutable expires : Ptime.t option;
203203+ mutable max_age : Ptime.Span.t option;
81204 mutable same_site : same_site option;
82205}
206206+(** Accumulated attributes from parsing Set-Cookie header *)
8320784208(** Create empty attribute accumulator *)
85209let empty_attributes () =
···89213 secure = false;
90214 http_only = false;
91215 expires = None;
216216+ max_age = None;
92217 same_site = None;
93218 }
94219···96221let parse_attribute clock attrs attr_name attr_value =
97222 let attr_lower = String.lowercase_ascii attr_name in
98223 match attr_lower with
9999- | "domain" -> attrs.domain <- Some attr_value
224224+ | "domain" -> attrs.domain <- Some (normalize_domain attr_value)
100225 | "path" -> attrs.path <- Some attr_value
101226 | "expires" -> (
102227 match Ptime.of_rfc3339 attr_value with
103228 | Ok (time, _, _) -> attrs.expires <- Some time
104104- | Error (`RFC3339 (_, err)) ->
105105- Log.warn (fun m ->
106106- m "Failed to parse expires attribute '%s': %a" attr_value
107107- Ptime.pp_rfc3339_error err))
229229+ | Error (`RFC3339 (_, err)) -> (
230230+ (* Try HTTP date format as fallback *)
231231+ match DateParser.parse_http_date attr_value with
232232+ | Some time -> attrs.expires <- Some time
233233+ | None ->
234234+ Log.warn (fun m ->
235235+ m "Failed to parse expires attribute '%s': %a" attr_value
236236+ Ptime.pp_rfc3339_error err)))
108237 | "max-age" -> (
109238 match int_of_string_opt attr_value with
110239 | Some seconds ->
240240+ (* Handle negative values as 0 per RFC 6265 *)
241241+ let seconds = max 0 seconds in
111242 let now = Eio.Time.now clock in
243243+ (* Store the max-age as a Ptime.Span *)
244244+ attrs.max_age <- Some (Ptime.Span.of_int_s seconds);
245245+ (* Also compute and store expires *)
112246 let expires = Ptime.of_float_s (now +. float_of_int seconds) in
113113- attrs.expires <- expires
247247+ attrs.expires <- expires;
248248+ Log.debug (fun m -> m "Parsed Max-Age: %d seconds" seconds)
114249 | None ->
115115- Log.warn (fun m -> m "Failed to parse max-age attribute '%s'" attr_value))
250250+ Log.warn (fun m ->
251251+ m "Failed to parse max-age attribute '%s'" attr_value))
116252 | "secure" -> attrs.secure <- true
117253 | "httponly" -> attrs.http_only <- true
118254 | "samesite" -> (
···121257 | "lax" -> attrs.same_site <- Some `Lax
122258 | "none" -> attrs.same_site <- Some `None
123259 | _ ->
124124- Log.warn (fun m -> m "Invalid samesite value '%s', ignoring" attr_value))
260260+ Log.warn (fun m ->
261261+ m "Invalid samesite value '%s', ignoring" attr_value))
125262 | _ ->
126263 Log.debug (fun m -> m "Unknown cookie attribute '%s', ignoring" attr_name)
127264···132269 | Some `None when not attrs.secure ->
133270 Log.warn (fun m ->
134271 m
135135- "Cookie has SameSite=None but Secure flag is not set; this violates \
136136- RFC requirements");
272272+ "Cookie has SameSite=None but Secure flag is not set; this \
273273+ violates RFC requirements");
137274 false
138275 | _ -> true
139276140277(** Build final cookie from name/value and accumulated attributes *)
141278let build_cookie ~request_domain ~request_path ~name ~value attrs ~now =
142142- let domain = Option.value attrs.domain ~default:request_domain in
279279+ let domain =
280280+ normalize_domain (Option.value attrs.domain ~default:request_domain)
281281+ in
143282 let path = Option.value attrs.path ~default:request_path in
144144- make ~domain ~path ~name ~value ~secure:attrs.secure ~http_only:attrs.http_only
145145- ?expires:attrs.expires ?same_site:attrs.same_site ~creation_time:now
146146- ~last_access:now ()
283283+ make ~domain ~path ~name ~value ~secure:attrs.secure
284284+ ~http_only:attrs.http_only ?expires:attrs.expires ?max_age:attrs.max_age
285285+ ?same_site:attrs.same_site ~creation_time:now ~last_access:now ()
147286148287let rec parse_set_cookie ~clock ~domain:request_domain ~path:request_path
149288 header_value =
···194333 None)
195334 else
196335 let cookie =
197197- build_cookie ~request_domain ~request_path ~name ~value:cookie_value
198198- accumulated_attrs ~now
336336+ build_cookie ~request_domain ~request_path ~name
337337+ ~value:cookie_value accumulated_attrs ~now
199338 in
200339 Log.debug (fun m -> m "Parsed cookie: %a" pp cookie);
201340 Some cookie)
···205344 |> List.map (fun c -> Printf.sprintf "%s=%s" (name c) (value c))
206345 |> String.concat "; "
207346347347+and make_set_cookie_header cookie =
348348+ let buffer = Buffer.create 128 in
349349+ Buffer.add_string buffer (Printf.sprintf "%s=%s" (name cookie) (value cookie));
350350+351351+ (* Add Max-Age if present *)
352352+ (match max_age cookie with
353353+ | Some span -> (
354354+ match Ptime.Span.to_int_s span with
355355+ | Some seconds ->
356356+ Buffer.add_string buffer (Printf.sprintf "; Max-Age=%d" seconds)
357357+ | None -> ())
358358+ | None -> ());
359359+360360+ (* Add Expires if present *)
361361+ (match expires cookie with
362362+ | Some exp_time ->
363363+ (* Format as HTTP date *)
364364+ let exp_str = Ptime.to_rfc3339 ~tz_offset_s:0 exp_time in
365365+ Buffer.add_string buffer (Printf.sprintf "; Expires=%s" exp_str)
366366+ | None -> ());
367367+368368+ (* Add Domain *)
369369+ Buffer.add_string buffer (Printf.sprintf "; Domain=%s" (domain cookie));
370370+371371+ (* Add Path *)
372372+ Buffer.add_string buffer (Printf.sprintf "; Path=%s" (path cookie));
373373+374374+ (* Add Secure flag *)
375375+ if secure cookie then Buffer.add_string buffer "; Secure";
376376+377377+ (* Add HttpOnly flag *)
378378+ if http_only cookie then Buffer.add_string buffer "; HttpOnly";
379379+380380+ (* Add SameSite *)
381381+ (match same_site cookie with
382382+ | Some `Strict -> Buffer.add_string buffer "; SameSite=Strict"
383383+ | Some `Lax -> Buffer.add_string buffer "; SameSite=Lax"
384384+ | Some `None -> Buffer.add_string buffer "; SameSite=None"
385385+ | None -> ());
386386+387387+ Buffer.contents buffer
388388+208389(** {1 Pretty Printing} *)
209390210391and pp_same_site ppf = function
···215396and pp ppf cookie =
216397 Format.fprintf ppf
217398 "@[<hov 2>{ name=%S;@ value=%S;@ domain=%S;@ path=%S;@ secure=%b;@ \
218218- http_only=%b;@ expires=%a;@ same_site=%a }@]"
399399+ http_only=%b;@ expires=%a;@ max_age=%a;@ same_site=%a }@]"
219400 (name cookie) (value cookie) (domain cookie) (path cookie) (secure cookie)
220401 (http_only cookie)
221402 (Format.pp_print_option Ptime.pp)
222403 (expires cookie)
404404+ (Format.pp_print_option Ptime.Span.pp)
405405+ (max_age cookie)
223406 (Format.pp_print_option pp_same_site)
224407 (same_site cookie)
225408226409let pp_jar ppf jar =
227410 Eio.Mutex.lock jar.mutex;
228228- let cookies = jar.cookies in
411411+ let original = jar.original_cookies in
412412+ let delta = jar.delta_cookies in
229413 Eio.Mutex.unlock jar.mutex;
230414231231- Format.fprintf ppf "@[<v>CookieJar with %d cookies:@," (List.length cookies);
232232- List.iter (fun cookie -> Format.fprintf ppf " %a@," pp cookie) cookies;
415415+ let all_cookies = original @ delta in
416416+ Format.fprintf ppf "@[<v>CookieJar with %d cookies (%d original, %d delta):@,"
417417+ (List.length all_cookies) (List.length original) (List.length delta);
418418+ List.iter (fun cookie -> Format.fprintf ppf " %a@," pp cookie) all_cookies;
233419 Format.fprintf ppf "@]"
234420235421(** {1 Cookie Management} *)
236422237423let add_cookie jar cookie =
238424 Log.debug (fun m ->
239239- m "Adding cookie: %s=%s for domain %s" (name cookie) (value cookie)
240240- (domain cookie));
425425+ m "Adding cookie to delta: %s=%s for domain %s" (name cookie)
426426+ (value cookie) (domain cookie));
241427242428 Eio.Mutex.lock jar.mutex;
243243- (* Remove existing cookie with same name, domain, and path *)
244244- jar.cookies <-
429429+ (* Remove existing cookie with same identity from delta *)
430430+ jar.delta_cookies <-
245431 List.filter
246246- (fun c ->
247247- not
248248- (name c = name cookie && domain c = domain cookie
249249- && path c = path cookie))
250250- jar.cookies;
251251- jar.cookies <- cookie :: jar.cookies;
432432+ (fun c -> not (cookie_identity_matches c cookie))
433433+ jar.delta_cookies;
434434+ jar.delta_cookies <- cookie :: jar.delta_cookies;
252435 Eio.Mutex.unlock jar.mutex
253436254254-let get_cookies jar ~clock ~domain:request_domain ~path:request_path ~is_secure =
437437+let add_original jar cookie =
438438+ Log.debug (fun m ->
439439+ m "Adding original cookie: %s=%s for domain %s" (name cookie)
440440+ (value cookie) (domain cookie));
441441+442442+ Eio.Mutex.lock jar.mutex;
443443+ (* Remove existing cookie with same identity from original *)
444444+ jar.original_cookies <-
445445+ List.filter
446446+ (fun c -> not (cookie_identity_matches c cookie))
447447+ jar.original_cookies;
448448+ jar.original_cookies <- cookie :: jar.original_cookies;
449449+ Eio.Mutex.unlock jar.mutex
450450+451451+let delta jar =
452452+ Eio.Mutex.lock jar.mutex;
453453+ let result = jar.delta_cookies in
454454+ Eio.Mutex.unlock jar.mutex;
455455+ Log.debug (fun m -> m "Returning %d delta cookies" (List.length result));
456456+ result
457457+458458+let make_removal_cookie cookie ~clock =
459459+ let now =
460460+ Ptime.of_float_s (Eio.Time.now clock) |> Option.value ~default:Ptime.epoch
461461+ in
462462+ (* Create a cookie with Max-Age=0 and past expiration (1 year ago) *)
463463+ let past_expiry =
464464+ Ptime.sub_span now (Ptime.Span.of_int_s (365 * 24 * 60 * 60))
465465+ |> Option.value ~default:Ptime.epoch
466466+ in
467467+ make ~domain:(domain cookie) ~path:(path cookie) ~name:(name cookie) ~value:""
468468+ ~secure:(secure cookie) ~http_only:(http_only cookie) ~expires:past_expiry
469469+ ~max_age:(Ptime.Span.of_int_s 0) ?same_site:(same_site cookie)
470470+ ~creation_time:now ~last_access:now ()
471471+472472+let remove jar ~clock cookie =
473473+ Log.debug (fun m ->
474474+ m "Removing cookie: %s=%s for domain %s" (name cookie) (value cookie)
475475+ (domain cookie));
476476+477477+ Eio.Mutex.lock jar.mutex;
478478+ (* Check if this cookie exists in original_cookies *)
479479+ let in_original =
480480+ List.exists (fun c -> cookie_identity_matches c cookie) jar.original_cookies
481481+ in
482482+483483+ if in_original then (
484484+ (* Create a removal cookie and add it to delta *)
485485+ let removal = make_removal_cookie cookie ~clock in
486486+ jar.delta_cookies <-
487487+ List.filter
488488+ (fun c -> not (cookie_identity_matches c removal))
489489+ jar.delta_cookies;
490490+ jar.delta_cookies <- removal :: jar.delta_cookies;
491491+ Log.debug (fun m -> m "Created removal cookie in delta for original cookie"))
492492+ else (
493493+ (* Just remove from delta if it exists there *)
494494+ jar.delta_cookies <-
495495+ List.filter
496496+ (fun c -> not (cookie_identity_matches c cookie))
497497+ jar.delta_cookies;
498498+ Log.debug (fun m -> m "Removed cookie from delta"));
499499+500500+ Eio.Mutex.unlock jar.mutex
501501+502502+let get_cookies jar ~clock ~domain:request_domain ~path:request_path ~is_secure
503503+ =
255504 Log.debug (fun m ->
256505 m "Getting cookies for domain=%s path=%s secure=%b" request_domain
257506 request_path is_secure);
258507259508 Eio.Mutex.lock jar.mutex;
509509+510510+ (* Combine original and delta cookies, with delta taking precedence *)
511511+ let all_cookies = jar.original_cookies @ jar.delta_cookies in
512512+513513+ (* Filter out duplicates, keeping the last occurrence (from delta) *)
514514+ let rec dedup acc = function
515515+ | [] -> List.rev acc
516516+ | c :: rest ->
517517+ (* Keep this cookie only if no later cookie has the same identity *)
518518+ let has_duplicate =
519519+ List.exists (fun c2 -> cookie_identity_matches c c2) rest
520520+ in
521521+ if has_duplicate then dedup acc rest else dedup (c :: acc) rest
522522+ in
523523+ let unique_cookies = dedup [] all_cookies in
524524+525525+ (* Filter for applicable cookies, excluding removal cookies (empty value) *)
260526 let applicable =
261527 List.filter
262528 (fun cookie ->
263263- domain_matches (domain cookie) request_domain
529529+ value cookie <> ""
530530+ (* Exclude removal cookies *)
531531+ && domain_matches (domain cookie) request_domain
264532 && path_matches (path cookie) request_path
265533 && ((not (secure cookie)) || is_secure))
266266- jar.cookies
534534+ unique_cookies
267535 in
268536269269- (* Update last access time *)
537537+ (* Update last access time in both lists *)
270538 let now =
271539 Ptime.of_float_s (Eio.Time.now clock) |> Option.value ~default:Ptime.epoch
272540 in
273273- let updated =
541541+ let update_last_access cookies =
274542 List.map
275543 (fun c ->
276276- if List.memq c applicable then
544544+ if List.exists (fun a -> cookie_identity_matches a c) applicable then
277545 make ~domain:(domain c) ~path:(path c) ~name:(name c) ~value:(value c)
278546 ~secure:(secure c) ~http_only:(http_only c) ?expires:(expires c)
279279- ?same_site:(same_site c) ~creation_time:(creation_time c)
280280- ~last_access:now ()
547547+ ?max_age:(max_age c) ?same_site:(same_site c)
548548+ ~creation_time:(creation_time c) ~last_access:now ()
281549 else c)
282282- jar.cookies
550550+ cookies
283551 in
284284- jar.cookies <- updated;
552552+ jar.original_cookies <- update_last_access jar.original_cookies;
553553+ jar.delta_cookies <- update_last_access jar.delta_cookies;
554554+285555 Eio.Mutex.unlock jar.mutex;
286556287557 Log.debug (fun m -> m "Found %d applicable cookies" (List.length applicable));
···290560let clear jar =
291561 Log.info (fun m -> m "Clearing all cookies");
292562 Eio.Mutex.lock jar.mutex;
293293- jar.cookies <- [];
563563+ jar.original_cookies <- [];
564564+ jar.delta_cookies <- [];
294565 Eio.Mutex.unlock jar.mutex
295566296567let clear_expired jar ~clock =
297568 Eio.Mutex.lock jar.mutex;
298298- let before_count = List.length jar.cookies in
299299- jar.cookies <- List.filter (fun c -> not (is_expired c clock)) jar.cookies;
300300- let removed = before_count - List.length jar.cookies in
569569+ let before_count =
570570+ List.length jar.original_cookies + List.length jar.delta_cookies
571571+ in
572572+ jar.original_cookies <-
573573+ List.filter (fun c -> not (is_expired c clock)) jar.original_cookies;
574574+ jar.delta_cookies <-
575575+ List.filter (fun c -> not (is_expired c clock)) jar.delta_cookies;
576576+ let removed =
577577+ before_count
578578+ - (List.length jar.original_cookies + List.length jar.delta_cookies)
579579+ in
301580 Eio.Mutex.unlock jar.mutex;
302581 Log.info (fun m -> m "Cleared %d expired cookies" removed)
303582304583let clear_session_cookies jar =
305584 Eio.Mutex.lock jar.mutex;
306306- let before_count = List.length jar.cookies in
307307- jar.cookies <- List.filter (fun c -> expires c <> None) jar.cookies;
308308- let removed = before_count - List.length jar.cookies in
585585+ let before_count =
586586+ List.length jar.original_cookies + List.length jar.delta_cookies
587587+ in
588588+ jar.original_cookies <-
589589+ List.filter (fun c -> expires c <> None) jar.original_cookies;
590590+ jar.delta_cookies <-
591591+ List.filter (fun c -> expires c <> None) jar.delta_cookies;
592592+ let removed =
593593+ before_count
594594+ - (List.length jar.original_cookies + List.length jar.delta_cookies)
595595+ in
309596 Eio.Mutex.unlock jar.mutex;
310597 Log.info (fun m -> m "Cleared %d session cookies" removed)
311598312599let count jar =
313600 Eio.Mutex.lock jar.mutex;
314314- let n = List.length jar.cookies in
601601+ (* Combine and deduplicate cookies for count *)
602602+ let all_cookies = jar.original_cookies @ jar.delta_cookies in
603603+ let rec dedup acc = function
604604+ | [] -> List.rev acc
605605+ | c :: rest ->
606606+ let has_duplicate =
607607+ List.exists (fun c2 -> cookie_identity_matches c c2) rest
608608+ in
609609+ if has_duplicate then dedup acc rest else dedup (c :: acc) rest
610610+ in
611611+ let unique = dedup [] all_cookies in
612612+ let n = List.length unique in
315613 Eio.Mutex.unlock jar.mutex;
316614 n
317615318616let get_all_cookies jar =
319617 Eio.Mutex.lock jar.mutex;
320320- let cookies = jar.cookies in
618618+ (* Combine and deduplicate, with delta taking precedence *)
619619+ let all_cookies = jar.original_cookies @ jar.delta_cookies in
620620+ let rec dedup acc = function
621621+ | [] -> List.rev acc
622622+ | c :: rest ->
623623+ let has_duplicate =
624624+ List.exists (fun c2 -> cookie_identity_matches c c2) rest
625625+ in
626626+ if has_duplicate then dedup acc rest else dedup (c :: acc) rest
627627+ in
628628+ let unique = dedup [] all_cookies in
321629 Eio.Mutex.unlock jar.mutex;
322322- cookies
630630+ unique
323631324632let is_empty jar =
325633 Eio.Mutex.lock jar.mutex;
326326- let empty = jar.cookies = [] in
634634+ let empty = jar.original_cookies = [] && jar.delta_cookies = [] in
327635 Eio.Mutex.unlock jar.mutex;
328636 empty
329637···333641 let buffer = Buffer.create 1024 in
334642 Buffer.add_string buffer "# Netscape HTTP Cookie File\n";
335643 Buffer.add_string buffer "# This is a generated file! Do not edit.\n\n";
644644+645645+ (* Combine and deduplicate cookies *)
646646+ let all_cookies = jar.original_cookies @ jar.delta_cookies in
647647+ let rec dedup acc = function
648648+ | [] -> List.rev acc
649649+ | c :: rest ->
650650+ let has_duplicate =
651651+ List.exists (fun c2 -> cookie_identity_matches c c2) rest
652652+ in
653653+ if has_duplicate then dedup acc rest else dedup (c :: acc) rest
654654+ in
655655+ let unique = dedup [] all_cookies in
336656337657 List.iter
338658 (fun cookie ->
339659 let include_subdomains =
340340- if String.starts_with ~prefix:"." (domain cookie) then "TRUE" else "FALSE"
660660+ if String.starts_with ~prefix:"." (domain cookie) then "TRUE"
661661+ else "FALSE"
341662 in
342663 let secure_flag = if secure cookie then "TRUE" else "FALSE" in
343664 let expires_str =
···350671351672 Buffer.add_string buffer
352673 (Printf.sprintf "%s\t%s\t%s\t%s\t%s\t%s\t%s\n" (domain cookie)
353353- include_subdomains (path cookie) secure_flag expires_str (name cookie)
354354- (value cookie)))
355355- jar.cookies;
674674+ include_subdomains (path cookie) secure_flag expires_str
675675+ (name cookie) (value cookie)))
676676+ unique;
356677357678 Buffer.contents buffer
358679···379700 in
380701 let expires =
381702 let exp_int = try int_of_string expires with _ -> 0 in
382382- if exp_int = 0 then None else Ptime.of_float_s (float_of_int exp_int)
703703+ if exp_int = 0 then None
704704+ else Ptime.of_float_s (float_of_int exp_int)
383705 in
384706385707 let cookie =
386386- make ~domain ~path ~name ~value ~secure:(secure = "TRUE")
387387- ~http_only:false ?expires ?same_site:None ~creation_time:now
708708+ make ~domain:(normalize_domain domain) ~path ~name ~value
709709+ ~secure:(secure = "TRUE") ~http_only:false ?expires
710710+ ?max_age:None ?same_site:None ~creation_time:now
388711 ~last_access:now ()
389712 in
390390- add_cookie jar cookie;
713713+ add_original jar cookie;
391714 Log.debug (fun m -> m "Loaded cookie: %s=%s" name value)
392715 | _ -> Log.warn (fun m -> m "Invalid cookie line: %s" line))
393716 lines;
394717395395- Log.info (fun m -> m "Loaded %d cookies" (List.length jar.cookies));
718718+ Log.info (fun m -> m "Loaded %d cookies" (List.length jar.original_cookies));
396719 jar
397720398721(** {1 File Operations} *)
···412735 create ()
413736414737let save path jar =
415415- Log.info (fun m ->
416416- m "Saving %d cookies to %a" (List.length jar.cookies) Eio.Path.pp path);
738738+ Eio.Mutex.lock jar.mutex;
739739+ let total_cookies =
740740+ List.length jar.original_cookies + List.length jar.delta_cookies
741741+ in
742742+ Eio.Mutex.unlock jar.mutex;
743743+ Log.info (fun m -> m "Saving %d cookies to %a" total_cookies Eio.Path.pp path);
417744418745 let content = to_mozilla_format jar in
419746
+63-18
lib/cookeio.mli
···11(** Cookie management library for OCaml
2233- HTTP cookies are a mechanism that allows "server side
44- connections to store and retrieve information on the client side."
55- Originally designed to enable persistent client-side state for web
66- applications, cookies are essential for storing user preferences, session
77- data, shopping cart contents, and authentication tokens.
33+ HTTP cookies are a mechanism that allows "server side connections to store
44+ and retrieve information on the client side." Originally designed to enable
55+ persistent client-side state for web applications, cookies are essential for
66+ storing user preferences, session data, shopping cart contents, and
77+ authentication tokens.
8899 This library provides a complete cookie jar implementation following
1010- established web standards while integrating Eio for efficient asynchronous operations.
1010+ established web standards while integrating Eio for efficient asynchronous
1111+ operations.
11121213 {2 Cookie Format and Structure}
1314···2627 - Domain matching uses "tail matching" (e.g., "acme.com" matches
2728 "anvil.acme.com")
2829 - Path matching allows subset URL specification for fine-grained control
2929- - More specific path mappings are sent first in Cookie headers
3030-3131- *)
3030+ - More specific path mappings are sent first in Cookie headers *)
32313332type same_site = [ `Strict | `Lax | `None ]
3433(** Cookie same-site policy for controlling cross-site request behavior.
···8180val expires : t -> Ptime.t option
8281(** Get the expiry time of a cookie *)
83828383+val max_age : t -> Ptime.Span.t option
8484+(** Get the max-age of a cookie *)
8585+8486val same_site : t -> same_site option
8587(** Get the same-site policy of a cookie *)
8688···9092val last_access : t -> Ptime.t
9193(** Get the last access time of a cookie *)
92949393-val make : domain:string -> path:string -> name:string -> value:string ->
9494- ?secure:bool -> ?http_only:bool -> ?expires:Ptime.t ->
9595- ?same_site:same_site -> creation_time:Ptime.t -> last_access:Ptime.t ->
9696- unit -> t
9595+val make :
9696+ domain:string ->
9797+ path:string ->
9898+ name:string ->
9999+ value:string ->
100100+ ?secure:bool ->
101101+ ?http_only:bool ->
102102+ ?expires:Ptime.t ->
103103+ ?max_age:Ptime.Span.t ->
104104+ ?same_site:same_site ->
105105+ creation_time:Ptime.t ->
106106+ last_access:Ptime.t ->
107107+ unit ->
108108+ t
97109(** Create a new cookie with the given attributes *)
9811099111(** {1 Cookie Jar Creation and Loading} *)
···114126(** {1 Cookie Jar Management} *)
115127116128val add_cookie : jar -> t -> unit
117117-(** Add a cookie to the jar *)
129129+(** Add a cookie to the jar.
130130+131131+ The cookie is added to the delta, meaning it will appear in Set-Cookie
132132+ headers when calling {!delta}. If a cookie with the same name/domain/path
133133+ exists in the delta, it will be replaced. *)
134134+135135+val add_original : jar -> t -> unit
136136+(** Add an original cookie to the jar.
137137+138138+ Original cookies are those received from the client (via Cookie header).
139139+ They do not appear in the delta. This method should be used when loading
140140+ cookies from incoming HTTP requests. *)
141141+142142+val delta : jar -> t list
143143+(** Get cookies that need to be sent in Set-Cookie headers.
144144+145145+ Returns cookies that have been added via {!add_cookie} and removal cookies
146146+ for original cookies that have been removed. Does not include original
147147+ cookies that were added via {!add_original}. *)
148148+149149+val remove : jar -> clock:_ Eio.Time.clock -> t -> unit
150150+(** Remove a cookie from the jar.
151151+152152+ If an original cookie with the same name/domain/path exists, creates a
153153+ removal cookie (empty value, Max-Age=0, past expiration) that appears in the
154154+ delta. If only a delta cookie exists, simply removes it from the delta. *)
118155119156val get_cookies :
120157 jar ->
···126163(** Get cookies applicable for a URL.
127164128165 Returns all cookies that match the given domain and path, and satisfy the
129129- secure flag requirement. Also updates the last access time of matching
130130- cookies using the provided clock. *)
166166+ secure flag requirement. Combines original and delta cookies, with delta
167167+ taking precedence. Excludes removal cookies (empty value). Also updates the
168168+ last access time of matching cookies using the provided clock. *)
131169132170val clear : jar -> unit
133171(** Clear all cookies *)
···167205 - [SameSite=None] requires the [Secure] flag to be set
168206169207 Example:
170170- [parse_set_cookie ~clock ~domain:"example.com" ~path:"/"
171171- "session=abc123; Secure; HttpOnly"] *)
208208+ [parse_set_cookie ~clock ~domain:"example.com" ~path:"/" "session=abc123;
209209+ Secure; HttpOnly"] *)
172210173211val make_cookie_header : t list -> string
174212(** Create cookie header value from cookies.
···182220183221 Example: [make_cookie_header cookies] might return
184222 ["session=abc123; theme=dark"] *)
223223+224224+val make_set_cookie_header : t -> string
225225+(** Create Set-Cookie header value from a cookie.
226226+227227+ Formats a cookie into a Set-Cookie header value suitable for HTTP responses.
228228+ Includes all cookie attributes: Max-Age, Expires, Domain, Path, Secure,
229229+ HttpOnly, and SameSite. *)
185230186231(** {1 Pretty Printing} *)
187232
+918-38
test/test_cookeio.ml
···55 (fun ppf c ->
66 Format.fprintf ppf
77 "{ name=%S; value=%S; domain=%S; path=%S; secure=%b; http_only=%b; \
88- expires=%a; same_site=%a }"
99- (Cookeio.name c) (Cookeio.value c) (Cookeio.domain c) (Cookeio.path c) (Cookeio.secure c) (Cookeio.http_only c)
88+ expires=%a; max_age=%a; same_site=%a }"
99+ (Cookeio.name c) (Cookeio.value c) (Cookeio.domain c) (Cookeio.path c)
1010+ (Cookeio.secure c) (Cookeio.http_only c)
1011 (Format.pp_print_option Ptime.pp)
1112 (Cookeio.expires c)
1313+ (Format.pp_print_option Ptime.Span.pp)
1414+ (Cookeio.max_age c)
1215 (Format.pp_print_option (fun ppf -> function
1316 | `Strict -> Format.pp_print_string ppf "Strict"
1417 | `Lax -> Format.pp_print_string ppf "Lax"
1518 | `None -> Format.pp_print_string ppf "None"))
1619 (Cookeio.same_site c))
1720 (fun c1 c2 ->
1818- Cookeio.name c1 = Cookeio.name c2 && Cookeio.value c1 = Cookeio.value c2 && Cookeio.domain c1 = Cookeio.domain c2
1919- && Cookeio.path c1 = Cookeio.path c2 && Cookeio.secure c1 = Cookeio.secure c2
2121+ Cookeio.name c1 = Cookeio.name c2
2222+ && Cookeio.value c1 = Cookeio.value c2
2323+ && Cookeio.domain c1 = Cookeio.domain c2
2424+ && Cookeio.path c1 = Cookeio.path c2
2525+ && Cookeio.secure c1 = Cookeio.secure c2
2026 && Cookeio.http_only c1 = Cookeio.http_only c2
2127 && Option.equal Ptime.equal (Cookeio.expires c1) (Cookeio.expires c2)
2828+ && Option.equal Ptime.Span.equal (Cookeio.max_age c1) (Cookeio.max_age c2)
2229 && Option.equal ( = ) (Cookeio.same_site c1) (Cookeio.same_site c2))
23302431let test_load_mozilla_cookies env =
···49565057 (* Test cookie-1: session cookie on exact domain *)
5158 let cookie1 = find_cookie "cookie-1" in
5252- Alcotest.(check string) "cookie-1 domain" "example.com" (Cookeio.domain cookie1);
5959+ Alcotest.(check string)
6060+ "cookie-1 domain" "example.com" (Cookeio.domain cookie1);
5361 Alcotest.(check string) "cookie-1 path" "/foo/" (Cookeio.path cookie1);
5462 Alcotest.(check string) "cookie-1 name" "cookie-1" (Cookeio.name cookie1);
5563 Alcotest.(check string) "cookie-1 value" "v$1" (Cookeio.value cookie1);
···6674 | `Lax -> Format.pp_print_string ppf "Lax"
6775 | `None -> Format.pp_print_string ppf "None")
6876 ( = ))))
6969- "cookie-1 same_site" None (Cookeio.same_site cookie1);
7777+ "cookie-1 same_site" None
7878+ (Cookeio.same_site cookie1);
70797180 (* Test cookie-2: session cookie on subdomain pattern *)
7281 let cookie2 = find_cookie "cookie-2" in
7373- Alcotest.(check string) "cookie-2 domain" ".example.com" (Cookeio.domain cookie2);
8282+ Alcotest.(check string)
8383+ "cookie-2 domain" "example.com" (Cookeio.domain cookie2);
7484 Alcotest.(check string) "cookie-2 path" "/foo/" (Cookeio.path cookie2);
7585 Alcotest.(check string) "cookie-2 name" "cookie-2" (Cookeio.name cookie2);
7686 Alcotest.(check string) "cookie-2 value" "v$2" (Cookeio.value cookie2);
···8292 (* Test cookie-3: non-session cookie with expiry *)
8393 let cookie3 = find_cookie "cookie-3" in
8494 let expected_expiry = Ptime.of_float_s 1257894000.0 in
8585- Alcotest.(check string) "cookie-3 domain" "example.com" (Cookeio.domain cookie3);
9595+ Alcotest.(check string)
9696+ "cookie-3 domain" "example.com" (Cookeio.domain cookie3);
8697 Alcotest.(check string) "cookie-3 path" "/foo/" (Cookeio.path cookie3);
8798 Alcotest.(check string) "cookie-3 name" "cookie-3" (Cookeio.name cookie3);
8899 Alcotest.(check string) "cookie-3 value" "v$3" (Cookeio.value cookie3);
···9310494105 (* Test cookie-4: another non-session cookie *)
95106 let cookie4 = find_cookie "cookie-4" in
9696- Alcotest.(check string) "cookie-4 domain" "example.com" (Cookeio.domain cookie4);
107107+ Alcotest.(check string)
108108+ "cookie-4 domain" "example.com" (Cookeio.domain cookie4);
97109 Alcotest.(check string) "cookie-4 path" "/foo/" (Cookeio.path cookie4);
98110 Alcotest.(check string) "cookie-4 name" "cookie-4" (Cookeio.name cookie4);
99111 Alcotest.(check string) "cookie-4 value" "v$4" (Cookeio.value cookie4);
···104116105117 (* Test cookie-5: secure cookie *)
106118 let cookie5 = find_cookie "cookie-5" in
107107- Alcotest.(check string) "cookie-5 domain" "example.com" (Cookeio.domain cookie5);
119119+ Alcotest.(check string)
120120+ "cookie-5 domain" "example.com" (Cookeio.domain cookie5);
108121 Alcotest.(check string) "cookie-5 path" "/foo/" (Cookeio.path cookie5);
109122 Alcotest.(check string) "cookie-5 name" "cookie-5" (Cookeio.name cookie5);
110123 Alcotest.(check string) "cookie-5 value" "v$5" (Cookeio.value cookie5);
···129142 (* Verify a few key cookies are loaded correctly *)
130143 let cookie1 = find_cookie "cookie-1" in
131144 Alcotest.(check string) "file cookie-1 value" "v$1" (Cookeio.value cookie1);
132132- Alcotest.(check string) "file cookie-1 domain" "example.com" (Cookeio.domain cookie1);
145145+ Alcotest.(check string)
146146+ "file cookie-1 domain" "example.com" (Cookeio.domain cookie1);
133147 Alcotest.(check bool) "file cookie-1 secure" false (Cookeio.secure cookie1);
134148 Alcotest.(check (option (Alcotest.testable Ptime.pp Ptime.equal)))
135149 "file cookie-1 expires" None (Cookeio.expires cookie1);
···143157144158 (* Verify subdomain cookie *)
145159 let cookie2 = find_cookie "cookie-2" in
146146- Alcotest.(check string) "file cookie-2 domain" ".example.com" (Cookeio.domain cookie2);
160160+ Alcotest.(check string)
161161+ "file cookie-2 domain" "example.com" (Cookeio.domain cookie2);
147162 Alcotest.(check (option (Alcotest.testable Ptime.pp Ptime.equal)))
148163 "file cookie-2 expires" None (Cookeio.expires cookie2)
149164···154169 (* Add test cookies with different domain patterns *)
155170 let exact_cookie =
156171 Cookeio.make ~domain:"example.com" ~path:"/" ~name:"exact" ~value:"test1"
157157- ~secure:false ~http_only:false ?expires:None ?same_site:None
172172+ ~secure:false ~http_only:false ?expires:None ?same_site:None ?max_age:None
158173 ~creation_time:Ptime.epoch ~last_access:Ptime.epoch ()
159174 in
160175 let subdomain_cookie =
161161- Cookeio.make ~domain:".example.com" ~path:"/" ~name:"subdomain" ~value:"test2"
162162- ~secure:false ~http_only:false ?expires:None ?same_site:None
163163- ~creation_time:Ptime.epoch ~last_access:Ptime.epoch ()
176176+ Cookeio.make ~domain:"example.com" ~path:"/" ~name:"subdomain"
177177+ ~value:"test2" ~secure:false ~http_only:false ?expires:None
178178+ ?same_site:None ?max_age:None ~creation_time:Ptime.epoch
179179+ ~last_access:Ptime.epoch ()
164180 in
165181 let secure_cookie =
166182 Cookeio.make ~domain:"example.com" ~path:"/" ~name:"secure" ~value:"test3"
167167- ~secure:true ~http_only:false ?expires:None ?same_site:None
183183+ ~secure:true ~http_only:false ?expires:None ?same_site:None ?max_age:None
168184 ~creation_time:Ptime.epoch ~last_access:Ptime.epoch ()
169185 in
170186···172188 add_cookie jar subdomain_cookie;
173189 add_cookie jar secure_cookie;
174190175175- (* Test exact domain matching *)
191191+ (* Test exact domain matching - all three cookies should match example.com *)
176192 let cookies_http =
177193 get_cookies jar ~clock ~domain:"example.com" ~path:"/" ~is_secure:false
178194 in
···183199 in
184200 Alcotest.(check int) "https cookies count" 3 (List.length cookies_https);
185201186186- (* Test subdomain matching *)
202202+ (* Test subdomain matching - all cookies should match subdomains now *)
187203 let cookies_sub =
188204 get_cookies jar ~clock ~domain:"sub.example.com" ~path:"/" ~is_secure:false
189205 in
190190- Alcotest.(check int) "subdomain cookies count" 1 (List.length cookies_sub);
191191- let sub_cookie = List.hd cookies_sub in
192192- Alcotest.(check string) "subdomain cookie name" "subdomain" (Cookeio.name sub_cookie)
206206+ Alcotest.(check int) "subdomain cookies count" 2 (List.length cookies_sub)
193207194208let test_empty_jar env =
195209 let clock = Eio.Stdenv.clock env in
···209223 let jar = create () in
210224211225 let test_cookie =
212212- Cookeio.make ~domain:"example.com" ~path:"/test/" ~name:"test" ~value:"value"
213213- ~secure:true ~http_only:false ?expires:(Ptime.of_float_s 1257894000.0)
214214- ~same_site:`Strict ~creation_time:Ptime.epoch ~last_access:Ptime.epoch ()
226226+ Cookeio.make ~domain:"example.com" ~path:"/test/" ~name:"test"
227227+ ~value:"value" ~secure:true ~http_only:false
228228+ ?expires:(Ptime.of_float_s 1257894000.0)
229229+ ~same_site:`Strict ?max_age:None ~creation_time:Ptime.epoch
230230+ ~last_access:Ptime.epoch ()
215231 in
216232217233 add_cookie jar test_cookie;
···225241 let cookie2 = List.hd cookies2 in
226242 Alcotest.(check string) "round trip name" "test" (Cookeio.name cookie2);
227243 Alcotest.(check string) "round trip value" "value" (Cookeio.value cookie2);
228228- Alcotest.(check string) "round trip domain" "example.com" (Cookeio.domain cookie2);
244244+ Alcotest.(check string)
245245+ "round trip domain" "example.com" (Cookeio.domain cookie2);
229246 Alcotest.(check string) "round trip path" "/test/" (Cookeio.path cookie2);
230247 Alcotest.(check bool) "round trip secure" true (Cookeio.secure cookie2);
231248 (* Note: http_only and same_site are lost in Mozilla format *)
···248265 let cookie1 =
249266 Cookeio.make ~domain:"example.com" ~path:"/" ~name:"expires_soon"
250267 ~value:"value1" ~secure:false ~http_only:false ~expires:expires_soon
251251- ?same_site:None
268268+ ?same_site:None ?max_age:None
252269 ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get)
253270 ~last_access:(Ptime.of_float_s 1000.0 |> Option.get)
254271 ()
···259276 let cookie2 =
260277 Cookeio.make ~domain:"example.com" ~path:"/" ~name:"expires_later"
261278 ~value:"value2" ~secure:false ~http_only:false ~expires:expires_later
262262- ?same_site:None
279279+ ?same_site:None ?max_age:None
263280 ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get)
264281 ~last_access:(Ptime.of_float_s 1000.0 |> Option.get)
265282 ()
···268285 (* Add a session cookie (no expiry) *)
269286 let cookie3 =
270287 Cookeio.make ~domain:"example.com" ~path:"/" ~name:"session" ~value:"value3"
271271- ~secure:false ~http_only:false ?expires:None ?same_site:None
288288+ ~secure:false ~http_only:false ?expires:None ?same_site:None ?max_age:None
272289 ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get)
273290 ~last_access:(Ptime.of_float_s 1000.0 |> Option.get)
274291 ()
···289306 let cookies = get_all_cookies jar in
290307 let names = List.map Cookeio.name cookies |> List.sort String.compare in
291308 Alcotest.(check (list string))
292292- "remaining cookies after 1600s" [ "expires_later"; "session" ] names;
309309+ "remaining cookies after 1600s"
310310+ [ "expires_later"; "session" ]
311311+ names;
293312294313 (* Advance time to 2100.0 - second cookie should expire *)
295314 Eio_mock.Clock.set_time clock 2100.0;
···298317 Alcotest.(check int) "after second expiry" 1 (count jar);
299318300319 let remaining = get_all_cookies jar in
301301- Alcotest.(check string) "only session cookie remains" "session"
320320+ Alcotest.(check string)
321321+ "only session cookie remains" "session"
302322 (Cookeio.name (List.hd remaining))
303323304324let test_max_age_parsing_with_mock_clock () =
···345365 (* Add a cookie *)
346366 let cookie =
347367 Cookeio.make ~domain:"example.com" ~path:"/" ~name:"test" ~value:"value"
348348- ~secure:false ~http_only:false ?expires:None ?same_site:None
368368+ ~secure:false ~http_only:false ?expires:None ?same_site:None ?max_age:None
349369 ~creation_time:(Ptime.of_float_s 3000.0 |> Option.get)
350370 ~last_access:(Ptime.of_float_s 3000.0 |> Option.get)
351371 ()
···394414 let cookie = Option.get cookie_opt in
395415 Alcotest.(check string) "cookie name" "id" (Cookeio.name cookie);
396416 Alcotest.(check string) "cookie value" "xyz789" (Cookeio.value cookie);
397397- Alcotest.(check string) "cookie domain" ".example.com" (Cookeio.domain cookie);
417417+ Alcotest.(check string) "cookie domain" "example.com" (Cookeio.domain cookie);
398418 Alcotest.(check string) "cookie path" "/" (Cookeio.path cookie);
399419400420 (* Verify expires is parsed correctly *)
401401- Alcotest.(check bool) "has expiry" true
421421+ Alcotest.(check bool)
422422+ "has expiry" true
402423 (Option.is_some (Cookeio.expires cookie));
403424404425 (* Verify the specific expiry time parsed from the RFC3339 date *)
···422443 parse_set_cookie ~clock ~domain:"example.com" ~path:"/" invalid_header
423444 in
424445425425- Alcotest.(check bool) "invalid cookie rejected" true (Option.is_none cookie_opt);
446446+ Alcotest.(check bool)
447447+ "invalid cookie rejected" true
448448+ (Option.is_none cookie_opt);
426449427450 (* This should be accepted: SameSite=None with Secure *)
428451 let valid_header = "token=abc; SameSite=None; Secure" in
···430453 parse_set_cookie ~clock ~domain:"example.com" ~path:"/" valid_header
431454 in
432455433433- Alcotest.(check bool) "valid cookie accepted" true (Option.is_some cookie_opt2);
456456+ Alcotest.(check bool)
457457+ "valid cookie accepted" true
458458+ (Option.is_some cookie_opt2);
434459435460 let cookie = Option.get cookie_opt2 in
436461 Alcotest.(check bool) "cookie is secure" true (Cookeio.secure cookie);
···445470 ( = ))))
446471 "samesite is None" (Some `None) (Cookeio.same_site cookie)
447472473473+let test_domain_normalization () =
474474+ Eio_mock.Backend.run @@ fun () ->
475475+ let clock = Eio_mock.Clock.make () in
476476+ Eio_mock.Clock.set_time clock 1000.0;
477477+478478+ (* Test parsing ".example.com" stores as "example.com" *)
479479+ let header = "test=value; Domain=.example.com" in
480480+ let cookie_opt =
481481+ parse_set_cookie ~clock ~domain:"example.com" ~path:"/" header
482482+ in
483483+ Alcotest.(check bool) "cookie parsed" true (Option.is_some cookie_opt);
484484+ let cookie = Option.get cookie_opt in
485485+ Alcotest.(check string)
486486+ "domain normalized" "example.com" (Cookeio.domain cookie);
487487+488488+ (* Test round-trip through Mozilla format normalizes domains *)
489489+ let jar = create () in
490490+ let test_cookie =
491491+ Cookeio.make ~domain:".example.com" ~path:"/" ~name:"test" ~value:"val"
492492+ ~secure:false ~http_only:false ?expires:None ?same_site:None ?max_age:None
493493+ ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get)
494494+ ~last_access:(Ptime.of_float_s 1000.0 |> Option.get)
495495+ ()
496496+ in
497497+ add_cookie jar test_cookie;
498498+499499+ let mozilla_format = to_mozilla_format jar in
500500+ let jar2 = from_mozilla_format ~clock mozilla_format in
501501+ let cookies2 = get_all_cookies jar2 in
502502+ Alcotest.(check int) "one cookie" 1 (List.length cookies2);
503503+ Alcotest.(check string)
504504+ "domain normalized after round-trip" "example.com"
505505+ (Cookeio.domain (List.hd cookies2))
506506+507507+let test_max_age_stored_separately () =
508508+ Eio_mock.Backend.run @@ fun () ->
509509+ let clock = Eio_mock.Clock.make () in
510510+ Eio_mock.Clock.set_time clock 5000.0;
511511+512512+ (* Parse a Set-Cookie header with Max-Age *)
513513+ let header = "session=abc123; Max-Age=3600" in
514514+ let cookie_opt =
515515+ parse_set_cookie ~clock ~domain:"example.com" ~path:"/" header
516516+ in
517517+ Alcotest.(check bool) "cookie parsed" true (Option.is_some cookie_opt);
518518+519519+ let cookie = Option.get cookie_opt in
520520+521521+ (* Verify max_age is stored as a Ptime.Span *)
522522+ Alcotest.(check bool)
523523+ "max_age is set" true
524524+ (Option.is_some (Cookeio.max_age cookie));
525525+ let max_age_span = Option.get (Cookeio.max_age cookie) in
526526+ Alcotest.(check (option int))
527527+ "max_age is 3600 seconds" (Some 3600)
528528+ (Ptime.Span.to_int_s max_age_span);
529529+530530+ (* Verify expires is also computed correctly *)
531531+ let expected_expiry = Ptime.of_float_s 8600.0 in
532532+ Alcotest.(check (option (Alcotest.testable Ptime.pp Ptime.equal)))
533533+ "expires computed from max-age" expected_expiry (Cookeio.expires cookie)
534534+535535+let test_max_age_negative_becomes_zero () =
536536+ Eio_mock.Backend.run @@ fun () ->
537537+ let clock = Eio_mock.Clock.make () in
538538+ Eio_mock.Clock.set_time clock 5000.0;
539539+540540+ (* Parse a Set-Cookie header with negative Max-Age *)
541541+ let header = "session=abc123; Max-Age=-100" in
542542+ let cookie_opt =
543543+ parse_set_cookie ~clock ~domain:"example.com" ~path:"/" header
544544+ in
545545+ Alcotest.(check bool) "cookie parsed" true (Option.is_some cookie_opt);
546546+547547+ let cookie = Option.get cookie_opt in
548548+549549+ (* Verify max_age is stored as 0 per RFC 6265 *)
550550+ Alcotest.(check bool)
551551+ "max_age is set" true
552552+ (Option.is_some (Cookeio.max_age cookie));
553553+ let max_age_span = Option.get (Cookeio.max_age cookie) in
554554+ Alcotest.(check (option int))
555555+ "negative max_age becomes 0" (Some 0)
556556+ (Ptime.Span.to_int_s max_age_span);
557557+558558+ (* Verify expires is computed with 0 seconds *)
559559+ let expected_expiry = Ptime.of_float_s 5000.0 in
560560+ Alcotest.(check (option (Alcotest.testable Ptime.pp Ptime.equal)))
561561+ "expires computed with 0 seconds" expected_expiry (Cookeio.expires cookie)
562562+563563+let string_contains_substring s sub =
564564+ try
565565+ let len = String.length sub in
566566+ let rec search i =
567567+ if i + len > String.length s then false
568568+ else if String.sub s i len = sub then true
569569+ else search (i + 1)
570570+ in
571571+ search 0
572572+ with _ -> false
573573+574574+let test_make_set_cookie_header_includes_max_age () =
575575+ Eio_mock.Backend.run @@ fun () ->
576576+ let clock = Eio_mock.Clock.make () in
577577+ Eio_mock.Clock.set_time clock 5000.0;
578578+579579+ (* Create a cookie with max_age *)
580580+ let max_age_span = Ptime.Span.of_int_s 3600 in
581581+ let expires_time = Ptime.of_float_s 8600.0 |> Option.get in
582582+ let cookie =
583583+ Cookeio.make ~domain:"example.com" ~path:"/" ~name:"session" ~value:"abc123"
584584+ ~secure:true ~http_only:true ?expires:(Some expires_time)
585585+ ?max_age:(Some max_age_span) ?same_site:(Some `Strict)
586586+ ~creation_time:(Ptime.of_float_s 5000.0 |> Option.get)
587587+ ~last_access:(Ptime.of_float_s 5000.0 |> Option.get)
588588+ ()
589589+ in
590590+591591+ let header = make_set_cookie_header cookie in
592592+593593+ (* Verify the header includes Max-Age *)
594594+ Alcotest.(check bool)
595595+ "header includes Max-Age" true
596596+ (string_contains_substring header "Max-Age=3600");
597597+598598+ (* Verify the header includes Expires *)
599599+ Alcotest.(check bool)
600600+ "header includes Expires" true
601601+ (string_contains_substring header "Expires=");
602602+603603+ (* Verify the header includes other attributes *)
604604+ Alcotest.(check bool)
605605+ "header includes Secure" true
606606+ (string_contains_substring header "Secure");
607607+ Alcotest.(check bool)
608608+ "header includes HttpOnly" true
609609+ (string_contains_substring header "HttpOnly");
610610+ Alcotest.(check bool)
611611+ "header includes SameSite" true
612612+ (string_contains_substring header "SameSite=Strict")
613613+614614+let test_max_age_round_trip () =
615615+ Eio_mock.Backend.run @@ fun () ->
616616+ let clock = Eio_mock.Clock.make () in
617617+ Eio_mock.Clock.set_time clock 5000.0;
618618+619619+ (* Parse a cookie with Max-Age *)
620620+ let header = "session=xyz; Max-Age=7200; Secure; HttpOnly" in
621621+ let cookie_opt =
622622+ parse_set_cookie ~clock ~domain:"example.com" ~path:"/" header
623623+ in
624624+ Alcotest.(check bool) "cookie parsed" true (Option.is_some cookie_opt);
625625+ let cookie = Option.get cookie_opt in
626626+627627+ (* Generate Set-Cookie header from the cookie *)
628628+ let set_cookie_header = make_set_cookie_header cookie in
629629+630630+ (* Parse it back *)
631631+ Eio_mock.Clock.set_time clock 5000.0;
632632+ (* Reset clock to same time *)
633633+ let cookie2_opt =
634634+ parse_set_cookie ~clock ~domain:"example.com" ~path:"/" set_cookie_header
635635+ in
636636+ Alcotest.(check bool) "cookie re-parsed" true (Option.is_some cookie2_opt);
637637+ let cookie2 = Option.get cookie2_opt in
638638+639639+ (* Verify max_age is preserved *)
640640+ Alcotest.(check (option int))
641641+ "max_age preserved"
642642+ (Ptime.Span.to_int_s (Option.get (Cookeio.max_age cookie)))
643643+ (Ptime.Span.to_int_s (Option.get (Cookeio.max_age cookie2)))
644644+645645+let test_domain_matching () =
646646+ Eio_mock.Backend.run @@ fun () ->
647647+ let clock = Eio_mock.Clock.make () in
648648+ Eio_mock.Clock.set_time clock 2000.0;
649649+650650+ let jar = create () in
651651+652652+ (* Create a cookie with domain "example.com" *)
653653+ let cookie =
654654+ Cookeio.make ~domain:"example.com" ~path:"/" ~name:"test" ~value:"value"
655655+ ~secure:false ~http_only:false ?expires:None ?same_site:None ?max_age:None
656656+ ~creation_time:(Ptime.of_float_s 2000.0 |> Option.get)
657657+ ~last_access:(Ptime.of_float_s 2000.0 |> Option.get)
658658+ ()
659659+ in
660660+ add_cookie jar cookie;
661661+662662+ (* Test "example.com" cookie matches "example.com" request *)
663663+ let cookies1 =
664664+ get_cookies jar ~clock ~domain:"example.com" ~path:"/" ~is_secure:false
665665+ in
666666+ Alcotest.(check int) "matches exact domain" 1 (List.length cookies1);
667667+668668+ (* Test "example.com" cookie matches "sub.example.com" request *)
669669+ let cookies2 =
670670+ get_cookies jar ~clock ~domain:"sub.example.com" ~path:"/" ~is_secure:false
671671+ in
672672+ Alcotest.(check int) "matches subdomain" 1 (List.length cookies2);
673673+674674+ (* Test "example.com" cookie matches "deep.sub.example.com" request *)
675675+ let cookies3 =
676676+ get_cookies jar ~clock ~domain:"deep.sub.example.com" ~path:"/"
677677+ ~is_secure:false
678678+ in
679679+ Alcotest.(check int) "matches deep subdomain" 1 (List.length cookies3);
680680+681681+ (* Test "example.com" cookie doesn't match "notexample.com" *)
682682+ let cookies4 =
683683+ get_cookies jar ~clock ~domain:"notexample.com" ~path:"/" ~is_secure:false
684684+ in
685685+ Alcotest.(check int) "doesn't match different domain" 0 (List.length cookies4);
686686+687687+ (* Test "example.com" cookie doesn't match "fakeexample.com" *)
688688+ let cookies5 =
689689+ get_cookies jar ~clock ~domain:"fakeexample.com" ~path:"/" ~is_secure:false
690690+ in
691691+ Alcotest.(check int) "doesn't match prefix domain" 0 (List.length cookies5)
692692+693693+(** {1 HTTP Date Parsing Tests} *)
694694+695695+let test_http_date_fmt1 () =
696696+ Eio_mock.Backend.run @@ fun () ->
697697+ let clock = Eio_mock.Clock.make () in
698698+ Eio_mock.Clock.set_time clock 1000.0;
699699+700700+ (* Test FMT1: "Wed, 21 Oct 2015 07:28:00 GMT" (RFC 1123) *)
701701+ let header = "session=abc; Expires=Wed, 21 Oct 2015 07:28:00 GMT" in
702702+ let cookie_opt =
703703+ parse_set_cookie ~clock ~domain:"example.com" ~path:"/" header
704704+ in
705705+ Alcotest.(check bool) "FMT1 cookie parsed" true (Option.is_some cookie_opt);
706706+707707+ let cookie = Option.get cookie_opt in
708708+ Alcotest.(check bool)
709709+ "FMT1 has expiry" true
710710+ (Option.is_some (Cookeio.expires cookie));
711711+712712+ (* Verify the parsed time matches expected value *)
713713+ let expected = Ptime.of_date_time ((2015, 10, 21), ((07, 28, 00), 0)) in
714714+ Alcotest.(check (option (Alcotest.testable Ptime.pp Ptime.equal)))
715715+ "FMT1 expiry correct" expected (Cookeio.expires cookie)
716716+717717+let test_http_date_fmt2 () =
718718+ Eio_mock.Backend.run @@ fun () ->
719719+ let clock = Eio_mock.Clock.make () in
720720+ Eio_mock.Clock.set_time clock 1000.0;
721721+722722+ (* Test FMT2: "Wednesday, 21-Oct-15 07:28:00 GMT" (RFC 850 with abbreviated year) *)
723723+ let header = "session=abc; Expires=Wednesday, 21-Oct-15 07:28:00 GMT" in
724724+ let cookie_opt =
725725+ parse_set_cookie ~clock ~domain:"example.com" ~path:"/" header
726726+ in
727727+ Alcotest.(check bool) "FMT2 cookie parsed" true (Option.is_some cookie_opt);
728728+729729+ let cookie = Option.get cookie_opt in
730730+ Alcotest.(check bool)
731731+ "FMT2 has expiry" true
732732+ (Option.is_some (Cookeio.expires cookie));
733733+734734+ (* Year 15 should be normalized to 2015 *)
735735+ let expected = Ptime.of_date_time ((2015, 10, 21), ((07, 28, 00), 0)) in
736736+ Alcotest.(check (option (Alcotest.testable Ptime.pp Ptime.equal)))
737737+ "FMT2 expiry correct with year normalization" expected
738738+ (Cookeio.expires cookie)
739739+740740+let test_http_date_fmt3 () =
741741+ Eio_mock.Backend.run @@ fun () ->
742742+ let clock = Eio_mock.Clock.make () in
743743+ Eio_mock.Clock.set_time clock 1000.0;
744744+745745+ (* Test FMT3: "Wed Oct 21 07:28:00 2015" (asctime) *)
746746+ let header = "session=abc; Expires=Wed Oct 21 07:28:00 2015" in
747747+ let cookie_opt =
748748+ parse_set_cookie ~clock ~domain:"example.com" ~path:"/" header
749749+ in
750750+ Alcotest.(check bool) "FMT3 cookie parsed" true (Option.is_some cookie_opt);
751751+752752+ let cookie = Option.get cookie_opt in
753753+ Alcotest.(check bool)
754754+ "FMT3 has expiry" true
755755+ (Option.is_some (Cookeio.expires cookie));
756756+757757+ let expected = Ptime.of_date_time ((2015, 10, 21), ((07, 28, 00), 0)) in
758758+ Alcotest.(check (option (Alcotest.testable Ptime.pp Ptime.equal)))
759759+ "FMT3 expiry correct" expected (Cookeio.expires cookie)
760760+761761+let test_http_date_fmt4 () =
762762+ Eio_mock.Backend.run @@ fun () ->
763763+ let clock = Eio_mock.Clock.make () in
764764+ Eio_mock.Clock.set_time clock 1000.0;
765765+766766+ (* Test FMT4: "Wed, 21-Oct-2015 07:28:00 GMT" (variant) *)
767767+ let header = "session=abc; Expires=Wed, 21-Oct-2015 07:28:00 GMT" in
768768+ let cookie_opt =
769769+ parse_set_cookie ~clock ~domain:"example.com" ~path:"/" header
770770+ in
771771+ Alcotest.(check bool) "FMT4 cookie parsed" true (Option.is_some cookie_opt);
772772+773773+ let cookie = Option.get cookie_opt in
774774+ Alcotest.(check bool)
775775+ "FMT4 has expiry" true
776776+ (Option.is_some (Cookeio.expires cookie));
777777+778778+ let expected = Ptime.of_date_time ((2015, 10, 21), ((07, 28, 00), 0)) in
779779+ Alcotest.(check (option (Alcotest.testable Ptime.pp Ptime.equal)))
780780+ "FMT4 expiry correct" expected (Cookeio.expires cookie)
781781+782782+let test_abbreviated_year_69_to_99 () =
783783+ Eio_mock.Backend.run @@ fun () ->
784784+ let clock = Eio_mock.Clock.make () in
785785+ Eio_mock.Clock.set_time clock 1000.0;
786786+787787+ (* Year 95 should become 1995 *)
788788+ let header = "session=abc; Expires=Wed, 21-Oct-95 07:28:00 GMT" in
789789+ let cookie_opt =
790790+ parse_set_cookie ~clock ~domain:"example.com" ~path:"/" header
791791+ in
792792+ let cookie = Option.get cookie_opt in
793793+ let expected = Ptime.of_date_time ((1995, 10, 21), ((07, 28, 00), 0)) in
794794+ Alcotest.(check (option (Alcotest.testable Ptime.pp Ptime.equal)))
795795+ "year 95 becomes 1995" expected (Cookeio.expires cookie);
796796+797797+ (* Year 69 should become 1969 *)
798798+ let header2 = "session=abc; Expires=Wed, 10-Sep-69 20:00:00 GMT" in
799799+ let cookie_opt2 =
800800+ parse_set_cookie ~clock ~domain:"example.com" ~path:"/" header2
801801+ in
802802+ let cookie2 = Option.get cookie_opt2 in
803803+ let expected2 = Ptime.of_date_time ((1969, 9, 10), ((20, 0, 0), 0)) in
804804+ Alcotest.(check (option (Alcotest.testable Ptime.pp Ptime.equal)))
805805+ "year 69 becomes 1969" expected2 (Cookeio.expires cookie2);
806806+807807+ (* Year 99 should become 1999 *)
808808+ let header3 = "session=abc; Expires=Thu, 10-Sep-99 20:00:00 GMT" in
809809+ let cookie_opt3 =
810810+ parse_set_cookie ~clock ~domain:"example.com" ~path:"/" header3
811811+ in
812812+ let cookie3 = Option.get cookie_opt3 in
813813+ let expected3 = Ptime.of_date_time ((1999, 9, 10), ((20, 0, 0), 0)) in
814814+ Alcotest.(check (option (Alcotest.testable Ptime.pp Ptime.equal)))
815815+ "year 99 becomes 1999" expected3 (Cookeio.expires cookie3)
816816+817817+let test_abbreviated_year_0_to_68 () =
818818+ Eio_mock.Backend.run @@ fun () ->
819819+ let clock = Eio_mock.Clock.make () in
820820+ Eio_mock.Clock.set_time clock 1000.0;
821821+822822+ (* Year 25 should become 2025 *)
823823+ let header = "session=abc; Expires=Wed, 21-Oct-25 07:28:00 GMT" in
824824+ let cookie_opt =
825825+ parse_set_cookie ~clock ~domain:"example.com" ~path:"/" header
826826+ in
827827+ let cookie = Option.get cookie_opt in
828828+ let expected = Ptime.of_date_time ((2025, 10, 21), ((07, 28, 00), 0)) in
829829+ Alcotest.(check (option (Alcotest.testable Ptime.pp Ptime.equal)))
830830+ "year 25 becomes 2025" expected (Cookeio.expires cookie);
831831+832832+ (* Year 0 should become 2000 *)
833833+ let header2 = "session=abc; Expires=Fri, 01-Jan-00 00:00:00 GMT" in
834834+ let cookie_opt2 =
835835+ parse_set_cookie ~clock ~domain:"example.com" ~path:"/" header2
836836+ in
837837+ let cookie2 = Option.get cookie_opt2 in
838838+ let expected2 = Ptime.of_date_time ((2000, 1, 1), ((0, 0, 0), 0)) in
839839+ Alcotest.(check (option (Alcotest.testable Ptime.pp Ptime.equal)))
840840+ "year 0 becomes 2000" expected2 (Cookeio.expires cookie2);
841841+842842+ (* Year 68 should become 2068 *)
843843+ let header3 = "session=abc; Expires=Thu, 10-Sep-68 20:00:00 GMT" in
844844+ let cookie_opt3 =
845845+ parse_set_cookie ~clock ~domain:"example.com" ~path:"/" header3
846846+ in
847847+ let cookie3 = Option.get cookie_opt3 in
848848+ let expected3 = Ptime.of_date_time ((2068, 9, 10), ((20, 0, 0), 0)) in
849849+ Alcotest.(check (option (Alcotest.testable Ptime.pp Ptime.equal)))
850850+ "year 68 becomes 2068" expected3 (Cookeio.expires cookie3)
851851+852852+let test_rfc3339_still_works () =
853853+ Eio_mock.Backend.run @@ fun () ->
854854+ let clock = Eio_mock.Clock.make () in
855855+ Eio_mock.Clock.set_time clock 1000.0;
856856+857857+ (* Ensure RFC 3339 format still works for backward compatibility *)
858858+ let header = "session=abc; Expires=2025-10-21T07:28:00Z" in
859859+ let cookie_opt =
860860+ parse_set_cookie ~clock ~domain:"example.com" ~path:"/" header
861861+ in
862862+ Alcotest.(check bool)
863863+ "RFC 3339 cookie parsed" true
864864+ (Option.is_some cookie_opt);
865865+866866+ let cookie = Option.get cookie_opt in
867867+ Alcotest.(check bool)
868868+ "RFC 3339 has expiry" true
869869+ (Option.is_some (Cookeio.expires cookie));
870870+871871+ (* Verify the time was parsed correctly *)
872872+ let expected = Ptime.of_rfc3339 "2025-10-21T07:28:00Z" in
873873+ match expected with
874874+ | Ok (time, _, _) ->
875875+ Alcotest.(check (option (Alcotest.testable Ptime.pp Ptime.equal)))
876876+ "RFC 3339 expiry correct" (Some time) (Cookeio.expires cookie)
877877+ | Error _ -> Alcotest.fail "Failed to parse expected RFC 3339 time"
878878+879879+let test_invalid_date_format_logs_warning () =
880880+ Eio_mock.Backend.run @@ fun () ->
881881+ let clock = Eio_mock.Clock.make () in
882882+ Eio_mock.Clock.set_time clock 1000.0;
883883+884884+ (* Invalid date format should log a warning but still parse the cookie *)
885885+ let header = "session=abc; Expires=InvalidDate" in
886886+ let cookie_opt =
887887+ parse_set_cookie ~clock ~domain:"example.com" ~path:"/" header
888888+ in
889889+890890+ (* Cookie should still be parsed, just without expires *)
891891+ Alcotest.(check bool)
892892+ "cookie parsed despite invalid date" true
893893+ (Option.is_some cookie_opt);
894894+ let cookie = Option.get cookie_opt in
895895+ Alcotest.(check string) "cookie name correct" "session" (Cookeio.name cookie);
896896+ Alcotest.(check string) "cookie value correct" "abc" (Cookeio.value cookie);
897897+ (* expires should be None since date was invalid *)
898898+ Alcotest.(check (option (Alcotest.testable Ptime.pp Ptime.equal)))
899899+ "expires is None for invalid date" None (Cookeio.expires cookie)
900900+901901+let test_case_insensitive_month_parsing () =
902902+ Eio_mock.Backend.run @@ fun () ->
903903+ let clock = Eio_mock.Clock.make () in
904904+ Eio_mock.Clock.set_time clock 1000.0;
905905+906906+ (* Test various case combinations for month names *)
907907+ let test_cases =
908908+ [
909909+ ("session=abc; Expires=Wed, 21 oct 2015 07:28:00 GMT", "lowercase month");
910910+ ("session=abc; Expires=Wed, 21 OCT 2015 07:28:00 GMT", "uppercase month");
911911+ ("session=abc; Expires=Wed, 21 OcT 2015 07:28:00 GMT", "mixed case month");
912912+ ("session=abc; Expires=Wed, 21 oCt 2015 07:28:00 GMT", "weird case month");
913913+ ]
914914+ in
915915+916916+ List.iter
917917+ (fun (header, description) ->
918918+ let cookie_opt =
919919+ parse_set_cookie ~clock ~domain:"example.com" ~path:"/" header
920920+ in
921921+ Alcotest.(check bool)
922922+ (description ^ " parsed") true
923923+ (Option.is_some cookie_opt);
924924+925925+ let cookie = Option.get cookie_opt in
926926+ Alcotest.(check bool)
927927+ (description ^ " has expiry")
928928+ true
929929+ (Option.is_some (Cookeio.expires cookie));
930930+931931+ (* Verify the date was parsed correctly regardless of case *)
932932+ let expires = Option.get (Cookeio.expires cookie) in
933933+ let year, month, _ = Ptime.to_date expires in
934934+ Alcotest.(check int) (description ^ " year correct") 2015 year;
935935+ Alcotest.(check int)
936936+ (description ^ " month correct (October=10)")
937937+ 10 month)
938938+ test_cases
939939+940940+let test_case_insensitive_gmt_parsing () =
941941+ Eio_mock.Backend.run @@ fun () ->
942942+ let clock = Eio_mock.Clock.make () in
943943+ Eio_mock.Clock.set_time clock 1000.0;
944944+945945+ (* Test various case combinations for GMT timezone *)
946946+ let test_cases =
947947+ [
948948+ ("session=abc; Expires=Wed, 21 Oct 2015 07:28:00 GMT", "uppercase GMT");
949949+ ("session=abc; Expires=Wed, 21 Oct 2015 07:28:00 gmt", "lowercase gmt");
950950+ ("session=abc; Expires=Wed, 21 Oct 2015 07:28:00 Gmt", "mixed case Gmt");
951951+ ("session=abc; Expires=Wed, 21 Oct 2015 07:28:00 GmT", "weird case GmT");
952952+ ]
953953+ in
954954+955955+ List.iter
956956+ (fun (header, description) ->
957957+ let cookie_opt =
958958+ parse_set_cookie ~clock ~domain:"example.com" ~path:"/" header
959959+ in
960960+ Alcotest.(check bool)
961961+ (description ^ " parsed") true
962962+ (Option.is_some cookie_opt);
963963+964964+ let cookie = Option.get cookie_opt in
965965+ Alcotest.(check bool)
966966+ (description ^ " has expiry")
967967+ true
968968+ (Option.is_some (Cookeio.expires cookie));
969969+970970+ (* Verify the date was parsed correctly regardless of GMT case *)
971971+ let expires = Option.get (Cookeio.expires cookie) in
972972+ let year, month, day = Ptime.to_date expires in
973973+ Alcotest.(check int) (description ^ " year correct") 2015 year;
974974+ Alcotest.(check int)
975975+ (description ^ " month correct (October=10)")
976976+ 10 month;
977977+ Alcotest.(check int) (description ^ " day correct") 21 day)
978978+ test_cases
979979+980980+(** {1 Delta Tracking Tests} *)
981981+982982+let test_add_original_not_in_delta () =
983983+ Eio_mock.Backend.run @@ fun () ->
984984+ let clock = Eio_mock.Clock.make () in
985985+ Eio_mock.Clock.set_time clock 1000.0;
986986+987987+ let jar = create () in
988988+ let cookie =
989989+ Cookeio.make ~domain:"example.com" ~path:"/" ~name:"test" ~value:"value"
990990+ ~secure:false ~http_only:false ?expires:None ?same_site:None ?max_age:None
991991+ ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get)
992992+ ~last_access:(Ptime.of_float_s 1000.0 |> Option.get)
993993+ ()
994994+ in
995995+ add_original jar cookie;
996996+997997+ (* Delta should be empty *)
998998+ let delta = Cookeio.delta jar in
999999+ Alcotest.(check int) "delta is empty" 0 (List.length delta);
10001000+10011001+ (* But the cookie should be in the jar *)
10021002+ Alcotest.(check int) "jar count is 1" 1 (count jar)
10031003+10041004+let test_add_cookie_appears_in_delta () =
10051005+ Eio_mock.Backend.run @@ fun () ->
10061006+ let clock = Eio_mock.Clock.make () in
10071007+ Eio_mock.Clock.set_time clock 1000.0;
10081008+10091009+ let jar = create () in
10101010+ let cookie =
10111011+ Cookeio.make ~domain:"example.com" ~path:"/" ~name:"test" ~value:"value"
10121012+ ~secure:false ~http_only:false ?expires:None ?same_site:None ?max_age:None
10131013+ ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get)
10141014+ ~last_access:(Ptime.of_float_s 1000.0 |> Option.get)
10151015+ ()
10161016+ in
10171017+ add_cookie jar cookie;
10181018+10191019+ (* Delta should contain the cookie *)
10201020+ let delta = Cookeio.delta jar in
10211021+ Alcotest.(check int) "delta has 1 cookie" 1 (List.length delta);
10221022+ let delta_cookie = List.hd delta in
10231023+ Alcotest.(check string) "delta cookie name" "test" (Cookeio.name delta_cookie);
10241024+ Alcotest.(check string)
10251025+ "delta cookie value" "value"
10261026+ (Cookeio.value delta_cookie)
10271027+10281028+let test_remove_original_creates_removal_cookie () =
10291029+ Eio_mock.Backend.run @@ fun () ->
10301030+ let clock = Eio_mock.Clock.make () in
10311031+ Eio_mock.Clock.set_time clock 1000.0;
10321032+10331033+ let jar = create () in
10341034+ let cookie =
10351035+ Cookeio.make ~domain:"example.com" ~path:"/" ~name:"test" ~value:"value"
10361036+ ~secure:false ~http_only:false ?expires:None ?same_site:None ?max_age:None
10371037+ ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get)
10381038+ ~last_access:(Ptime.of_float_s 1000.0 |> Option.get)
10391039+ ()
10401040+ in
10411041+ add_original jar cookie;
10421042+10431043+ (* Remove the cookie *)
10441044+ Cookeio.remove jar ~clock cookie;
10451045+10461046+ (* Delta should contain a removal cookie *)
10471047+ let delta = Cookeio.delta jar in
10481048+ Alcotest.(check int) "delta has 1 removal cookie" 1 (List.length delta);
10491049+ let removal_cookie = List.hd delta in
10501050+ Alcotest.(check string)
10511051+ "removal cookie name" "test"
10521052+ (Cookeio.name removal_cookie);
10531053+ Alcotest.(check string)
10541054+ "removal cookie has empty value" ""
10551055+ (Cookeio.value removal_cookie);
10561056+10571057+ (* Check Max-Age is 0 *)
10581058+ match Cookeio.max_age removal_cookie with
10591059+ | Some span ->
10601060+ Alcotest.(check (option int))
10611061+ "removal cookie Max-Age is 0" (Some 0) (Ptime.Span.to_int_s span)
10621062+ | None -> Alcotest.fail "removal cookie should have Max-Age"
10631063+10641064+let test_remove_delta_cookie_removes_it () =
10651065+ Eio_mock.Backend.run @@ fun () ->
10661066+ let clock = Eio_mock.Clock.make () in
10671067+ Eio_mock.Clock.set_time clock 1000.0;
10681068+10691069+ let jar = create () in
10701070+ let cookie =
10711071+ Cookeio.make ~domain:"example.com" ~path:"/" ~name:"test" ~value:"value"
10721072+ ~secure:false ~http_only:false ?expires:None ?same_site:None ?max_age:None
10731073+ ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get)
10741074+ ~last_access:(Ptime.of_float_s 1000.0 |> Option.get)
10751075+ ()
10761076+ in
10771077+ add_cookie jar cookie;
10781078+10791079+ (* Remove the cookie *)
10801080+ Cookeio.remove jar ~clock cookie;
10811081+10821082+ (* Delta should be empty *)
10831083+ let delta = Cookeio.delta jar in
10841084+ Alcotest.(check int)
10851085+ "delta is empty after removing delta cookie" 0 (List.length delta)
10861086+10871087+let test_get_cookies_combines_original_and_delta () =
10881088+ Eio_mock.Backend.run @@ fun () ->
10891089+ let clock = Eio_mock.Clock.make () in
10901090+ Eio_mock.Clock.set_time clock 1000.0;
10911091+10921092+ let jar = create () in
10931093+10941094+ (* Add an original cookie *)
10951095+ let original =
10961096+ Cookeio.make ~domain:"example.com" ~path:"/" ~name:"original"
10971097+ ~value:"orig_val" ~secure:false ~http_only:false ?expires:None
10981098+ ?same_site:None ?max_age:None
10991099+ ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get)
11001100+ ~last_access:(Ptime.of_float_s 1000.0 |> Option.get)
11011101+ ()
11021102+ in
11031103+ add_original jar original;
11041104+11051105+ (* Add a delta cookie *)
11061106+ let delta_cookie =
11071107+ Cookeio.make ~domain:"example.com" ~path:"/" ~name:"delta"
11081108+ ~value:"delta_val" ~secure:false ~http_only:false ?expires:None
11091109+ ?same_site:None ?max_age:None
11101110+ ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get)
11111111+ ~last_access:(Ptime.of_float_s 1000.0 |> Option.get)
11121112+ ()
11131113+ in
11141114+ add_cookie jar delta_cookie;
11151115+11161116+ (* Get cookies should return both *)
11171117+ let cookies =
11181118+ get_cookies jar ~clock ~domain:"example.com" ~path:"/" ~is_secure:false
11191119+ in
11201120+ Alcotest.(check int) "both cookies returned" 2 (List.length cookies);
11211121+11221122+ let names = List.map Cookeio.name cookies |> List.sort String.compare in
11231123+ Alcotest.(check (list string)) "cookie names" [ "delta"; "original" ] names
11241124+11251125+let test_get_cookies_delta_takes_precedence () =
11261126+ Eio_mock.Backend.run @@ fun () ->
11271127+ let clock = Eio_mock.Clock.make () in
11281128+ Eio_mock.Clock.set_time clock 1000.0;
11291129+11301130+ let jar = create () in
11311131+11321132+ (* Add an original cookie *)
11331133+ let original =
11341134+ Cookeio.make ~domain:"example.com" ~path:"/" ~name:"test" ~value:"orig_val"
11351135+ ~secure:false ~http_only:false ?expires:None ?same_site:None ?max_age:None
11361136+ ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get)
11371137+ ~last_access:(Ptime.of_float_s 1000.0 |> Option.get)
11381138+ ()
11391139+ in
11401140+ add_original jar original;
11411141+11421142+ (* Add a delta cookie with the same name/domain/path *)
11431143+ let delta_cookie =
11441144+ Cookeio.make ~domain:"example.com" ~path:"/" ~name:"test" ~value:"delta_val"
11451145+ ~secure:false ~http_only:false ?expires:None ?same_site:None ?max_age:None
11461146+ ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get)
11471147+ ~last_access:(Ptime.of_float_s 1000.0 |> Option.get)
11481148+ ()
11491149+ in
11501150+ add_cookie jar delta_cookie;
11511151+11521152+ (* Get cookies should return only the delta cookie *)
11531153+ let cookies =
11541154+ get_cookies jar ~clock ~domain:"example.com" ~path:"/" ~is_secure:false
11551155+ in
11561156+ Alcotest.(check int) "only one cookie returned" 1 (List.length cookies);
11571157+ let cookie = List.hd cookies in
11581158+ Alcotest.(check string)
11591159+ "delta cookie value" "delta_val" (Cookeio.value cookie)
11601160+11611161+let test_get_cookies_excludes_removal_cookies () =
11621162+ Eio_mock.Backend.run @@ fun () ->
11631163+ let clock = Eio_mock.Clock.make () in
11641164+ Eio_mock.Clock.set_time clock 1000.0;
11651165+11661166+ let jar = create () in
11671167+11681168+ (* Add an original cookie *)
11691169+ let original =
11701170+ Cookeio.make ~domain:"example.com" ~path:"/" ~name:"test" ~value:"value"
11711171+ ~secure:false ~http_only:false ?expires:None ?same_site:None ?max_age:None
11721172+ ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get)
11731173+ ~last_access:(Ptime.of_float_s 1000.0 |> Option.get)
11741174+ ()
11751175+ in
11761176+ add_original jar original;
11771177+11781178+ (* Remove it *)
11791179+ Cookeio.remove jar ~clock original;
11801180+11811181+ (* Get cookies should return nothing *)
11821182+ let cookies =
11831183+ get_cookies jar ~clock ~domain:"example.com" ~path:"/" ~is_secure:false
11841184+ in
11851185+ Alcotest.(check int) "no cookies returned" 0 (List.length cookies);
11861186+11871187+ (* But delta should have the removal cookie *)
11881188+ let delta = Cookeio.delta jar in
11891189+ Alcotest.(check int) "delta has removal cookie" 1 (List.length delta)
11901190+11911191+let test_delta_returns_only_changed_cookies () =
11921192+ Eio_mock.Backend.run @@ fun () ->
11931193+ let clock = Eio_mock.Clock.make () in
11941194+ Eio_mock.Clock.set_time clock 1000.0;
11951195+11961196+ let jar = create () in
11971197+11981198+ (* Add original cookies *)
11991199+ let original1 =
12001200+ Cookeio.make ~domain:"example.com" ~path:"/" ~name:"orig1" ~value:"val1"
12011201+ ~secure:false ~http_only:false ?expires:None ?same_site:None ?max_age:None
12021202+ ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get)
12031203+ ~last_access:(Ptime.of_float_s 1000.0 |> Option.get)
12041204+ ()
12051205+ in
12061206+ add_original jar original1;
12071207+12081208+ let original2 =
12091209+ Cookeio.make ~domain:"example.com" ~path:"/" ~name:"orig2" ~value:"val2"
12101210+ ~secure:false ~http_only:false ?expires:None ?same_site:None ?max_age:None
12111211+ ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get)
12121212+ ~last_access:(Ptime.of_float_s 1000.0 |> Option.get)
12131213+ ()
12141214+ in
12151215+ add_original jar original2;
12161216+12171217+ (* Add a new delta cookie *)
12181218+ let new_cookie =
12191219+ Cookeio.make ~domain:"example.com" ~path:"/" ~name:"new" ~value:"new_val"
12201220+ ~secure:false ~http_only:false ?expires:None ?same_site:None ?max_age:None
12211221+ ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get)
12221222+ ~last_access:(Ptime.of_float_s 1000.0 |> Option.get)
12231223+ ()
12241224+ in
12251225+ add_cookie jar new_cookie;
12261226+12271227+ (* Delta should only contain the new cookie *)
12281228+ let delta = Cookeio.delta jar in
12291229+ Alcotest.(check int) "delta has 1 cookie" 1 (List.length delta);
12301230+ let delta_cookie = List.hd delta in
12311231+ Alcotest.(check string) "delta cookie name" "new" (Cookeio.name delta_cookie)
12321232+12331233+let test_removal_cookie_format () =
12341234+ Eio_mock.Backend.run @@ fun () ->
12351235+ let clock = Eio_mock.Clock.make () in
12361236+ Eio_mock.Clock.set_time clock 1000.0;
12371237+12381238+ let jar = create () in
12391239+ let cookie =
12401240+ Cookeio.make ~domain:"example.com" ~path:"/" ~name:"test" ~value:"value"
12411241+ ~secure:true ~http_only:true ?expires:None ~same_site:`Strict
12421242+ ?max_age:None
12431243+ ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get)
12441244+ ~last_access:(Ptime.of_float_s 1000.0 |> Option.get)
12451245+ ()
12461246+ in
12471247+ add_original jar cookie;
12481248+12491249+ (* Remove the cookie *)
12501250+ Cookeio.remove jar ~clock cookie;
12511251+12521252+ (* Get the removal cookie *)
12531253+ let delta = Cookeio.delta jar in
12541254+ let removal = List.hd delta in
12551255+12561256+ (* Check all properties *)
12571257+ Alcotest.(check string)
12581258+ "removal cookie has empty value" "" (Cookeio.value removal);
12591259+ Alcotest.(check (option int))
12601260+ "removal cookie Max-Age is 0" (Some 0)
12611261+ (Option.bind (Cookeio.max_age removal) Ptime.Span.to_int_s);
12621262+12631263+ (* Check expires is in the past *)
12641264+ let now = Ptime.of_float_s 1000.0 |> Option.get in
12651265+ match Cookeio.expires removal with
12661266+ | Some exp ->
12671267+ Alcotest.(check bool)
12681268+ "expires is in the past" true
12691269+ (Ptime.compare exp now < 0)
12701270+ | None -> Alcotest.fail "removal cookie should have expires"
12711271+4481272let () =
4491273 Eio_main.run @@ fun env ->
4501274 let open Alcotest in
···4651289 test_cookie_matching env);
4661290 ] );
4671291 ( "basic_operations",
468468- [ test_case "Empty jar operations" `Quick (fun () -> test_empty_jar env) ]
469469- );
12921292+ [
12931293+ test_case "Empty jar operations" `Quick (fun () -> test_empty_jar env);
12941294+ ] );
4701295 ( "time_handling",
4711296 [
4721297 test_case "Cookie expiry with mock clock" `Quick
···4791304 test_parse_set_cookie_with_expires;
4801305 test_case "SameSite=None validation" `Quick
4811306 test_samesite_none_validation;
13071307+ ] );
13081308+ ( "domain_normalization",
13091309+ [
13101310+ test_case "Domain normalization" `Quick test_domain_normalization;
13111311+ test_case "Domain matching with normalized domains" `Quick
13121312+ test_domain_matching;
13131313+ ] );
13141314+ ( "max_age_tracking",
13151315+ [
13161316+ test_case "Max-Age stored separately from Expires" `Quick
13171317+ test_max_age_stored_separately;
13181318+ test_case "Negative Max-Age becomes 0" `Quick
13191319+ test_max_age_negative_becomes_zero;
13201320+ test_case "make_set_cookie_header includes Max-Age" `Quick
13211321+ test_make_set_cookie_header_includes_max_age;
13221322+ test_case "Max-Age round-trip parsing" `Quick test_max_age_round_trip;
13231323+ ] );
13241324+ ( "delta_tracking",
13251325+ [
13261326+ test_case "add_original doesn't affect delta" `Quick
13271327+ test_add_original_not_in_delta;
13281328+ test_case "add_cookie appears in delta" `Quick
13291329+ test_add_cookie_appears_in_delta;
13301330+ test_case "remove original creates removal cookie" `Quick
13311331+ test_remove_original_creates_removal_cookie;
13321332+ test_case "remove delta cookie just removes it" `Quick
13331333+ test_remove_delta_cookie_removes_it;
13341334+ test_case "get_cookies combines original and delta" `Quick
13351335+ test_get_cookies_combines_original_and_delta;
13361336+ test_case "get_cookies delta takes precedence" `Quick
13371337+ test_get_cookies_delta_takes_precedence;
13381338+ test_case "get_cookies excludes removal cookies" `Quick
13391339+ test_get_cookies_excludes_removal_cookies;
13401340+ test_case "delta returns only changed cookies" `Quick
13411341+ test_delta_returns_only_changed_cookies;
13421342+ test_case "removal cookie format" `Quick test_removal_cookie_format;
13431343+ ] );
13441344+ ( "http_date_parsing",
13451345+ [
13461346+ test_case "HTTP date FMT1 (RFC 1123)" `Quick test_http_date_fmt1;
13471347+ test_case "HTTP date FMT2 (RFC 850)" `Quick test_http_date_fmt2;
13481348+ test_case "HTTP date FMT3 (asctime)" `Quick test_http_date_fmt3;
13491349+ test_case "HTTP date FMT4 (variant)" `Quick test_http_date_fmt4;
13501350+ test_case "Abbreviated year 69-99 becomes 1900+" `Quick
13511351+ test_abbreviated_year_69_to_99;
13521352+ test_case "Abbreviated year 0-68 becomes 2000+" `Quick
13531353+ test_abbreviated_year_0_to_68;
13541354+ test_case "RFC 3339 backward compatibility" `Quick
13551355+ test_rfc3339_still_works;
13561356+ test_case "Invalid date format logs warning" `Quick
13571357+ test_invalid_date_format_logs_warning;
13581358+ test_case "Case-insensitive month parsing" `Quick
13591359+ test_case_insensitive_month_parsing;
13601360+ test_case "Case-insensitive GMT parsing" `Quick
13611361+ test_case_insensitive_gmt_parsing;
4821362 ] );
4831363 ]