OCaml HTTP cookie handling library with support for Eio-based storage jars

more feature coverage of max-age and other date formats

+1382 -130
+1 -1
.ocamlformat
··· 1 - version=0.27.0 1 + version=0.28.1
+400 -73
lib/cookeio.ml
··· 13 13 secure : bool; 14 14 http_only : bool; 15 15 expires : Ptime.t option; 16 + max_age : Ptime.Span.t option; 16 17 same_site : same_site option; 17 18 creation_time : Ptime.t; 18 19 last_access : Ptime.t; 19 20 } 20 21 (** HTTP Cookie *) 21 22 22 - type jar = { mutable cookies : t list; mutex : Eio.Mutex.t } 23 + type jar = { 24 + mutable original_cookies : t list; (* from client *) 25 + mutable delta_cookies : t list; (* to send back *) 26 + mutex : Eio.Mutex.t; 27 + } 23 28 (** Cookie jar for storing and managing cookies *) 24 29 25 30 (** {1 Cookie Accessors} *) ··· 31 36 let secure cookie = cookie.secure 32 37 let http_only cookie = cookie.http_only 33 38 let expires cookie = cookie.expires 39 + let max_age cookie = cookie.max_age 34 40 let same_site cookie = cookie.same_site 35 41 let creation_time cookie = cookie.creation_time 36 42 let last_access cookie = cookie.last_access 37 43 38 44 let make ~domain ~path ~name ~value ?(secure = false) ?(http_only = false) 39 - ?expires ?same_site ~creation_time ~last_access () = 40 - { domain; path; name; value; secure; http_only; expires; same_site; creation_time; last_access } 45 + ?expires ?max_age ?same_site ~creation_time ~last_access () = 46 + { 47 + domain; 48 + path; 49 + name; 50 + value; 51 + secure; 52 + http_only; 53 + expires; 54 + max_age; 55 + same_site; 56 + creation_time; 57 + last_access; 58 + } 41 59 42 60 (** {1 Cookie Jar Creation} *) 43 61 44 62 let create () = 45 63 Log.debug (fun m -> m "Creating new empty cookie jar"); 46 - { cookies = []; mutex = Eio.Mutex.create () } 64 + { original_cookies = []; delta_cookies = []; mutex = Eio.Mutex.create () } 47 65 48 66 (** {1 Cookie Matching Helpers} *) 49 67 68 + let cookie_identity_matches c1 c2 = 69 + name c1 = name c2 && domain c1 = domain c2 && path c1 = path c2 70 + 71 + let normalize_domain domain = 72 + (* Strip leading dot per RFC 6265 *) 73 + match String.starts_with ~prefix:"." domain with 74 + | true when String.length domain > 1 -> 75 + String.sub domain 1 (String.length domain - 1) 76 + | _ -> domain 77 + 50 78 let domain_matches cookie_domain request_domain = 51 - (* Cookie domain .example.com matches example.com and sub.example.com *) 52 - if String.starts_with ~prefix:"." cookie_domain then 53 - let domain_suffix = String.sub cookie_domain 1 (String.length cookie_domain - 1) in 54 - request_domain = domain_suffix 55 - || String.ends_with ~suffix:("." ^ domain_suffix) request_domain 56 - else cookie_domain = request_domain 79 + (* Cookie domains are stored without leading dots per RFC 6265. 80 + A cookie with domain "example.com" should match both "example.com" (exact) 81 + and "sub.example.com" (subdomain). *) 82 + request_domain = cookie_domain 83 + || String.ends_with ~suffix:("." ^ cookie_domain) request_domain 57 84 58 85 let path_matches cookie_path request_path = 59 86 (* Cookie path /foo matches /foo, /foo/, /foo/bar *) 60 87 String.starts_with ~prefix:cookie_path request_path 61 88 89 + (** {1 HTTP Date Parsing} *) 62 90 let is_expired cookie clock = 63 91 match cookie.expires with 64 92 | None -> false (* Session cookie *) ··· 69 97 in 70 98 Ptime.compare now exp_time > 0 71 99 100 + module DateParser = struct 101 + (** Month name to number mapping (case-insensitive) *) 102 + let month_of_string s = 103 + match String.lowercase_ascii s with 104 + | "jan" -> Some 1 105 + | "feb" -> Some 2 106 + | "mar" -> Some 3 107 + | "apr" -> Some 4 108 + | "may" -> Some 5 109 + | "jun" -> Some 6 110 + | "jul" -> Some 7 111 + | "aug" -> Some 8 112 + | "sep" -> Some 9 113 + | "oct" -> Some 10 114 + | "nov" -> Some 11 115 + | "dec" -> Some 12 116 + | _ -> None 117 + 118 + (** Normalize abbreviated years: 119 + - Years 69-99 get 1900 added (e.g., 95 → 1995) 120 + - Years 0-68 get 2000 added (e.g., 25 → 2025) 121 + - Years >= 100 are returned as-is *) 122 + let normalize_year year = 123 + if year >= 0 && year <= 68 then year + 2000 124 + else if year >= 69 && year <= 99 then year + 1900 125 + else year 126 + 127 + (** Parse FMT1: "Wed, 21 Oct 2015 07:28:00 GMT" (RFC 1123) *) 128 + let parse_fmt1 s = 129 + try 130 + Scanf.sscanf s "%s %d %s %d %d:%d:%d %s" 131 + (fun _wday day mon year hour min sec tz -> 132 + (* Check timezone is GMT (case-insensitive) *) 133 + if String.lowercase_ascii tz <> "gmt" then None 134 + else 135 + match month_of_string mon with 136 + | None -> None 137 + | Some month -> 138 + let year = normalize_year year in 139 + Ptime.of_date_time ((year, month, day), ((hour, min, sec), 0))) 140 + with _ -> None 141 + 142 + (** Parse FMT2: "Wednesday, 21-Oct-15 07:28:00 GMT" (RFC 850) *) 143 + let parse_fmt2 s = 144 + try 145 + Scanf.sscanf s "%[^,], %d-%3s-%d %d:%d:%d %s" 146 + (fun _wday day mon year hour min sec tz -> 147 + (* Check timezone is GMT (case-insensitive) *) 148 + if String.lowercase_ascii tz <> "gmt" then None 149 + else 150 + match month_of_string mon with 151 + | None -> None 152 + | Some month -> 153 + let year = normalize_year year in 154 + Ptime.of_date_time ((year, month, day), ((hour, min, sec), 0))) 155 + with _ -> None 156 + 157 + (** Parse FMT3: "Wed Oct 21 07:28:00 2015" (asctime) *) 158 + let parse_fmt3 s = 159 + try 160 + Scanf.sscanf s "%s %s %d %d:%d:%d %d" 161 + (fun _wday mon day hour min sec year -> 162 + match month_of_string mon with 163 + | None -> None 164 + | Some month -> 165 + let year = normalize_year year in 166 + Ptime.of_date_time ((year, month, day), ((hour, min, sec), 0))) 167 + with _ -> None 168 + 169 + (** Parse FMT4: "Wed, 21-Oct-2015 07:28:00 GMT" (variant) *) 170 + let parse_fmt4 s = 171 + try 172 + Scanf.sscanf s "%s %d-%3s-%d %d:%d:%d %s" 173 + (fun _wday day mon year hour min sec tz -> 174 + (* Check timezone is GMT (case-insensitive) *) 175 + if String.lowercase_ascii tz <> "gmt" then None 176 + else 177 + match month_of_string mon with 178 + | None -> None 179 + | Some month -> 180 + let year = normalize_year year in 181 + Ptime.of_date_time ((year, month, day), ((hour, min, sec), 0))) 182 + with _ -> None 183 + 184 + (** Parse HTTP date by trying all supported formats in sequence *) 185 + let parse_http_date s = 186 + match parse_fmt1 s with 187 + | Some t -> Some t 188 + | None -> ( 189 + match parse_fmt2 s with 190 + | Some t -> Some t 191 + | None -> ( 192 + match parse_fmt3 s with Some t -> Some t | None -> parse_fmt4 s)) 193 + end 194 + 72 195 (** {1 Cookie Parsing} *) 73 196 74 - (** Accumulated attributes from parsing Set-Cookie header *) 75 197 type cookie_attributes = { 76 198 mutable domain : string option; 77 199 mutable path : string option; 78 200 mutable secure : bool; 79 201 mutable http_only : bool; 80 202 mutable expires : Ptime.t option; 203 + mutable max_age : Ptime.Span.t option; 81 204 mutable same_site : same_site option; 82 205 } 206 + (** Accumulated attributes from parsing Set-Cookie header *) 83 207 84 208 (** Create empty attribute accumulator *) 85 209 let empty_attributes () = ··· 89 213 secure = false; 90 214 http_only = false; 91 215 expires = None; 216 + max_age = None; 92 217 same_site = None; 93 218 } 94 219 ··· 96 221 let parse_attribute clock attrs attr_name attr_value = 97 222 let attr_lower = String.lowercase_ascii attr_name in 98 223 match attr_lower with 99 - | "domain" -> attrs.domain <- Some attr_value 224 + | "domain" -> attrs.domain <- Some (normalize_domain attr_value) 100 225 | "path" -> attrs.path <- Some attr_value 101 226 | "expires" -> ( 102 227 match Ptime.of_rfc3339 attr_value with 103 228 | Ok (time, _, _) -> attrs.expires <- Some time 104 - | Error (`RFC3339 (_, err)) -> 105 - Log.warn (fun m -> 106 - m "Failed to parse expires attribute '%s': %a" attr_value 107 - Ptime.pp_rfc3339_error err)) 229 + | Error (`RFC3339 (_, err)) -> ( 230 + (* Try HTTP date format as fallback *) 231 + match DateParser.parse_http_date attr_value with 232 + | Some time -> attrs.expires <- Some time 233 + | None -> 234 + Log.warn (fun m -> 235 + m "Failed to parse expires attribute '%s': %a" attr_value 236 + Ptime.pp_rfc3339_error err))) 108 237 | "max-age" -> ( 109 238 match int_of_string_opt attr_value with 110 239 | Some seconds -> 240 + (* Handle negative values as 0 per RFC 6265 *) 241 + let seconds = max 0 seconds in 111 242 let now = Eio.Time.now clock in 243 + (* Store the max-age as a Ptime.Span *) 244 + attrs.max_age <- Some (Ptime.Span.of_int_s seconds); 245 + (* Also compute and store expires *) 112 246 let expires = Ptime.of_float_s (now +. float_of_int seconds) in 113 - attrs.expires <- expires 247 + attrs.expires <- expires; 248 + Log.debug (fun m -> m "Parsed Max-Age: %d seconds" seconds) 114 249 | None -> 115 - Log.warn (fun m -> m "Failed to parse max-age attribute '%s'" attr_value)) 250 + Log.warn (fun m -> 251 + m "Failed to parse max-age attribute '%s'" attr_value)) 116 252 | "secure" -> attrs.secure <- true 117 253 | "httponly" -> attrs.http_only <- true 118 254 | "samesite" -> ( ··· 121 257 | "lax" -> attrs.same_site <- Some `Lax 122 258 | "none" -> attrs.same_site <- Some `None 123 259 | _ -> 124 - Log.warn (fun m -> m "Invalid samesite value '%s', ignoring" attr_value)) 260 + Log.warn (fun m -> 261 + m "Invalid samesite value '%s', ignoring" attr_value)) 125 262 | _ -> 126 263 Log.debug (fun m -> m "Unknown cookie attribute '%s', ignoring" attr_name) 127 264 ··· 132 269 | Some `None when not attrs.secure -> 133 270 Log.warn (fun m -> 134 271 m 135 - "Cookie has SameSite=None but Secure flag is not set; this violates \ 136 - RFC requirements"); 272 + "Cookie has SameSite=None but Secure flag is not set; this \ 273 + violates RFC requirements"); 137 274 false 138 275 | _ -> true 139 276 140 277 (** Build final cookie from name/value and accumulated attributes *) 141 278 let build_cookie ~request_domain ~request_path ~name ~value attrs ~now = 142 - let domain = Option.value attrs.domain ~default:request_domain in 279 + let domain = 280 + normalize_domain (Option.value attrs.domain ~default:request_domain) 281 + in 143 282 let path = Option.value attrs.path ~default:request_path in 144 - make ~domain ~path ~name ~value ~secure:attrs.secure ~http_only:attrs.http_only 145 - ?expires:attrs.expires ?same_site:attrs.same_site ~creation_time:now 146 - ~last_access:now () 283 + make ~domain ~path ~name ~value ~secure:attrs.secure 284 + ~http_only:attrs.http_only ?expires:attrs.expires ?max_age:attrs.max_age 285 + ?same_site:attrs.same_site ~creation_time:now ~last_access:now () 147 286 148 287 let rec parse_set_cookie ~clock ~domain:request_domain ~path:request_path 149 288 header_value = ··· 194 333 None) 195 334 else 196 335 let cookie = 197 - build_cookie ~request_domain ~request_path ~name ~value:cookie_value 198 - accumulated_attrs ~now 336 + build_cookie ~request_domain ~request_path ~name 337 + ~value:cookie_value accumulated_attrs ~now 199 338 in 200 339 Log.debug (fun m -> m "Parsed cookie: %a" pp cookie); 201 340 Some cookie) ··· 205 344 |> List.map (fun c -> Printf.sprintf "%s=%s" (name c) (value c)) 206 345 |> String.concat "; " 207 346 347 + and make_set_cookie_header cookie = 348 + let buffer = Buffer.create 128 in 349 + Buffer.add_string buffer (Printf.sprintf "%s=%s" (name cookie) (value cookie)); 350 + 351 + (* Add Max-Age if present *) 352 + (match max_age cookie with 353 + | Some span -> ( 354 + match Ptime.Span.to_int_s span with 355 + | Some seconds -> 356 + Buffer.add_string buffer (Printf.sprintf "; Max-Age=%d" seconds) 357 + | None -> ()) 358 + | None -> ()); 359 + 360 + (* Add Expires if present *) 361 + (match expires cookie with 362 + | Some exp_time -> 363 + (* Format as HTTP date *) 364 + let exp_str = Ptime.to_rfc3339 ~tz_offset_s:0 exp_time in 365 + Buffer.add_string buffer (Printf.sprintf "; Expires=%s" exp_str) 366 + | None -> ()); 367 + 368 + (* Add Domain *) 369 + Buffer.add_string buffer (Printf.sprintf "; Domain=%s" (domain cookie)); 370 + 371 + (* Add Path *) 372 + Buffer.add_string buffer (Printf.sprintf "; Path=%s" (path cookie)); 373 + 374 + (* Add Secure flag *) 375 + if secure cookie then Buffer.add_string buffer "; Secure"; 376 + 377 + (* Add HttpOnly flag *) 378 + if http_only cookie then Buffer.add_string buffer "; HttpOnly"; 379 + 380 + (* Add SameSite *) 381 + (match same_site cookie with 382 + | Some `Strict -> Buffer.add_string buffer "; SameSite=Strict" 383 + | Some `Lax -> Buffer.add_string buffer "; SameSite=Lax" 384 + | Some `None -> Buffer.add_string buffer "; SameSite=None" 385 + | None -> ()); 386 + 387 + Buffer.contents buffer 388 + 208 389 (** {1 Pretty Printing} *) 209 390 210 391 and pp_same_site ppf = function ··· 215 396 and pp ppf cookie = 216 397 Format.fprintf ppf 217 398 "@[<hov 2>{ name=%S;@ value=%S;@ domain=%S;@ path=%S;@ secure=%b;@ \ 218 - http_only=%b;@ expires=%a;@ same_site=%a }@]" 399 + http_only=%b;@ expires=%a;@ max_age=%a;@ same_site=%a }@]" 219 400 (name cookie) (value cookie) (domain cookie) (path cookie) (secure cookie) 220 401 (http_only cookie) 221 402 (Format.pp_print_option Ptime.pp) 222 403 (expires cookie) 404 + (Format.pp_print_option Ptime.Span.pp) 405 + (max_age cookie) 223 406 (Format.pp_print_option pp_same_site) 224 407 (same_site cookie) 225 408 226 409 let pp_jar ppf jar = 227 410 Eio.Mutex.lock jar.mutex; 228 - let cookies = jar.cookies in 411 + let original = jar.original_cookies in 412 + let delta = jar.delta_cookies in 229 413 Eio.Mutex.unlock jar.mutex; 230 414 231 - Format.fprintf ppf "@[<v>CookieJar with %d cookies:@," (List.length cookies); 232 - List.iter (fun cookie -> Format.fprintf ppf " %a@," pp cookie) cookies; 415 + let all_cookies = original @ delta in 416 + Format.fprintf ppf "@[<v>CookieJar with %d cookies (%d original, %d delta):@," 417 + (List.length all_cookies) (List.length original) (List.length delta); 418 + List.iter (fun cookie -> Format.fprintf ppf " %a@," pp cookie) all_cookies; 233 419 Format.fprintf ppf "@]" 234 420 235 421 (** {1 Cookie Management} *) 236 422 237 423 let add_cookie jar cookie = 238 424 Log.debug (fun m -> 239 - m "Adding cookie: %s=%s for domain %s" (name cookie) (value cookie) 240 - (domain cookie)); 425 + m "Adding cookie to delta: %s=%s for domain %s" (name cookie) 426 + (value cookie) (domain cookie)); 241 427 242 428 Eio.Mutex.lock jar.mutex; 243 - (* Remove existing cookie with same name, domain, and path *) 244 - jar.cookies <- 429 + (* Remove existing cookie with same identity from delta *) 430 + jar.delta_cookies <- 245 431 List.filter 246 - (fun c -> 247 - not 248 - (name c = name cookie && domain c = domain cookie 249 - && path c = path cookie)) 250 - jar.cookies; 251 - jar.cookies <- cookie :: jar.cookies; 432 + (fun c -> not (cookie_identity_matches c cookie)) 433 + jar.delta_cookies; 434 + jar.delta_cookies <- cookie :: jar.delta_cookies; 252 435 Eio.Mutex.unlock jar.mutex 253 436 254 - let get_cookies jar ~clock ~domain:request_domain ~path:request_path ~is_secure = 437 + let add_original jar cookie = 438 + Log.debug (fun m -> 439 + m "Adding original cookie: %s=%s for domain %s" (name cookie) 440 + (value cookie) (domain cookie)); 441 + 442 + Eio.Mutex.lock jar.mutex; 443 + (* Remove existing cookie with same identity from original *) 444 + jar.original_cookies <- 445 + List.filter 446 + (fun c -> not (cookie_identity_matches c cookie)) 447 + jar.original_cookies; 448 + jar.original_cookies <- cookie :: jar.original_cookies; 449 + Eio.Mutex.unlock jar.mutex 450 + 451 + let delta jar = 452 + Eio.Mutex.lock jar.mutex; 453 + let result = jar.delta_cookies in 454 + Eio.Mutex.unlock jar.mutex; 455 + Log.debug (fun m -> m "Returning %d delta cookies" (List.length result)); 456 + result 457 + 458 + let make_removal_cookie cookie ~clock = 459 + let now = 460 + Ptime.of_float_s (Eio.Time.now clock) |> Option.value ~default:Ptime.epoch 461 + in 462 + (* Create a cookie with Max-Age=0 and past expiration (1 year ago) *) 463 + let past_expiry = 464 + Ptime.sub_span now (Ptime.Span.of_int_s (365 * 24 * 60 * 60)) 465 + |> Option.value ~default:Ptime.epoch 466 + in 467 + make ~domain:(domain cookie) ~path:(path cookie) ~name:(name cookie) ~value:"" 468 + ~secure:(secure cookie) ~http_only:(http_only cookie) ~expires:past_expiry 469 + ~max_age:(Ptime.Span.of_int_s 0) ?same_site:(same_site cookie) 470 + ~creation_time:now ~last_access:now () 471 + 472 + let remove jar ~clock cookie = 473 + Log.debug (fun m -> 474 + m "Removing cookie: %s=%s for domain %s" (name cookie) (value cookie) 475 + (domain cookie)); 476 + 477 + Eio.Mutex.lock jar.mutex; 478 + (* Check if this cookie exists in original_cookies *) 479 + let in_original = 480 + List.exists (fun c -> cookie_identity_matches c cookie) jar.original_cookies 481 + in 482 + 483 + if in_original then ( 484 + (* Create a removal cookie and add it to delta *) 485 + let removal = make_removal_cookie cookie ~clock in 486 + jar.delta_cookies <- 487 + List.filter 488 + (fun c -> not (cookie_identity_matches c removal)) 489 + jar.delta_cookies; 490 + jar.delta_cookies <- removal :: jar.delta_cookies; 491 + Log.debug (fun m -> m "Created removal cookie in delta for original cookie")) 492 + else ( 493 + (* Just remove from delta if it exists there *) 494 + jar.delta_cookies <- 495 + List.filter 496 + (fun c -> not (cookie_identity_matches c cookie)) 497 + jar.delta_cookies; 498 + Log.debug (fun m -> m "Removed cookie from delta")); 499 + 500 + Eio.Mutex.unlock jar.mutex 501 + 502 + let get_cookies jar ~clock ~domain:request_domain ~path:request_path ~is_secure 503 + = 255 504 Log.debug (fun m -> 256 505 m "Getting cookies for domain=%s path=%s secure=%b" request_domain 257 506 request_path is_secure); 258 507 259 508 Eio.Mutex.lock jar.mutex; 509 + 510 + (* Combine original and delta cookies, with delta taking precedence *) 511 + let all_cookies = jar.original_cookies @ jar.delta_cookies in 512 + 513 + (* Filter out duplicates, keeping the last occurrence (from delta) *) 514 + let rec dedup acc = function 515 + | [] -> List.rev acc 516 + | c :: rest -> 517 + (* Keep this cookie only if no later cookie has the same identity *) 518 + let has_duplicate = 519 + List.exists (fun c2 -> cookie_identity_matches c c2) rest 520 + in 521 + if has_duplicate then dedup acc rest else dedup (c :: acc) rest 522 + in 523 + let unique_cookies = dedup [] all_cookies in 524 + 525 + (* Filter for applicable cookies, excluding removal cookies (empty value) *) 260 526 let applicable = 261 527 List.filter 262 528 (fun cookie -> 263 - domain_matches (domain cookie) request_domain 529 + value cookie <> "" 530 + (* Exclude removal cookies *) 531 + && domain_matches (domain cookie) request_domain 264 532 && path_matches (path cookie) request_path 265 533 && ((not (secure cookie)) || is_secure)) 266 - jar.cookies 534 + unique_cookies 267 535 in 268 536 269 - (* Update last access time *) 537 + (* Update last access time in both lists *) 270 538 let now = 271 539 Ptime.of_float_s (Eio.Time.now clock) |> Option.value ~default:Ptime.epoch 272 540 in 273 - let updated = 541 + let update_last_access cookies = 274 542 List.map 275 543 (fun c -> 276 - if List.memq c applicable then 544 + if List.exists (fun a -> cookie_identity_matches a c) applicable then 277 545 make ~domain:(domain c) ~path:(path c) ~name:(name c) ~value:(value c) 278 546 ~secure:(secure c) ~http_only:(http_only c) ?expires:(expires c) 279 - ?same_site:(same_site c) ~creation_time:(creation_time c) 280 - ~last_access:now () 547 + ?max_age:(max_age c) ?same_site:(same_site c) 548 + ~creation_time:(creation_time c) ~last_access:now () 281 549 else c) 282 - jar.cookies 550 + cookies 283 551 in 284 - jar.cookies <- updated; 552 + jar.original_cookies <- update_last_access jar.original_cookies; 553 + jar.delta_cookies <- update_last_access jar.delta_cookies; 554 + 285 555 Eio.Mutex.unlock jar.mutex; 286 556 287 557 Log.debug (fun m -> m "Found %d applicable cookies" (List.length applicable)); ··· 290 560 let clear jar = 291 561 Log.info (fun m -> m "Clearing all cookies"); 292 562 Eio.Mutex.lock jar.mutex; 293 - jar.cookies <- []; 563 + jar.original_cookies <- []; 564 + jar.delta_cookies <- []; 294 565 Eio.Mutex.unlock jar.mutex 295 566 296 567 let clear_expired jar ~clock = 297 568 Eio.Mutex.lock jar.mutex; 298 - let before_count = List.length jar.cookies in 299 - jar.cookies <- List.filter (fun c -> not (is_expired c clock)) jar.cookies; 300 - let removed = before_count - List.length jar.cookies in 569 + let before_count = 570 + List.length jar.original_cookies + List.length jar.delta_cookies 571 + in 572 + jar.original_cookies <- 573 + List.filter (fun c -> not (is_expired c clock)) jar.original_cookies; 574 + jar.delta_cookies <- 575 + List.filter (fun c -> not (is_expired c clock)) jar.delta_cookies; 576 + let removed = 577 + before_count 578 + - (List.length jar.original_cookies + List.length jar.delta_cookies) 579 + in 301 580 Eio.Mutex.unlock jar.mutex; 302 581 Log.info (fun m -> m "Cleared %d expired cookies" removed) 303 582 304 583 let clear_session_cookies jar = 305 584 Eio.Mutex.lock jar.mutex; 306 - let before_count = List.length jar.cookies in 307 - jar.cookies <- List.filter (fun c -> expires c <> None) jar.cookies; 308 - let removed = before_count - List.length jar.cookies in 585 + let before_count = 586 + List.length jar.original_cookies + List.length jar.delta_cookies 587 + in 588 + jar.original_cookies <- 589 + List.filter (fun c -> expires c <> None) jar.original_cookies; 590 + jar.delta_cookies <- 591 + List.filter (fun c -> expires c <> None) jar.delta_cookies; 592 + let removed = 593 + before_count 594 + - (List.length jar.original_cookies + List.length jar.delta_cookies) 595 + in 309 596 Eio.Mutex.unlock jar.mutex; 310 597 Log.info (fun m -> m "Cleared %d session cookies" removed) 311 598 312 599 let count jar = 313 600 Eio.Mutex.lock jar.mutex; 314 - let n = List.length jar.cookies in 601 + (* Combine and deduplicate cookies for count *) 602 + let all_cookies = jar.original_cookies @ jar.delta_cookies in 603 + let rec dedup acc = function 604 + | [] -> List.rev acc 605 + | c :: rest -> 606 + let has_duplicate = 607 + List.exists (fun c2 -> cookie_identity_matches c c2) rest 608 + in 609 + if has_duplicate then dedup acc rest else dedup (c :: acc) rest 610 + in 611 + let unique = dedup [] all_cookies in 612 + let n = List.length unique in 315 613 Eio.Mutex.unlock jar.mutex; 316 614 n 317 615 318 616 let get_all_cookies jar = 319 617 Eio.Mutex.lock jar.mutex; 320 - let cookies = jar.cookies in 618 + (* Combine and deduplicate, with delta taking precedence *) 619 + let all_cookies = jar.original_cookies @ jar.delta_cookies in 620 + let rec dedup acc = function 621 + | [] -> List.rev acc 622 + | c :: rest -> 623 + let has_duplicate = 624 + List.exists (fun c2 -> cookie_identity_matches c c2) rest 625 + in 626 + if has_duplicate then dedup acc rest else dedup (c :: acc) rest 627 + in 628 + let unique = dedup [] all_cookies in 321 629 Eio.Mutex.unlock jar.mutex; 322 - cookies 630 + unique 323 631 324 632 let is_empty jar = 325 633 Eio.Mutex.lock jar.mutex; 326 - let empty = jar.cookies = [] in 634 + let empty = jar.original_cookies = [] && jar.delta_cookies = [] in 327 635 Eio.Mutex.unlock jar.mutex; 328 636 empty 329 637 ··· 333 641 let buffer = Buffer.create 1024 in 334 642 Buffer.add_string buffer "# Netscape HTTP Cookie File\n"; 335 643 Buffer.add_string buffer "# This is a generated file! Do not edit.\n\n"; 644 + 645 + (* Combine and deduplicate cookies *) 646 + let all_cookies = jar.original_cookies @ jar.delta_cookies in 647 + let rec dedup acc = function 648 + | [] -> List.rev acc 649 + | c :: rest -> 650 + let has_duplicate = 651 + List.exists (fun c2 -> cookie_identity_matches c c2) rest 652 + in 653 + if has_duplicate then dedup acc rest else dedup (c :: acc) rest 654 + in 655 + let unique = dedup [] all_cookies in 336 656 337 657 List.iter 338 658 (fun cookie -> 339 659 let include_subdomains = 340 - if String.starts_with ~prefix:"." (domain cookie) then "TRUE" else "FALSE" 660 + if String.starts_with ~prefix:"." (domain cookie) then "TRUE" 661 + else "FALSE" 341 662 in 342 663 let secure_flag = if secure cookie then "TRUE" else "FALSE" in 343 664 let expires_str = ··· 350 671 351 672 Buffer.add_string buffer 352 673 (Printf.sprintf "%s\t%s\t%s\t%s\t%s\t%s\t%s\n" (domain cookie) 353 - include_subdomains (path cookie) secure_flag expires_str (name cookie) 354 - (value cookie))) 355 - jar.cookies; 674 + include_subdomains (path cookie) secure_flag expires_str 675 + (name cookie) (value cookie))) 676 + unique; 356 677 357 678 Buffer.contents buffer 358 679 ··· 379 700 in 380 701 let expires = 381 702 let exp_int = try int_of_string expires with _ -> 0 in 382 - if exp_int = 0 then None else Ptime.of_float_s (float_of_int exp_int) 703 + if exp_int = 0 then None 704 + else Ptime.of_float_s (float_of_int exp_int) 383 705 in 384 706 385 707 let cookie = 386 - make ~domain ~path ~name ~value ~secure:(secure = "TRUE") 387 - ~http_only:false ?expires ?same_site:None ~creation_time:now 708 + make ~domain:(normalize_domain domain) ~path ~name ~value 709 + ~secure:(secure = "TRUE") ~http_only:false ?expires 710 + ?max_age:None ?same_site:None ~creation_time:now 388 711 ~last_access:now () 389 712 in 390 - add_cookie jar cookie; 713 + add_original jar cookie; 391 714 Log.debug (fun m -> m "Loaded cookie: %s=%s" name value) 392 715 | _ -> Log.warn (fun m -> m "Invalid cookie line: %s" line)) 393 716 lines; 394 717 395 - Log.info (fun m -> m "Loaded %d cookies" (List.length jar.cookies)); 718 + Log.info (fun m -> m "Loaded %d cookies" (List.length jar.original_cookies)); 396 719 jar 397 720 398 721 (** {1 File Operations} *) ··· 412 735 create () 413 736 414 737 let save path jar = 415 - Log.info (fun m -> 416 - m "Saving %d cookies to %a" (List.length jar.cookies) Eio.Path.pp path); 738 + Eio.Mutex.lock jar.mutex; 739 + let total_cookies = 740 + List.length jar.original_cookies + List.length jar.delta_cookies 741 + in 742 + Eio.Mutex.unlock jar.mutex; 743 + Log.info (fun m -> m "Saving %d cookies to %a" total_cookies Eio.Path.pp path); 417 744 418 745 let content = to_mozilla_format jar in 419 746
+63 -18
lib/cookeio.mli
··· 1 1 (** Cookie management library for OCaml 2 2 3 - HTTP cookies are a mechanism that allows "server side 4 - connections to store and retrieve information on the client side." 5 - Originally designed to enable persistent client-side state for web 6 - applications, cookies are essential for storing user preferences, session 7 - data, shopping cart contents, and authentication tokens. 3 + HTTP cookies are a mechanism that allows "server side connections to store 4 + and retrieve information on the client side." Originally designed to enable 5 + persistent client-side state for web applications, cookies are essential for 6 + storing user preferences, session data, shopping cart contents, and 7 + authentication tokens. 8 8 9 9 This library provides a complete cookie jar implementation following 10 - established web standards while integrating Eio for efficient asynchronous operations. 10 + established web standards while integrating Eio for efficient asynchronous 11 + operations. 11 12 12 13 {2 Cookie Format and Structure} 13 14 ··· 26 27 - Domain matching uses "tail matching" (e.g., "acme.com" matches 27 28 "anvil.acme.com") 28 29 - Path matching allows subset URL specification for fine-grained control 29 - - More specific path mappings are sent first in Cookie headers 30 - 31 - *) 30 + - More specific path mappings are sent first in Cookie headers *) 32 31 33 32 type same_site = [ `Strict | `Lax | `None ] 34 33 (** Cookie same-site policy for controlling cross-site request behavior. ··· 81 80 val expires : t -> Ptime.t option 82 81 (** Get the expiry time of a cookie *) 83 82 83 + val max_age : t -> Ptime.Span.t option 84 + (** Get the max-age of a cookie *) 85 + 84 86 val same_site : t -> same_site option 85 87 (** Get the same-site policy of a cookie *) 86 88 ··· 90 92 val last_access : t -> Ptime.t 91 93 (** Get the last access time of a cookie *) 92 94 93 - val make : domain:string -> path:string -> name:string -> value:string -> 94 - ?secure:bool -> ?http_only:bool -> ?expires:Ptime.t -> 95 - ?same_site:same_site -> creation_time:Ptime.t -> last_access:Ptime.t -> 96 - unit -> t 95 + val make : 96 + domain:string -> 97 + path:string -> 98 + name:string -> 99 + value:string -> 100 + ?secure:bool -> 101 + ?http_only:bool -> 102 + ?expires:Ptime.t -> 103 + ?max_age:Ptime.Span.t -> 104 + ?same_site:same_site -> 105 + creation_time:Ptime.t -> 106 + last_access:Ptime.t -> 107 + unit -> 108 + t 97 109 (** Create a new cookie with the given attributes *) 98 110 99 111 (** {1 Cookie Jar Creation and Loading} *) ··· 114 126 (** {1 Cookie Jar Management} *) 115 127 116 128 val add_cookie : jar -> t -> unit 117 - (** Add a cookie to the jar *) 129 + (** Add a cookie to the jar. 130 + 131 + The cookie is added to the delta, meaning it will appear in Set-Cookie 132 + headers when calling {!delta}. If a cookie with the same name/domain/path 133 + exists in the delta, it will be replaced. *) 134 + 135 + val add_original : jar -> t -> unit 136 + (** Add an original cookie to the jar. 137 + 138 + Original cookies are those received from the client (via Cookie header). 139 + They do not appear in the delta. This method should be used when loading 140 + cookies from incoming HTTP requests. *) 141 + 142 + val delta : jar -> t list 143 + (** Get cookies that need to be sent in Set-Cookie headers. 144 + 145 + Returns cookies that have been added via {!add_cookie} and removal cookies 146 + for original cookies that have been removed. Does not include original 147 + cookies that were added via {!add_original}. *) 148 + 149 + val remove : jar -> clock:_ Eio.Time.clock -> t -> unit 150 + (** Remove a cookie from the jar. 151 + 152 + If an original cookie with the same name/domain/path exists, creates a 153 + removal cookie (empty value, Max-Age=0, past expiration) that appears in the 154 + delta. If only a delta cookie exists, simply removes it from the delta. *) 118 155 119 156 val get_cookies : 120 157 jar -> ··· 126 163 (** Get cookies applicable for a URL. 127 164 128 165 Returns all cookies that match the given domain and path, and satisfy the 129 - secure flag requirement. Also updates the last access time of matching 130 - cookies using the provided clock. *) 166 + secure flag requirement. Combines original and delta cookies, with delta 167 + taking precedence. Excludes removal cookies (empty value). Also updates the 168 + last access time of matching cookies using the provided clock. *) 131 169 132 170 val clear : jar -> unit 133 171 (** Clear all cookies *) ··· 167 205 - [SameSite=None] requires the [Secure] flag to be set 168 206 169 207 Example: 170 - [parse_set_cookie ~clock ~domain:"example.com" ~path:"/" 171 - "session=abc123; Secure; HttpOnly"] *) 208 + [parse_set_cookie ~clock ~domain:"example.com" ~path:"/" "session=abc123; 209 + Secure; HttpOnly"] *) 172 210 173 211 val make_cookie_header : t list -> string 174 212 (** Create cookie header value from cookies. ··· 182 220 183 221 Example: [make_cookie_header cookies] might return 184 222 ["session=abc123; theme=dark"] *) 223 + 224 + val make_set_cookie_header : t -> string 225 + (** Create Set-Cookie header value from a cookie. 226 + 227 + Formats a cookie into a Set-Cookie header value suitable for HTTP responses. 228 + Includes all cookie attributes: Max-Age, Expires, Domain, Path, Secure, 229 + HttpOnly, and SameSite. *) 185 230 186 231 (** {1 Pretty Printing} *) 187 232
+918 -38
test/test_cookeio.ml
··· 5 5 (fun ppf c -> 6 6 Format.fprintf ppf 7 7 "{ name=%S; value=%S; domain=%S; path=%S; secure=%b; http_only=%b; \ 8 - expires=%a; same_site=%a }" 9 - (Cookeio.name c) (Cookeio.value c) (Cookeio.domain c) (Cookeio.path c) (Cookeio.secure c) (Cookeio.http_only c) 8 + expires=%a; max_age=%a; same_site=%a }" 9 + (Cookeio.name c) (Cookeio.value c) (Cookeio.domain c) (Cookeio.path c) 10 + (Cookeio.secure c) (Cookeio.http_only c) 10 11 (Format.pp_print_option Ptime.pp) 11 12 (Cookeio.expires c) 13 + (Format.pp_print_option Ptime.Span.pp) 14 + (Cookeio.max_age c) 12 15 (Format.pp_print_option (fun ppf -> function 13 16 | `Strict -> Format.pp_print_string ppf "Strict" 14 17 | `Lax -> Format.pp_print_string ppf "Lax" 15 18 | `None -> Format.pp_print_string ppf "None")) 16 19 (Cookeio.same_site c)) 17 20 (fun c1 c2 -> 18 - Cookeio.name c1 = Cookeio.name c2 && Cookeio.value c1 = Cookeio.value c2 && Cookeio.domain c1 = Cookeio.domain c2 19 - && Cookeio.path c1 = Cookeio.path c2 && Cookeio.secure c1 = Cookeio.secure c2 21 + Cookeio.name c1 = Cookeio.name c2 22 + && Cookeio.value c1 = Cookeio.value c2 23 + && Cookeio.domain c1 = Cookeio.domain c2 24 + && Cookeio.path c1 = Cookeio.path c2 25 + && Cookeio.secure c1 = Cookeio.secure c2 20 26 && Cookeio.http_only c1 = Cookeio.http_only c2 21 27 && Option.equal Ptime.equal (Cookeio.expires c1) (Cookeio.expires c2) 28 + && Option.equal Ptime.Span.equal (Cookeio.max_age c1) (Cookeio.max_age c2) 22 29 && Option.equal ( = ) (Cookeio.same_site c1) (Cookeio.same_site c2)) 23 30 24 31 let test_load_mozilla_cookies env = ··· 49 56 50 57 (* Test cookie-1: session cookie on exact domain *) 51 58 let cookie1 = find_cookie "cookie-1" in 52 - Alcotest.(check string) "cookie-1 domain" "example.com" (Cookeio.domain cookie1); 59 + Alcotest.(check string) 60 + "cookie-1 domain" "example.com" (Cookeio.domain cookie1); 53 61 Alcotest.(check string) "cookie-1 path" "/foo/" (Cookeio.path cookie1); 54 62 Alcotest.(check string) "cookie-1 name" "cookie-1" (Cookeio.name cookie1); 55 63 Alcotest.(check string) "cookie-1 value" "v$1" (Cookeio.value cookie1); ··· 66 74 | `Lax -> Format.pp_print_string ppf "Lax" 67 75 | `None -> Format.pp_print_string ppf "None") 68 76 ( = )))) 69 - "cookie-1 same_site" None (Cookeio.same_site cookie1); 77 + "cookie-1 same_site" None 78 + (Cookeio.same_site cookie1); 70 79 71 80 (* Test cookie-2: session cookie on subdomain pattern *) 72 81 let cookie2 = find_cookie "cookie-2" in 73 - Alcotest.(check string) "cookie-2 domain" ".example.com" (Cookeio.domain cookie2); 82 + Alcotest.(check string) 83 + "cookie-2 domain" "example.com" (Cookeio.domain cookie2); 74 84 Alcotest.(check string) "cookie-2 path" "/foo/" (Cookeio.path cookie2); 75 85 Alcotest.(check string) "cookie-2 name" "cookie-2" (Cookeio.name cookie2); 76 86 Alcotest.(check string) "cookie-2 value" "v$2" (Cookeio.value cookie2); ··· 82 92 (* Test cookie-3: non-session cookie with expiry *) 83 93 let cookie3 = find_cookie "cookie-3" in 84 94 let expected_expiry = Ptime.of_float_s 1257894000.0 in 85 - Alcotest.(check string) "cookie-3 domain" "example.com" (Cookeio.domain cookie3); 95 + Alcotest.(check string) 96 + "cookie-3 domain" "example.com" (Cookeio.domain cookie3); 86 97 Alcotest.(check string) "cookie-3 path" "/foo/" (Cookeio.path cookie3); 87 98 Alcotest.(check string) "cookie-3 name" "cookie-3" (Cookeio.name cookie3); 88 99 Alcotest.(check string) "cookie-3 value" "v$3" (Cookeio.value cookie3); ··· 93 104 94 105 (* Test cookie-4: another non-session cookie *) 95 106 let cookie4 = find_cookie "cookie-4" in 96 - Alcotest.(check string) "cookie-4 domain" "example.com" (Cookeio.domain cookie4); 107 + Alcotest.(check string) 108 + "cookie-4 domain" "example.com" (Cookeio.domain cookie4); 97 109 Alcotest.(check string) "cookie-4 path" "/foo/" (Cookeio.path cookie4); 98 110 Alcotest.(check string) "cookie-4 name" "cookie-4" (Cookeio.name cookie4); 99 111 Alcotest.(check string) "cookie-4 value" "v$4" (Cookeio.value cookie4); ··· 104 116 105 117 (* Test cookie-5: secure cookie *) 106 118 let cookie5 = find_cookie "cookie-5" in 107 - Alcotest.(check string) "cookie-5 domain" "example.com" (Cookeio.domain cookie5); 119 + Alcotest.(check string) 120 + "cookie-5 domain" "example.com" (Cookeio.domain cookie5); 108 121 Alcotest.(check string) "cookie-5 path" "/foo/" (Cookeio.path cookie5); 109 122 Alcotest.(check string) "cookie-5 name" "cookie-5" (Cookeio.name cookie5); 110 123 Alcotest.(check string) "cookie-5 value" "v$5" (Cookeio.value cookie5); ··· 129 142 (* Verify a few key cookies are loaded correctly *) 130 143 let cookie1 = find_cookie "cookie-1" in 131 144 Alcotest.(check string) "file cookie-1 value" "v$1" (Cookeio.value cookie1); 132 - Alcotest.(check string) "file cookie-1 domain" "example.com" (Cookeio.domain cookie1); 145 + Alcotest.(check string) 146 + "file cookie-1 domain" "example.com" (Cookeio.domain cookie1); 133 147 Alcotest.(check bool) "file cookie-1 secure" false (Cookeio.secure cookie1); 134 148 Alcotest.(check (option (Alcotest.testable Ptime.pp Ptime.equal))) 135 149 "file cookie-1 expires" None (Cookeio.expires cookie1); ··· 143 157 144 158 (* Verify subdomain cookie *) 145 159 let cookie2 = find_cookie "cookie-2" in 146 - Alcotest.(check string) "file cookie-2 domain" ".example.com" (Cookeio.domain cookie2); 160 + Alcotest.(check string) 161 + "file cookie-2 domain" "example.com" (Cookeio.domain cookie2); 147 162 Alcotest.(check (option (Alcotest.testable Ptime.pp Ptime.equal))) 148 163 "file cookie-2 expires" None (Cookeio.expires cookie2) 149 164 ··· 154 169 (* Add test cookies with different domain patterns *) 155 170 let exact_cookie = 156 171 Cookeio.make ~domain:"example.com" ~path:"/" ~name:"exact" ~value:"test1" 157 - ~secure:false ~http_only:false ?expires:None ?same_site:None 172 + ~secure:false ~http_only:false ?expires:None ?same_site:None ?max_age:None 158 173 ~creation_time:Ptime.epoch ~last_access:Ptime.epoch () 159 174 in 160 175 let subdomain_cookie = 161 - Cookeio.make ~domain:".example.com" ~path:"/" ~name:"subdomain" ~value:"test2" 162 - ~secure:false ~http_only:false ?expires:None ?same_site:None 163 - ~creation_time:Ptime.epoch ~last_access:Ptime.epoch () 176 + Cookeio.make ~domain:"example.com" ~path:"/" ~name:"subdomain" 177 + ~value:"test2" ~secure:false ~http_only:false ?expires:None 178 + ?same_site:None ?max_age:None ~creation_time:Ptime.epoch 179 + ~last_access:Ptime.epoch () 164 180 in 165 181 let secure_cookie = 166 182 Cookeio.make ~domain:"example.com" ~path:"/" ~name:"secure" ~value:"test3" 167 - ~secure:true ~http_only:false ?expires:None ?same_site:None 183 + ~secure:true ~http_only:false ?expires:None ?same_site:None ?max_age:None 168 184 ~creation_time:Ptime.epoch ~last_access:Ptime.epoch () 169 185 in 170 186 ··· 172 188 add_cookie jar subdomain_cookie; 173 189 add_cookie jar secure_cookie; 174 190 175 - (* Test exact domain matching *) 191 + (* Test exact domain matching - all three cookies should match example.com *) 176 192 let cookies_http = 177 193 get_cookies jar ~clock ~domain:"example.com" ~path:"/" ~is_secure:false 178 194 in ··· 183 199 in 184 200 Alcotest.(check int) "https cookies count" 3 (List.length cookies_https); 185 201 186 - (* Test subdomain matching *) 202 + (* Test subdomain matching - all cookies should match subdomains now *) 187 203 let cookies_sub = 188 204 get_cookies jar ~clock ~domain:"sub.example.com" ~path:"/" ~is_secure:false 189 205 in 190 - Alcotest.(check int) "subdomain cookies count" 1 (List.length cookies_sub); 191 - let sub_cookie = List.hd cookies_sub in 192 - Alcotest.(check string) "subdomain cookie name" "subdomain" (Cookeio.name sub_cookie) 206 + Alcotest.(check int) "subdomain cookies count" 2 (List.length cookies_sub) 193 207 194 208 let test_empty_jar env = 195 209 let clock = Eio.Stdenv.clock env in ··· 209 223 let jar = create () in 210 224 211 225 let test_cookie = 212 - Cookeio.make ~domain:"example.com" ~path:"/test/" ~name:"test" ~value:"value" 213 - ~secure:true ~http_only:false ?expires:(Ptime.of_float_s 1257894000.0) 214 - ~same_site:`Strict ~creation_time:Ptime.epoch ~last_access:Ptime.epoch () 226 + Cookeio.make ~domain:"example.com" ~path:"/test/" ~name:"test" 227 + ~value:"value" ~secure:true ~http_only:false 228 + ?expires:(Ptime.of_float_s 1257894000.0) 229 + ~same_site:`Strict ?max_age:None ~creation_time:Ptime.epoch 230 + ~last_access:Ptime.epoch () 215 231 in 216 232 217 233 add_cookie jar test_cookie; ··· 225 241 let cookie2 = List.hd cookies2 in 226 242 Alcotest.(check string) "round trip name" "test" (Cookeio.name cookie2); 227 243 Alcotest.(check string) "round trip value" "value" (Cookeio.value cookie2); 228 - Alcotest.(check string) "round trip domain" "example.com" (Cookeio.domain cookie2); 244 + Alcotest.(check string) 245 + "round trip domain" "example.com" (Cookeio.domain cookie2); 229 246 Alcotest.(check string) "round trip path" "/test/" (Cookeio.path cookie2); 230 247 Alcotest.(check bool) "round trip secure" true (Cookeio.secure cookie2); 231 248 (* Note: http_only and same_site are lost in Mozilla format *) ··· 248 265 let cookie1 = 249 266 Cookeio.make ~domain:"example.com" ~path:"/" ~name:"expires_soon" 250 267 ~value:"value1" ~secure:false ~http_only:false ~expires:expires_soon 251 - ?same_site:None 268 + ?same_site:None ?max_age:None 252 269 ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get) 253 270 ~last_access:(Ptime.of_float_s 1000.0 |> Option.get) 254 271 () ··· 259 276 let cookie2 = 260 277 Cookeio.make ~domain:"example.com" ~path:"/" ~name:"expires_later" 261 278 ~value:"value2" ~secure:false ~http_only:false ~expires:expires_later 262 - ?same_site:None 279 + ?same_site:None ?max_age:None 263 280 ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get) 264 281 ~last_access:(Ptime.of_float_s 1000.0 |> Option.get) 265 282 () ··· 268 285 (* Add a session cookie (no expiry) *) 269 286 let cookie3 = 270 287 Cookeio.make ~domain:"example.com" ~path:"/" ~name:"session" ~value:"value3" 271 - ~secure:false ~http_only:false ?expires:None ?same_site:None 288 + ~secure:false ~http_only:false ?expires:None ?same_site:None ?max_age:None 272 289 ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get) 273 290 ~last_access:(Ptime.of_float_s 1000.0 |> Option.get) 274 291 () ··· 289 306 let cookies = get_all_cookies jar in 290 307 let names = List.map Cookeio.name cookies |> List.sort String.compare in 291 308 Alcotest.(check (list string)) 292 - "remaining cookies after 1600s" [ "expires_later"; "session" ] names; 309 + "remaining cookies after 1600s" 310 + [ "expires_later"; "session" ] 311 + names; 293 312 294 313 (* Advance time to 2100.0 - second cookie should expire *) 295 314 Eio_mock.Clock.set_time clock 2100.0; ··· 298 317 Alcotest.(check int) "after second expiry" 1 (count jar); 299 318 300 319 let remaining = get_all_cookies jar in 301 - Alcotest.(check string) "only session cookie remains" "session" 320 + Alcotest.(check string) 321 + "only session cookie remains" "session" 302 322 (Cookeio.name (List.hd remaining)) 303 323 304 324 let test_max_age_parsing_with_mock_clock () = ··· 345 365 (* Add a cookie *) 346 366 let cookie = 347 367 Cookeio.make ~domain:"example.com" ~path:"/" ~name:"test" ~value:"value" 348 - ~secure:false ~http_only:false ?expires:None ?same_site:None 368 + ~secure:false ~http_only:false ?expires:None ?same_site:None ?max_age:None 349 369 ~creation_time:(Ptime.of_float_s 3000.0 |> Option.get) 350 370 ~last_access:(Ptime.of_float_s 3000.0 |> Option.get) 351 371 () ··· 394 414 let cookie = Option.get cookie_opt in 395 415 Alcotest.(check string) "cookie name" "id" (Cookeio.name cookie); 396 416 Alcotest.(check string) "cookie value" "xyz789" (Cookeio.value cookie); 397 - Alcotest.(check string) "cookie domain" ".example.com" (Cookeio.domain cookie); 417 + Alcotest.(check string) "cookie domain" "example.com" (Cookeio.domain cookie); 398 418 Alcotest.(check string) "cookie path" "/" (Cookeio.path cookie); 399 419 400 420 (* Verify expires is parsed correctly *) 401 - Alcotest.(check bool) "has expiry" true 421 + Alcotest.(check bool) 422 + "has expiry" true 402 423 (Option.is_some (Cookeio.expires cookie)); 403 424 404 425 (* Verify the specific expiry time parsed from the RFC3339 date *) ··· 422 443 parse_set_cookie ~clock ~domain:"example.com" ~path:"/" invalid_header 423 444 in 424 445 425 - Alcotest.(check bool) "invalid cookie rejected" true (Option.is_none cookie_opt); 446 + Alcotest.(check bool) 447 + "invalid cookie rejected" true 448 + (Option.is_none cookie_opt); 426 449 427 450 (* This should be accepted: SameSite=None with Secure *) 428 451 let valid_header = "token=abc; SameSite=None; Secure" in ··· 430 453 parse_set_cookie ~clock ~domain:"example.com" ~path:"/" valid_header 431 454 in 432 455 433 - Alcotest.(check bool) "valid cookie accepted" true (Option.is_some cookie_opt2); 456 + Alcotest.(check bool) 457 + "valid cookie accepted" true 458 + (Option.is_some cookie_opt2); 434 459 435 460 let cookie = Option.get cookie_opt2 in 436 461 Alcotest.(check bool) "cookie is secure" true (Cookeio.secure cookie); ··· 445 470 ( = )))) 446 471 "samesite is None" (Some `None) (Cookeio.same_site cookie) 447 472 473 + let test_domain_normalization () = 474 + Eio_mock.Backend.run @@ fun () -> 475 + let clock = Eio_mock.Clock.make () in 476 + Eio_mock.Clock.set_time clock 1000.0; 477 + 478 + (* Test parsing ".example.com" stores as "example.com" *) 479 + let header = "test=value; Domain=.example.com" in 480 + let cookie_opt = 481 + parse_set_cookie ~clock ~domain:"example.com" ~path:"/" header 482 + in 483 + Alcotest.(check bool) "cookie parsed" true (Option.is_some cookie_opt); 484 + let cookie = Option.get cookie_opt in 485 + Alcotest.(check string) 486 + "domain normalized" "example.com" (Cookeio.domain cookie); 487 + 488 + (* Test round-trip through Mozilla format normalizes domains *) 489 + let jar = create () in 490 + let test_cookie = 491 + Cookeio.make ~domain:".example.com" ~path:"/" ~name:"test" ~value:"val" 492 + ~secure:false ~http_only:false ?expires:None ?same_site:None ?max_age:None 493 + ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get) 494 + ~last_access:(Ptime.of_float_s 1000.0 |> Option.get) 495 + () 496 + in 497 + add_cookie jar test_cookie; 498 + 499 + let mozilla_format = to_mozilla_format jar in 500 + let jar2 = from_mozilla_format ~clock mozilla_format in 501 + let cookies2 = get_all_cookies jar2 in 502 + Alcotest.(check int) "one cookie" 1 (List.length cookies2); 503 + Alcotest.(check string) 504 + "domain normalized after round-trip" "example.com" 505 + (Cookeio.domain (List.hd cookies2)) 506 + 507 + let test_max_age_stored_separately () = 508 + Eio_mock.Backend.run @@ fun () -> 509 + let clock = Eio_mock.Clock.make () in 510 + Eio_mock.Clock.set_time clock 5000.0; 511 + 512 + (* Parse a Set-Cookie header with Max-Age *) 513 + let header = "session=abc123; Max-Age=3600" in 514 + let cookie_opt = 515 + parse_set_cookie ~clock ~domain:"example.com" ~path:"/" header 516 + in 517 + Alcotest.(check bool) "cookie parsed" true (Option.is_some cookie_opt); 518 + 519 + let cookie = Option.get cookie_opt in 520 + 521 + (* Verify max_age is stored as a Ptime.Span *) 522 + Alcotest.(check bool) 523 + "max_age is set" true 524 + (Option.is_some (Cookeio.max_age cookie)); 525 + let max_age_span = Option.get (Cookeio.max_age cookie) in 526 + Alcotest.(check (option int)) 527 + "max_age is 3600 seconds" (Some 3600) 528 + (Ptime.Span.to_int_s max_age_span); 529 + 530 + (* Verify expires is also computed correctly *) 531 + let expected_expiry = Ptime.of_float_s 8600.0 in 532 + Alcotest.(check (option (Alcotest.testable Ptime.pp Ptime.equal))) 533 + "expires computed from max-age" expected_expiry (Cookeio.expires cookie) 534 + 535 + let test_max_age_negative_becomes_zero () = 536 + Eio_mock.Backend.run @@ fun () -> 537 + let clock = Eio_mock.Clock.make () in 538 + Eio_mock.Clock.set_time clock 5000.0; 539 + 540 + (* Parse a Set-Cookie header with negative Max-Age *) 541 + let header = "session=abc123; Max-Age=-100" in 542 + let cookie_opt = 543 + parse_set_cookie ~clock ~domain:"example.com" ~path:"/" header 544 + in 545 + Alcotest.(check bool) "cookie parsed" true (Option.is_some cookie_opt); 546 + 547 + let cookie = Option.get cookie_opt in 548 + 549 + (* Verify max_age is stored as 0 per RFC 6265 *) 550 + Alcotest.(check bool) 551 + "max_age is set" true 552 + (Option.is_some (Cookeio.max_age cookie)); 553 + let max_age_span = Option.get (Cookeio.max_age cookie) in 554 + Alcotest.(check (option int)) 555 + "negative max_age becomes 0" (Some 0) 556 + (Ptime.Span.to_int_s max_age_span); 557 + 558 + (* Verify expires is computed with 0 seconds *) 559 + let expected_expiry = Ptime.of_float_s 5000.0 in 560 + Alcotest.(check (option (Alcotest.testable Ptime.pp Ptime.equal))) 561 + "expires computed with 0 seconds" expected_expiry (Cookeio.expires cookie) 562 + 563 + let string_contains_substring s sub = 564 + try 565 + let len = String.length sub in 566 + let rec search i = 567 + if i + len > String.length s then false 568 + else if String.sub s i len = sub then true 569 + else search (i + 1) 570 + in 571 + search 0 572 + with _ -> false 573 + 574 + let test_make_set_cookie_header_includes_max_age () = 575 + Eio_mock.Backend.run @@ fun () -> 576 + let clock = Eio_mock.Clock.make () in 577 + Eio_mock.Clock.set_time clock 5000.0; 578 + 579 + (* Create a cookie with max_age *) 580 + let max_age_span = Ptime.Span.of_int_s 3600 in 581 + let expires_time = Ptime.of_float_s 8600.0 |> Option.get in 582 + let cookie = 583 + Cookeio.make ~domain:"example.com" ~path:"/" ~name:"session" ~value:"abc123" 584 + ~secure:true ~http_only:true ?expires:(Some expires_time) 585 + ?max_age:(Some max_age_span) ?same_site:(Some `Strict) 586 + ~creation_time:(Ptime.of_float_s 5000.0 |> Option.get) 587 + ~last_access:(Ptime.of_float_s 5000.0 |> Option.get) 588 + () 589 + in 590 + 591 + let header = make_set_cookie_header cookie in 592 + 593 + (* Verify the header includes Max-Age *) 594 + Alcotest.(check bool) 595 + "header includes Max-Age" true 596 + (string_contains_substring header "Max-Age=3600"); 597 + 598 + (* Verify the header includes Expires *) 599 + Alcotest.(check bool) 600 + "header includes Expires" true 601 + (string_contains_substring header "Expires="); 602 + 603 + (* Verify the header includes other attributes *) 604 + Alcotest.(check bool) 605 + "header includes Secure" true 606 + (string_contains_substring header "Secure"); 607 + Alcotest.(check bool) 608 + "header includes HttpOnly" true 609 + (string_contains_substring header "HttpOnly"); 610 + Alcotest.(check bool) 611 + "header includes SameSite" true 612 + (string_contains_substring header "SameSite=Strict") 613 + 614 + let test_max_age_round_trip () = 615 + Eio_mock.Backend.run @@ fun () -> 616 + let clock = Eio_mock.Clock.make () in 617 + Eio_mock.Clock.set_time clock 5000.0; 618 + 619 + (* Parse a cookie with Max-Age *) 620 + let header = "session=xyz; Max-Age=7200; Secure; HttpOnly" in 621 + let cookie_opt = 622 + parse_set_cookie ~clock ~domain:"example.com" ~path:"/" header 623 + in 624 + Alcotest.(check bool) "cookie parsed" true (Option.is_some cookie_opt); 625 + let cookie = Option.get cookie_opt in 626 + 627 + (* Generate Set-Cookie header from the cookie *) 628 + let set_cookie_header = make_set_cookie_header cookie in 629 + 630 + (* Parse it back *) 631 + Eio_mock.Clock.set_time clock 5000.0; 632 + (* Reset clock to same time *) 633 + let cookie2_opt = 634 + parse_set_cookie ~clock ~domain:"example.com" ~path:"/" set_cookie_header 635 + in 636 + Alcotest.(check bool) "cookie re-parsed" true (Option.is_some cookie2_opt); 637 + let cookie2 = Option.get cookie2_opt in 638 + 639 + (* Verify max_age is preserved *) 640 + Alcotest.(check (option int)) 641 + "max_age preserved" 642 + (Ptime.Span.to_int_s (Option.get (Cookeio.max_age cookie))) 643 + (Ptime.Span.to_int_s (Option.get (Cookeio.max_age cookie2))) 644 + 645 + let test_domain_matching () = 646 + Eio_mock.Backend.run @@ fun () -> 647 + let clock = Eio_mock.Clock.make () in 648 + Eio_mock.Clock.set_time clock 2000.0; 649 + 650 + let jar = create () in 651 + 652 + (* Create a cookie with domain "example.com" *) 653 + let cookie = 654 + Cookeio.make ~domain:"example.com" ~path:"/" ~name:"test" ~value:"value" 655 + ~secure:false ~http_only:false ?expires:None ?same_site:None ?max_age:None 656 + ~creation_time:(Ptime.of_float_s 2000.0 |> Option.get) 657 + ~last_access:(Ptime.of_float_s 2000.0 |> Option.get) 658 + () 659 + in 660 + add_cookie jar cookie; 661 + 662 + (* Test "example.com" cookie matches "example.com" request *) 663 + let cookies1 = 664 + get_cookies jar ~clock ~domain:"example.com" ~path:"/" ~is_secure:false 665 + in 666 + Alcotest.(check int) "matches exact domain" 1 (List.length cookies1); 667 + 668 + (* Test "example.com" cookie matches "sub.example.com" request *) 669 + let cookies2 = 670 + get_cookies jar ~clock ~domain:"sub.example.com" ~path:"/" ~is_secure:false 671 + in 672 + Alcotest.(check int) "matches subdomain" 1 (List.length cookies2); 673 + 674 + (* Test "example.com" cookie matches "deep.sub.example.com" request *) 675 + let cookies3 = 676 + get_cookies jar ~clock ~domain:"deep.sub.example.com" ~path:"/" 677 + ~is_secure:false 678 + in 679 + Alcotest.(check int) "matches deep subdomain" 1 (List.length cookies3); 680 + 681 + (* Test "example.com" cookie doesn't match "notexample.com" *) 682 + let cookies4 = 683 + get_cookies jar ~clock ~domain:"notexample.com" ~path:"/" ~is_secure:false 684 + in 685 + Alcotest.(check int) "doesn't match different domain" 0 (List.length cookies4); 686 + 687 + (* Test "example.com" cookie doesn't match "fakeexample.com" *) 688 + let cookies5 = 689 + get_cookies jar ~clock ~domain:"fakeexample.com" ~path:"/" ~is_secure:false 690 + in 691 + Alcotest.(check int) "doesn't match prefix domain" 0 (List.length cookies5) 692 + 693 + (** {1 HTTP Date Parsing Tests} *) 694 + 695 + let test_http_date_fmt1 () = 696 + Eio_mock.Backend.run @@ fun () -> 697 + let clock = Eio_mock.Clock.make () in 698 + Eio_mock.Clock.set_time clock 1000.0; 699 + 700 + (* Test FMT1: "Wed, 21 Oct 2015 07:28:00 GMT" (RFC 1123) *) 701 + let header = "session=abc; Expires=Wed, 21 Oct 2015 07:28:00 GMT" in 702 + let cookie_opt = 703 + parse_set_cookie ~clock ~domain:"example.com" ~path:"/" header 704 + in 705 + Alcotest.(check bool) "FMT1 cookie parsed" true (Option.is_some cookie_opt); 706 + 707 + let cookie = Option.get cookie_opt in 708 + Alcotest.(check bool) 709 + "FMT1 has expiry" true 710 + (Option.is_some (Cookeio.expires cookie)); 711 + 712 + (* Verify the parsed time matches expected value *) 713 + let expected = Ptime.of_date_time ((2015, 10, 21), ((07, 28, 00), 0)) in 714 + Alcotest.(check (option (Alcotest.testable Ptime.pp Ptime.equal))) 715 + "FMT1 expiry correct" expected (Cookeio.expires cookie) 716 + 717 + let test_http_date_fmt2 () = 718 + Eio_mock.Backend.run @@ fun () -> 719 + let clock = Eio_mock.Clock.make () in 720 + Eio_mock.Clock.set_time clock 1000.0; 721 + 722 + (* Test FMT2: "Wednesday, 21-Oct-15 07:28:00 GMT" (RFC 850 with abbreviated year) *) 723 + let header = "session=abc; Expires=Wednesday, 21-Oct-15 07:28:00 GMT" in 724 + let cookie_opt = 725 + parse_set_cookie ~clock ~domain:"example.com" ~path:"/" header 726 + in 727 + Alcotest.(check bool) "FMT2 cookie parsed" true (Option.is_some cookie_opt); 728 + 729 + let cookie = Option.get cookie_opt in 730 + Alcotest.(check bool) 731 + "FMT2 has expiry" true 732 + (Option.is_some (Cookeio.expires cookie)); 733 + 734 + (* Year 15 should be normalized to 2015 *) 735 + let expected = Ptime.of_date_time ((2015, 10, 21), ((07, 28, 00), 0)) in 736 + Alcotest.(check (option (Alcotest.testable Ptime.pp Ptime.equal))) 737 + "FMT2 expiry correct with year normalization" expected 738 + (Cookeio.expires cookie) 739 + 740 + let test_http_date_fmt3 () = 741 + Eio_mock.Backend.run @@ fun () -> 742 + let clock = Eio_mock.Clock.make () in 743 + Eio_mock.Clock.set_time clock 1000.0; 744 + 745 + (* Test FMT3: "Wed Oct 21 07:28:00 2015" (asctime) *) 746 + let header = "session=abc; Expires=Wed Oct 21 07:28:00 2015" in 747 + let cookie_opt = 748 + parse_set_cookie ~clock ~domain:"example.com" ~path:"/" header 749 + in 750 + Alcotest.(check bool) "FMT3 cookie parsed" true (Option.is_some cookie_opt); 751 + 752 + let cookie = Option.get cookie_opt in 753 + Alcotest.(check bool) 754 + "FMT3 has expiry" true 755 + (Option.is_some (Cookeio.expires cookie)); 756 + 757 + let expected = Ptime.of_date_time ((2015, 10, 21), ((07, 28, 00), 0)) in 758 + Alcotest.(check (option (Alcotest.testable Ptime.pp Ptime.equal))) 759 + "FMT3 expiry correct" expected (Cookeio.expires cookie) 760 + 761 + let test_http_date_fmt4 () = 762 + Eio_mock.Backend.run @@ fun () -> 763 + let clock = Eio_mock.Clock.make () in 764 + Eio_mock.Clock.set_time clock 1000.0; 765 + 766 + (* Test FMT4: "Wed, 21-Oct-2015 07:28:00 GMT" (variant) *) 767 + let header = "session=abc; Expires=Wed, 21-Oct-2015 07:28:00 GMT" in 768 + let cookie_opt = 769 + parse_set_cookie ~clock ~domain:"example.com" ~path:"/" header 770 + in 771 + Alcotest.(check bool) "FMT4 cookie parsed" true (Option.is_some cookie_opt); 772 + 773 + let cookie = Option.get cookie_opt in 774 + Alcotest.(check bool) 775 + "FMT4 has expiry" true 776 + (Option.is_some (Cookeio.expires cookie)); 777 + 778 + let expected = Ptime.of_date_time ((2015, 10, 21), ((07, 28, 00), 0)) in 779 + Alcotest.(check (option (Alcotest.testable Ptime.pp Ptime.equal))) 780 + "FMT4 expiry correct" expected (Cookeio.expires cookie) 781 + 782 + let test_abbreviated_year_69_to_99 () = 783 + Eio_mock.Backend.run @@ fun () -> 784 + let clock = Eio_mock.Clock.make () in 785 + Eio_mock.Clock.set_time clock 1000.0; 786 + 787 + (* Year 95 should become 1995 *) 788 + let header = "session=abc; Expires=Wed, 21-Oct-95 07:28:00 GMT" in 789 + let cookie_opt = 790 + parse_set_cookie ~clock ~domain:"example.com" ~path:"/" header 791 + in 792 + let cookie = Option.get cookie_opt in 793 + let expected = Ptime.of_date_time ((1995, 10, 21), ((07, 28, 00), 0)) in 794 + Alcotest.(check (option (Alcotest.testable Ptime.pp Ptime.equal))) 795 + "year 95 becomes 1995" expected (Cookeio.expires cookie); 796 + 797 + (* Year 69 should become 1969 *) 798 + let header2 = "session=abc; Expires=Wed, 10-Sep-69 20:00:00 GMT" in 799 + let cookie_opt2 = 800 + parse_set_cookie ~clock ~domain:"example.com" ~path:"/" header2 801 + in 802 + let cookie2 = Option.get cookie_opt2 in 803 + let expected2 = Ptime.of_date_time ((1969, 9, 10), ((20, 0, 0), 0)) in 804 + Alcotest.(check (option (Alcotest.testable Ptime.pp Ptime.equal))) 805 + "year 69 becomes 1969" expected2 (Cookeio.expires cookie2); 806 + 807 + (* Year 99 should become 1999 *) 808 + let header3 = "session=abc; Expires=Thu, 10-Sep-99 20:00:00 GMT" in 809 + let cookie_opt3 = 810 + parse_set_cookie ~clock ~domain:"example.com" ~path:"/" header3 811 + in 812 + let cookie3 = Option.get cookie_opt3 in 813 + let expected3 = Ptime.of_date_time ((1999, 9, 10), ((20, 0, 0), 0)) in 814 + Alcotest.(check (option (Alcotest.testable Ptime.pp Ptime.equal))) 815 + "year 99 becomes 1999" expected3 (Cookeio.expires cookie3) 816 + 817 + let test_abbreviated_year_0_to_68 () = 818 + Eio_mock.Backend.run @@ fun () -> 819 + let clock = Eio_mock.Clock.make () in 820 + Eio_mock.Clock.set_time clock 1000.0; 821 + 822 + (* Year 25 should become 2025 *) 823 + let header = "session=abc; Expires=Wed, 21-Oct-25 07:28:00 GMT" in 824 + let cookie_opt = 825 + parse_set_cookie ~clock ~domain:"example.com" ~path:"/" header 826 + in 827 + let cookie = Option.get cookie_opt in 828 + let expected = Ptime.of_date_time ((2025, 10, 21), ((07, 28, 00), 0)) in 829 + Alcotest.(check (option (Alcotest.testable Ptime.pp Ptime.equal))) 830 + "year 25 becomes 2025" expected (Cookeio.expires cookie); 831 + 832 + (* Year 0 should become 2000 *) 833 + let header2 = "session=abc; Expires=Fri, 01-Jan-00 00:00:00 GMT" in 834 + let cookie_opt2 = 835 + parse_set_cookie ~clock ~domain:"example.com" ~path:"/" header2 836 + in 837 + let cookie2 = Option.get cookie_opt2 in 838 + let expected2 = Ptime.of_date_time ((2000, 1, 1), ((0, 0, 0), 0)) in 839 + Alcotest.(check (option (Alcotest.testable Ptime.pp Ptime.equal))) 840 + "year 0 becomes 2000" expected2 (Cookeio.expires cookie2); 841 + 842 + (* Year 68 should become 2068 *) 843 + let header3 = "session=abc; Expires=Thu, 10-Sep-68 20:00:00 GMT" in 844 + let cookie_opt3 = 845 + parse_set_cookie ~clock ~domain:"example.com" ~path:"/" header3 846 + in 847 + let cookie3 = Option.get cookie_opt3 in 848 + let expected3 = Ptime.of_date_time ((2068, 9, 10), ((20, 0, 0), 0)) in 849 + Alcotest.(check (option (Alcotest.testable Ptime.pp Ptime.equal))) 850 + "year 68 becomes 2068" expected3 (Cookeio.expires cookie3) 851 + 852 + let test_rfc3339_still_works () = 853 + Eio_mock.Backend.run @@ fun () -> 854 + let clock = Eio_mock.Clock.make () in 855 + Eio_mock.Clock.set_time clock 1000.0; 856 + 857 + (* Ensure RFC 3339 format still works for backward compatibility *) 858 + let header = "session=abc; Expires=2025-10-21T07:28:00Z" in 859 + let cookie_opt = 860 + parse_set_cookie ~clock ~domain:"example.com" ~path:"/" header 861 + in 862 + Alcotest.(check bool) 863 + "RFC 3339 cookie parsed" true 864 + (Option.is_some cookie_opt); 865 + 866 + let cookie = Option.get cookie_opt in 867 + Alcotest.(check bool) 868 + "RFC 3339 has expiry" true 869 + (Option.is_some (Cookeio.expires cookie)); 870 + 871 + (* Verify the time was parsed correctly *) 872 + let expected = Ptime.of_rfc3339 "2025-10-21T07:28:00Z" in 873 + match expected with 874 + | Ok (time, _, _) -> 875 + Alcotest.(check (option (Alcotest.testable Ptime.pp Ptime.equal))) 876 + "RFC 3339 expiry correct" (Some time) (Cookeio.expires cookie) 877 + | Error _ -> Alcotest.fail "Failed to parse expected RFC 3339 time" 878 + 879 + let test_invalid_date_format_logs_warning () = 880 + Eio_mock.Backend.run @@ fun () -> 881 + let clock = Eio_mock.Clock.make () in 882 + Eio_mock.Clock.set_time clock 1000.0; 883 + 884 + (* Invalid date format should log a warning but still parse the cookie *) 885 + let header = "session=abc; Expires=InvalidDate" in 886 + let cookie_opt = 887 + parse_set_cookie ~clock ~domain:"example.com" ~path:"/" header 888 + in 889 + 890 + (* Cookie should still be parsed, just without expires *) 891 + Alcotest.(check bool) 892 + "cookie parsed despite invalid date" true 893 + (Option.is_some cookie_opt); 894 + let cookie = Option.get cookie_opt in 895 + Alcotest.(check string) "cookie name correct" "session" (Cookeio.name cookie); 896 + Alcotest.(check string) "cookie value correct" "abc" (Cookeio.value cookie); 897 + (* expires should be None since date was invalid *) 898 + Alcotest.(check (option (Alcotest.testable Ptime.pp Ptime.equal))) 899 + "expires is None for invalid date" None (Cookeio.expires cookie) 900 + 901 + let test_case_insensitive_month_parsing () = 902 + Eio_mock.Backend.run @@ fun () -> 903 + let clock = Eio_mock.Clock.make () in 904 + Eio_mock.Clock.set_time clock 1000.0; 905 + 906 + (* Test various case combinations for month names *) 907 + let test_cases = 908 + [ 909 + ("session=abc; Expires=Wed, 21 oct 2015 07:28:00 GMT", "lowercase month"); 910 + ("session=abc; Expires=Wed, 21 OCT 2015 07:28:00 GMT", "uppercase month"); 911 + ("session=abc; Expires=Wed, 21 OcT 2015 07:28:00 GMT", "mixed case month"); 912 + ("session=abc; Expires=Wed, 21 oCt 2015 07:28:00 GMT", "weird case month"); 913 + ] 914 + in 915 + 916 + List.iter 917 + (fun (header, description) -> 918 + let cookie_opt = 919 + parse_set_cookie ~clock ~domain:"example.com" ~path:"/" header 920 + in 921 + Alcotest.(check bool) 922 + (description ^ " parsed") true 923 + (Option.is_some cookie_opt); 924 + 925 + let cookie = Option.get cookie_opt in 926 + Alcotest.(check bool) 927 + (description ^ " has expiry") 928 + true 929 + (Option.is_some (Cookeio.expires cookie)); 930 + 931 + (* Verify the date was parsed correctly regardless of case *) 932 + let expires = Option.get (Cookeio.expires cookie) in 933 + let year, month, _ = Ptime.to_date expires in 934 + Alcotest.(check int) (description ^ " year correct") 2015 year; 935 + Alcotest.(check int) 936 + (description ^ " month correct (October=10)") 937 + 10 month) 938 + test_cases 939 + 940 + let test_case_insensitive_gmt_parsing () = 941 + Eio_mock.Backend.run @@ fun () -> 942 + let clock = Eio_mock.Clock.make () in 943 + Eio_mock.Clock.set_time clock 1000.0; 944 + 945 + (* Test various case combinations for GMT timezone *) 946 + let test_cases = 947 + [ 948 + ("session=abc; Expires=Wed, 21 Oct 2015 07:28:00 GMT", "uppercase GMT"); 949 + ("session=abc; Expires=Wed, 21 Oct 2015 07:28:00 gmt", "lowercase gmt"); 950 + ("session=abc; Expires=Wed, 21 Oct 2015 07:28:00 Gmt", "mixed case Gmt"); 951 + ("session=abc; Expires=Wed, 21 Oct 2015 07:28:00 GmT", "weird case GmT"); 952 + ] 953 + in 954 + 955 + List.iter 956 + (fun (header, description) -> 957 + let cookie_opt = 958 + parse_set_cookie ~clock ~domain:"example.com" ~path:"/" header 959 + in 960 + Alcotest.(check bool) 961 + (description ^ " parsed") true 962 + (Option.is_some cookie_opt); 963 + 964 + let cookie = Option.get cookie_opt in 965 + Alcotest.(check bool) 966 + (description ^ " has expiry") 967 + true 968 + (Option.is_some (Cookeio.expires cookie)); 969 + 970 + (* Verify the date was parsed correctly regardless of GMT case *) 971 + let expires = Option.get (Cookeio.expires cookie) in 972 + let year, month, day = Ptime.to_date expires in 973 + Alcotest.(check int) (description ^ " year correct") 2015 year; 974 + Alcotest.(check int) 975 + (description ^ " month correct (October=10)") 976 + 10 month; 977 + Alcotest.(check int) (description ^ " day correct") 21 day) 978 + test_cases 979 + 980 + (** {1 Delta Tracking Tests} *) 981 + 982 + let test_add_original_not_in_delta () = 983 + Eio_mock.Backend.run @@ fun () -> 984 + let clock = Eio_mock.Clock.make () in 985 + Eio_mock.Clock.set_time clock 1000.0; 986 + 987 + let jar = create () in 988 + let cookie = 989 + Cookeio.make ~domain:"example.com" ~path:"/" ~name:"test" ~value:"value" 990 + ~secure:false ~http_only:false ?expires:None ?same_site:None ?max_age:None 991 + ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get) 992 + ~last_access:(Ptime.of_float_s 1000.0 |> Option.get) 993 + () 994 + in 995 + add_original jar cookie; 996 + 997 + (* Delta should be empty *) 998 + let delta = Cookeio.delta jar in 999 + Alcotest.(check int) "delta is empty" 0 (List.length delta); 1000 + 1001 + (* But the cookie should be in the jar *) 1002 + Alcotest.(check int) "jar count is 1" 1 (count jar) 1003 + 1004 + let test_add_cookie_appears_in_delta () = 1005 + Eio_mock.Backend.run @@ fun () -> 1006 + let clock = Eio_mock.Clock.make () in 1007 + Eio_mock.Clock.set_time clock 1000.0; 1008 + 1009 + let jar = create () in 1010 + let cookie = 1011 + Cookeio.make ~domain:"example.com" ~path:"/" ~name:"test" ~value:"value" 1012 + ~secure:false ~http_only:false ?expires:None ?same_site:None ?max_age:None 1013 + ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get) 1014 + ~last_access:(Ptime.of_float_s 1000.0 |> Option.get) 1015 + () 1016 + in 1017 + add_cookie jar cookie; 1018 + 1019 + (* Delta should contain the cookie *) 1020 + let delta = Cookeio.delta jar in 1021 + Alcotest.(check int) "delta has 1 cookie" 1 (List.length delta); 1022 + let delta_cookie = List.hd delta in 1023 + Alcotest.(check string) "delta cookie name" "test" (Cookeio.name delta_cookie); 1024 + Alcotest.(check string) 1025 + "delta cookie value" "value" 1026 + (Cookeio.value delta_cookie) 1027 + 1028 + let test_remove_original_creates_removal_cookie () = 1029 + Eio_mock.Backend.run @@ fun () -> 1030 + let clock = Eio_mock.Clock.make () in 1031 + Eio_mock.Clock.set_time clock 1000.0; 1032 + 1033 + let jar = create () in 1034 + let cookie = 1035 + Cookeio.make ~domain:"example.com" ~path:"/" ~name:"test" ~value:"value" 1036 + ~secure:false ~http_only:false ?expires:None ?same_site:None ?max_age:None 1037 + ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get) 1038 + ~last_access:(Ptime.of_float_s 1000.0 |> Option.get) 1039 + () 1040 + in 1041 + add_original jar cookie; 1042 + 1043 + (* Remove the cookie *) 1044 + Cookeio.remove jar ~clock cookie; 1045 + 1046 + (* Delta should contain a removal cookie *) 1047 + let delta = Cookeio.delta jar in 1048 + Alcotest.(check int) "delta has 1 removal cookie" 1 (List.length delta); 1049 + let removal_cookie = List.hd delta in 1050 + Alcotest.(check string) 1051 + "removal cookie name" "test" 1052 + (Cookeio.name removal_cookie); 1053 + Alcotest.(check string) 1054 + "removal cookie has empty value" "" 1055 + (Cookeio.value removal_cookie); 1056 + 1057 + (* Check Max-Age is 0 *) 1058 + match Cookeio.max_age removal_cookie with 1059 + | Some span -> 1060 + Alcotest.(check (option int)) 1061 + "removal cookie Max-Age is 0" (Some 0) (Ptime.Span.to_int_s span) 1062 + | None -> Alcotest.fail "removal cookie should have Max-Age" 1063 + 1064 + let test_remove_delta_cookie_removes_it () = 1065 + Eio_mock.Backend.run @@ fun () -> 1066 + let clock = Eio_mock.Clock.make () in 1067 + Eio_mock.Clock.set_time clock 1000.0; 1068 + 1069 + let jar = create () in 1070 + let cookie = 1071 + Cookeio.make ~domain:"example.com" ~path:"/" ~name:"test" ~value:"value" 1072 + ~secure:false ~http_only:false ?expires:None ?same_site:None ?max_age:None 1073 + ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get) 1074 + ~last_access:(Ptime.of_float_s 1000.0 |> Option.get) 1075 + () 1076 + in 1077 + add_cookie jar cookie; 1078 + 1079 + (* Remove the cookie *) 1080 + Cookeio.remove jar ~clock cookie; 1081 + 1082 + (* Delta should be empty *) 1083 + let delta = Cookeio.delta jar in 1084 + Alcotest.(check int) 1085 + "delta is empty after removing delta cookie" 0 (List.length delta) 1086 + 1087 + let test_get_cookies_combines_original_and_delta () = 1088 + Eio_mock.Backend.run @@ fun () -> 1089 + let clock = Eio_mock.Clock.make () in 1090 + Eio_mock.Clock.set_time clock 1000.0; 1091 + 1092 + let jar = create () in 1093 + 1094 + (* Add an original cookie *) 1095 + let original = 1096 + Cookeio.make ~domain:"example.com" ~path:"/" ~name:"original" 1097 + ~value:"orig_val" ~secure:false ~http_only:false ?expires:None 1098 + ?same_site:None ?max_age:None 1099 + ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get) 1100 + ~last_access:(Ptime.of_float_s 1000.0 |> Option.get) 1101 + () 1102 + in 1103 + add_original jar original; 1104 + 1105 + (* Add a delta cookie *) 1106 + let delta_cookie = 1107 + Cookeio.make ~domain:"example.com" ~path:"/" ~name:"delta" 1108 + ~value:"delta_val" ~secure:false ~http_only:false ?expires:None 1109 + ?same_site:None ?max_age:None 1110 + ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get) 1111 + ~last_access:(Ptime.of_float_s 1000.0 |> Option.get) 1112 + () 1113 + in 1114 + add_cookie jar delta_cookie; 1115 + 1116 + (* Get cookies should return both *) 1117 + let cookies = 1118 + get_cookies jar ~clock ~domain:"example.com" ~path:"/" ~is_secure:false 1119 + in 1120 + Alcotest.(check int) "both cookies returned" 2 (List.length cookies); 1121 + 1122 + let names = List.map Cookeio.name cookies |> List.sort String.compare in 1123 + Alcotest.(check (list string)) "cookie names" [ "delta"; "original" ] names 1124 + 1125 + let test_get_cookies_delta_takes_precedence () = 1126 + Eio_mock.Backend.run @@ fun () -> 1127 + let clock = Eio_mock.Clock.make () in 1128 + Eio_mock.Clock.set_time clock 1000.0; 1129 + 1130 + let jar = create () in 1131 + 1132 + (* Add an original cookie *) 1133 + let original = 1134 + Cookeio.make ~domain:"example.com" ~path:"/" ~name:"test" ~value:"orig_val" 1135 + ~secure:false ~http_only:false ?expires:None ?same_site:None ?max_age:None 1136 + ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get) 1137 + ~last_access:(Ptime.of_float_s 1000.0 |> Option.get) 1138 + () 1139 + in 1140 + add_original jar original; 1141 + 1142 + (* Add a delta cookie with the same name/domain/path *) 1143 + let delta_cookie = 1144 + Cookeio.make ~domain:"example.com" ~path:"/" ~name:"test" ~value:"delta_val" 1145 + ~secure:false ~http_only:false ?expires:None ?same_site:None ?max_age:None 1146 + ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get) 1147 + ~last_access:(Ptime.of_float_s 1000.0 |> Option.get) 1148 + () 1149 + in 1150 + add_cookie jar delta_cookie; 1151 + 1152 + (* Get cookies should return only the delta cookie *) 1153 + let cookies = 1154 + get_cookies jar ~clock ~domain:"example.com" ~path:"/" ~is_secure:false 1155 + in 1156 + Alcotest.(check int) "only one cookie returned" 1 (List.length cookies); 1157 + let cookie = List.hd cookies in 1158 + Alcotest.(check string) 1159 + "delta cookie value" "delta_val" (Cookeio.value cookie) 1160 + 1161 + let test_get_cookies_excludes_removal_cookies () = 1162 + Eio_mock.Backend.run @@ fun () -> 1163 + let clock = Eio_mock.Clock.make () in 1164 + Eio_mock.Clock.set_time clock 1000.0; 1165 + 1166 + let jar = create () in 1167 + 1168 + (* Add an original cookie *) 1169 + let original = 1170 + Cookeio.make ~domain:"example.com" ~path:"/" ~name:"test" ~value:"value" 1171 + ~secure:false ~http_only:false ?expires:None ?same_site:None ?max_age:None 1172 + ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get) 1173 + ~last_access:(Ptime.of_float_s 1000.0 |> Option.get) 1174 + () 1175 + in 1176 + add_original jar original; 1177 + 1178 + (* Remove it *) 1179 + Cookeio.remove jar ~clock original; 1180 + 1181 + (* Get cookies should return nothing *) 1182 + let cookies = 1183 + get_cookies jar ~clock ~domain:"example.com" ~path:"/" ~is_secure:false 1184 + in 1185 + Alcotest.(check int) "no cookies returned" 0 (List.length cookies); 1186 + 1187 + (* But delta should have the removal cookie *) 1188 + let delta = Cookeio.delta jar in 1189 + Alcotest.(check int) "delta has removal cookie" 1 (List.length delta) 1190 + 1191 + let test_delta_returns_only_changed_cookies () = 1192 + Eio_mock.Backend.run @@ fun () -> 1193 + let clock = Eio_mock.Clock.make () in 1194 + Eio_mock.Clock.set_time clock 1000.0; 1195 + 1196 + let jar = create () in 1197 + 1198 + (* Add original cookies *) 1199 + let original1 = 1200 + Cookeio.make ~domain:"example.com" ~path:"/" ~name:"orig1" ~value:"val1" 1201 + ~secure:false ~http_only:false ?expires:None ?same_site:None ?max_age:None 1202 + ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get) 1203 + ~last_access:(Ptime.of_float_s 1000.0 |> Option.get) 1204 + () 1205 + in 1206 + add_original jar original1; 1207 + 1208 + let original2 = 1209 + Cookeio.make ~domain:"example.com" ~path:"/" ~name:"orig2" ~value:"val2" 1210 + ~secure:false ~http_only:false ?expires:None ?same_site:None ?max_age:None 1211 + ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get) 1212 + ~last_access:(Ptime.of_float_s 1000.0 |> Option.get) 1213 + () 1214 + in 1215 + add_original jar original2; 1216 + 1217 + (* Add a new delta cookie *) 1218 + let new_cookie = 1219 + Cookeio.make ~domain:"example.com" ~path:"/" ~name:"new" ~value:"new_val" 1220 + ~secure:false ~http_only:false ?expires:None ?same_site:None ?max_age:None 1221 + ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get) 1222 + ~last_access:(Ptime.of_float_s 1000.0 |> Option.get) 1223 + () 1224 + in 1225 + add_cookie jar new_cookie; 1226 + 1227 + (* Delta should only contain the new cookie *) 1228 + let delta = Cookeio.delta jar in 1229 + Alcotest.(check int) "delta has 1 cookie" 1 (List.length delta); 1230 + let delta_cookie = List.hd delta in 1231 + Alcotest.(check string) "delta cookie name" "new" (Cookeio.name delta_cookie) 1232 + 1233 + let test_removal_cookie_format () = 1234 + Eio_mock.Backend.run @@ fun () -> 1235 + let clock = Eio_mock.Clock.make () in 1236 + Eio_mock.Clock.set_time clock 1000.0; 1237 + 1238 + let jar = create () in 1239 + let cookie = 1240 + Cookeio.make ~domain:"example.com" ~path:"/" ~name:"test" ~value:"value" 1241 + ~secure:true ~http_only:true ?expires:None ~same_site:`Strict 1242 + ?max_age:None 1243 + ~creation_time:(Ptime.of_float_s 1000.0 |> Option.get) 1244 + ~last_access:(Ptime.of_float_s 1000.0 |> Option.get) 1245 + () 1246 + in 1247 + add_original jar cookie; 1248 + 1249 + (* Remove the cookie *) 1250 + Cookeio.remove jar ~clock cookie; 1251 + 1252 + (* Get the removal cookie *) 1253 + let delta = Cookeio.delta jar in 1254 + let removal = List.hd delta in 1255 + 1256 + (* Check all properties *) 1257 + Alcotest.(check string) 1258 + "removal cookie has empty value" "" (Cookeio.value removal); 1259 + Alcotest.(check (option int)) 1260 + "removal cookie Max-Age is 0" (Some 0) 1261 + (Option.bind (Cookeio.max_age removal) Ptime.Span.to_int_s); 1262 + 1263 + (* Check expires is in the past *) 1264 + let now = Ptime.of_float_s 1000.0 |> Option.get in 1265 + match Cookeio.expires removal with 1266 + | Some exp -> 1267 + Alcotest.(check bool) 1268 + "expires is in the past" true 1269 + (Ptime.compare exp now < 0) 1270 + | None -> Alcotest.fail "removal cookie should have expires" 1271 + 448 1272 let () = 449 1273 Eio_main.run @@ fun env -> 450 1274 let open Alcotest in ··· 465 1289 test_cookie_matching env); 466 1290 ] ); 467 1291 ( "basic_operations", 468 - [ test_case "Empty jar operations" `Quick (fun () -> test_empty_jar env) ] 469 - ); 1292 + [ 1293 + test_case "Empty jar operations" `Quick (fun () -> test_empty_jar env); 1294 + ] ); 470 1295 ( "time_handling", 471 1296 [ 472 1297 test_case "Cookie expiry with mock clock" `Quick ··· 479 1304 test_parse_set_cookie_with_expires; 480 1305 test_case "SameSite=None validation" `Quick 481 1306 test_samesite_none_validation; 1307 + ] ); 1308 + ( "domain_normalization", 1309 + [ 1310 + test_case "Domain normalization" `Quick test_domain_normalization; 1311 + test_case "Domain matching with normalized domains" `Quick 1312 + test_domain_matching; 1313 + ] ); 1314 + ( "max_age_tracking", 1315 + [ 1316 + test_case "Max-Age stored separately from Expires" `Quick 1317 + test_max_age_stored_separately; 1318 + test_case "Negative Max-Age becomes 0" `Quick 1319 + test_max_age_negative_becomes_zero; 1320 + test_case "make_set_cookie_header includes Max-Age" `Quick 1321 + test_make_set_cookie_header_includes_max_age; 1322 + test_case "Max-Age round-trip parsing" `Quick test_max_age_round_trip; 1323 + ] ); 1324 + ( "delta_tracking", 1325 + [ 1326 + test_case "add_original doesn't affect delta" `Quick 1327 + test_add_original_not_in_delta; 1328 + test_case "add_cookie appears in delta" `Quick 1329 + test_add_cookie_appears_in_delta; 1330 + test_case "remove original creates removal cookie" `Quick 1331 + test_remove_original_creates_removal_cookie; 1332 + test_case "remove delta cookie just removes it" `Quick 1333 + test_remove_delta_cookie_removes_it; 1334 + test_case "get_cookies combines original and delta" `Quick 1335 + test_get_cookies_combines_original_and_delta; 1336 + test_case "get_cookies delta takes precedence" `Quick 1337 + test_get_cookies_delta_takes_precedence; 1338 + test_case "get_cookies excludes removal cookies" `Quick 1339 + test_get_cookies_excludes_removal_cookies; 1340 + test_case "delta returns only changed cookies" `Quick 1341 + test_delta_returns_only_changed_cookies; 1342 + test_case "removal cookie format" `Quick test_removal_cookie_format; 1343 + ] ); 1344 + ( "http_date_parsing", 1345 + [ 1346 + test_case "HTTP date FMT1 (RFC 1123)" `Quick test_http_date_fmt1; 1347 + test_case "HTTP date FMT2 (RFC 850)" `Quick test_http_date_fmt2; 1348 + test_case "HTTP date FMT3 (asctime)" `Quick test_http_date_fmt3; 1349 + test_case "HTTP date FMT4 (variant)" `Quick test_http_date_fmt4; 1350 + test_case "Abbreviated year 69-99 becomes 1900+" `Quick 1351 + test_abbreviated_year_69_to_99; 1352 + test_case "Abbreviated year 0-68 becomes 2000+" `Quick 1353 + test_abbreviated_year_0_to_68; 1354 + test_case "RFC 3339 backward compatibility" `Quick 1355 + test_rfc3339_still_works; 1356 + test_case "Invalid date format logs warning" `Quick 1357 + test_invalid_date_format_logs_warning; 1358 + test_case "Case-insensitive month parsing" `Quick 1359 + test_case_insensitive_month_parsing; 1360 + test_case "Case-insensitive GMT parsing" `Quick 1361 + test_case_insensitive_gmt_parsing; 482 1362 ] ); 483 1363 ]