+115 -88

lib/cookeio.ml

··· 71 71 72 72 (** {1 Cookie Parsing} *) 73 73 74 74 - let parse_cookie_attribute attr attr_value cookie = 75 75 - let attr_lower = String.lowercase_ascii attr in 74 74 + (** Accumulated attributes from parsing Set-Cookie header *) 75 75 + type cookie_attributes = { 76 76 + mutable domain : string option; 77 77 + mutable path : string option; 78 78 + mutable secure : bool; 79 79 + mutable http_only : bool; 80 80 + mutable expires : Ptime.t option; 81 81 + mutable same_site : same_site option; 82 82 + } 83 83 + 84 84 + (** Create empty attribute accumulator *) 85 85 + let empty_attributes () = 86 86 + { 87 87 + domain = None; 88 88 + path = None; 89 89 + secure = false; 90 90 + http_only = false; 91 91 + expires = None; 92 92 + same_site = None; 93 93 + } 94 94 + 95 95 + (** Parse a single attribute and update the accumulator in-place *) 96 96 + let parse_attribute clock attrs attr_name attr_value = 97 97 + let attr_lower = String.lowercase_ascii attr_name in 76 98 match attr_lower with 77 77 - | "domain" -> make ~domain:attr_value ~path:(path cookie) ~name:(name cookie) 78 78 - ~value:(value cookie) ~secure:(secure cookie) ~http_only:(http_only cookie) 79 79 - ?expires:(expires cookie) ?same_site:(same_site cookie) 80 80 - ~creation_time:(creation_time cookie) ~last_access:(last_access cookie) () 81 81 - | "path" -> make ~domain:(domain cookie) ~path:attr_value ~name:(name cookie) 82 82 - ~value:(value cookie) ~secure:(secure cookie) ~http_only:(http_only cookie) 83 83 - ?expires:(expires cookie) ?same_site:(same_site cookie) 84 84 - ~creation_time:(creation_time cookie) ~last_access:(last_access cookie) () 99 99 + | "domain" -> attrs.domain <- Some attr_value 100 100 + | "path" -> attrs.path <- Some attr_value 85 101 | "expires" -> ( 86 86 - try 87 87 - let time, _tz_offset, _tz_string = 88 88 - Ptime.of_rfc3339 attr_value |> Result.get_ok 89 89 - in 90 90 - make ~domain:(domain cookie) ~path:(path cookie) ~name:(name cookie) 91 91 - ~value:(value cookie) ~secure:(secure cookie) ~http_only:(http_only cookie) 92 92 - ~expires:time ?same_site:(same_site cookie) 93 93 - ~creation_time:(creation_time cookie) ~last_access:(last_access cookie) () 94 94 - with _ -> 95 95 - Log.debug (fun m -> m "Failed to parse expires: %s" attr_value); 96 96 - cookie) 102 102 + match Ptime.of_rfc3339 attr_value with 103 103 + | Ok (time, _, _) -> attrs.expires <- Some time 104 104 + | Error (`RFC3339 (_, err)) -> 105 105 + Log.warn (fun m -> 106 106 + m "Failed to parse expires attribute '%s': %a" attr_value 107 107 + Ptime.pp_rfc3339_error err)) 97 108 | "max-age" -> ( 98 98 - try 99 99 - let seconds = int_of_string attr_value in 100 100 - let now = Unix.time () in 101 101 - let expires = Ptime.of_float_s (now +. float_of_int seconds) in 102 102 - make ~domain:(domain cookie) ~path:(path cookie) ~name:(name cookie) 103 103 - ~value:(value cookie) ~secure:(secure cookie) ~http_only:(http_only cookie) 104 104 - ?expires ?same_site:(same_site cookie) 105 105 - ~creation_time:(creation_time cookie) ~last_access:(last_access cookie) () 106 106 - with _ -> cookie) 107 107 - | "secure" -> make ~domain:(domain cookie) ~path:(path cookie) ~name:(name cookie) 108 108 - ~value:(value cookie) ~secure:true ~http_only:(http_only cookie) 109 109 - ?expires:(expires cookie) ?same_site:(same_site cookie) 110 110 - ~creation_time:(creation_time cookie) ~last_access:(last_access cookie) () 111 111 - | "httponly" -> make ~domain:(domain cookie) ~path:(path cookie) ~name:(name cookie) 112 112 - ~value:(value cookie) ~secure:(secure cookie) ~http_only:true 113 113 - ?expires:(expires cookie) ?same_site:(same_site cookie) 114 114 - ~creation_time:(creation_time cookie) ~last_access:(last_access cookie) () 115 115 - | "samesite" -> 116 116 - let same_site_val = 117 117 - match String.lowercase_ascii attr_value with 118 118 - | "strict" -> Some `Strict 119 119 - | "lax" -> Some `Lax 120 120 - | "none" -> Some `None 121 121 - | _ -> None 122 122 - in 123 123 - make ~domain:(domain cookie) ~path:(path cookie) ~name:(name cookie) 124 124 - ~value:(value cookie) ~secure:(secure cookie) ~http_only:(http_only cookie) 125 125 - ?expires:(expires cookie) ?same_site:same_site_val 126 126 - ~creation_time:(creation_time cookie) ~last_access:(last_access cookie) () 127 127 - | _ -> cookie 109 109 + match int_of_string_opt attr_value with 110 110 + | Some seconds -> 111 111 + let now = Eio.Time.now clock in 112 112 + let expires = Ptime.of_float_s (now +. float_of_int seconds) in 113 113 + attrs.expires <- expires 114 114 + | None -> 115 115 + Log.warn (fun m -> m "Failed to parse max-age attribute '%s'" attr_value)) 116 116 + | "secure" -> attrs.secure <- true 117 117 + | "httponly" -> attrs.http_only <- true 118 118 + | "samesite" -> ( 119 119 + match String.lowercase_ascii attr_value with 120 120 + | "strict" -> attrs.same_site <- Some `Strict 121 121 + | "lax" -> attrs.same_site <- Some `Lax 122 122 + | "none" -> attrs.same_site <- Some `None 123 123 + | _ -> 124 124 + Log.warn (fun m -> m "Invalid samesite value '%s', ignoring" attr_value)) 125 125 + | _ -> 126 126 + Log.debug (fun m -> m "Unknown cookie attribute '%s', ignoring" attr_name) 127 127 + 128 128 + (** Validate cookie attributes and log warnings for invalid combinations *) 129 129 + let validate_attributes attrs = 130 130 + (* SameSite=None requires Secure flag *) 131 131 + match attrs.same_site with 132 132 + | Some `None when not attrs.secure -> 133 133 + Log.warn (fun m -> 134 134 + m 135 135 + "Cookie has SameSite=None but Secure flag is not set; this violates \ 136 136 + RFC requirements"); 137 137 + false 138 138 + | _ -> true 139 139 + 140 140 + (** Build final cookie from name/value and accumulated attributes *) 141 141 + let build_cookie ~request_domain ~request_path ~name ~value attrs ~now = 142 142 + let domain = Option.value attrs.domain ~default:request_domain in 143 143 + let path = Option.value attrs.path ~default:request_path in 144 144 + make ~domain ~path ~name ~value ~secure:attrs.secure ~http_only:attrs.http_only 145 145 + ?expires:attrs.expires ?same_site:attrs.same_site ~creation_time:now 146 146 + ~last_access:now () 128 147 129 129 - let rec parse_set_cookie ~domain:request_domain ~path:request_path header_value = 148 148 + let rec parse_set_cookie ~clock ~domain:request_domain ~path:request_path 149 149 + header_value = 130 150 Log.debug (fun m -> m "Parsing Set-Cookie: %s" header_value); 131 151 132 152 (* Split into attributes *) ··· 147 167 in 148 168 149 169 let now = 150 150 - Ptime.of_float_s (Unix.time ()) |> Option.value ~default:Ptime.epoch 151 151 - in 152 152 - let base_cookie = 153 153 - make ~domain:request_domain ~path:request_path ~name ~value:cookie_value ~secure:false ~http_only:false 154 154 - ?expires:None ?same_site:None ~creation_time:now ~last_access:now () 170 170 + Ptime.of_float_s (Eio.Time.now clock) 171 171 + |> Option.value ~default:Ptime.epoch 155 172 in 156 173 157 157 - (* Parse attributes *) 158 158 - let cookie = 159 159 - List.fold_left 160 160 - (fun cookie attr -> 161 161 - match String.index_opt attr '=' with 162 162 - | None -> parse_cookie_attribute attr "" cookie 163 163 - | Some eq -> 164 164 - let attr_name = String.sub attr 0 eq |> String.trim in 165 165 - let attr_value = 166 166 - String.sub attr (eq + 1) (String.length attr - eq - 1) 167 167 - |> String.trim 168 168 - in 169 169 - parse_cookie_attribute attr_name attr_value cookie) 170 170 - base_cookie attrs 171 171 - in 174 174 + (* Parse all attributes into mutable accumulator *) 175 175 + let accumulated_attrs = empty_attributes () in 176 176 + List.iter 177 177 + (fun attr -> 178 178 + match String.index_opt attr '=' with 179 179 + | None -> 180 180 + (* Attribute without value (e.g., Secure, HttpOnly) *) 181 181 + parse_attribute clock accumulated_attrs attr "" 182 182 + | Some eq -> 183 183 + let attr_name = String.sub attr 0 eq |> String.trim in 184 184 + let attr_value = 185 185 + String.sub attr (eq + 1) (String.length attr - eq - 1) 186 186 + |> String.trim 187 187 + in 188 188 + parse_attribute clock accumulated_attrs attr_name attr_value) 189 189 + attrs; 172 190 173 173 - Log.debug (fun m -> m "Parsed cookie: %a" pp cookie); 174 174 - Some cookie) 191 191 + (* Validate attributes *) 192 192 + if not (validate_attributes accumulated_attrs) then ( 193 193 + Log.warn (fun m -> m "Cookie validation failed, rejecting cookie"); 194 194 + None) 195 195 + else 196 196 + let cookie = 197 197 + build_cookie ~request_domain ~request_path ~name ~value:cookie_value 198 198 + accumulated_attrs ~now 199 199 + in 200 200 + Log.debug (fun m -> m "Parsed cookie: %a" pp cookie); 201 201 + Some cookie) 175 202 176 203 and make_cookie_header cookies = 177 204 cookies ··· 224 251 jar.cookies <- cookie :: jar.cookies; 225 252 Eio.Mutex.unlock jar.mutex 226 253 227 227 - let get_cookies jar ~domain:request_domain ~path:request_path ~is_secure = 254 254 + let get_cookies jar ~clock ~domain:request_domain ~path:request_path ~is_secure = 228 255 Log.debug (fun m -> 229 229 - m "Getting cookies for domain=%s path=%s secure=%b" request_domain request_path is_secure); 256 256 + m "Getting cookies for domain=%s path=%s secure=%b" request_domain 257 257 + request_path is_secure); 230 258 231 259 Eio.Mutex.lock jar.mutex; 232 260 let applicable = ··· 240 268 241 269 (* Update last access time *) 242 270 let now = 243 243 - Ptime.of_float_s (Unix.time ()) |> Option.value ~default:Ptime.epoch 271 271 + Ptime.of_float_s (Eio.Time.now clock) |> Option.value ~default:Ptime.epoch 244 272 in 245 273 let updated = 246 274 List.map ··· 248 276 if List.memq c applicable then 249 277 make ~domain:(domain c) ~path:(path c) ~name:(name c) ~value:(value c) 250 278 ~secure:(secure c) ~http_only:(http_only c) ?expires:(expires c) 251 251 - ?same_site:(same_site c) ~creation_time:(creation_time c) ~last_access:now () 279 279 + ?same_site:(same_site c) ~creation_time:(creation_time c) 280 280 + ~last_access:now () 252 281 else c) 253 282 jar.cookies 254 283 in ··· 333 362 Eio.Mutex.unlock jar.mutex; 334 363 result 335 364 336 336 - let from_mozilla_format content = 365 365 + let from_mozilla_format ~clock content = 337 366 Log.debug (fun m -> m "Parsing Mozilla format cookies"); 338 367 let jar = create () in 339 368 ··· 345 374 match String.split_on_char '\t' line with 346 375 | [ domain; _include_subdomains; path; secure; expires; name; value ] -> 347 376 let now = 348 348 - Ptime.of_float_s (Unix.time ()) 377 377 + Ptime.of_float_s (Eio.Time.now clock) 349 378 |> Option.value ~default:Ptime.epoch 350 379 in 351 380 let expires = 352 381 let exp_int = try int_of_string expires with _ -> 0 in 353 353 - if exp_int = 0 then None 354 354 - else Ptime.of_float_s (float_of_int exp_int) 382 382 + if exp_int = 0 then None else Ptime.of_float_s (float_of_int exp_int) 355 383 in 356 384 357 385 let cookie = 358 358 - make ~domain ~path ~name ~value 359 359 - ~secure:(secure = "TRUE") ~http_only:false 360 360 - ?expires ?same_site:None 361 361 - ~creation_time:now ~last_access:now () 386 386 + make ~domain ~path ~name ~value ~secure:(secure = "TRUE") 387 387 + ~http_only:false ?expires ?same_site:None ~creation_time:now 388 388 + ~last_access:now () 362 389 in 363 390 add_cookie jar cookie; 364 391 Log.debug (fun m -> m "Loaded cookie: %s=%s" name value) ··· 370 397 371 398 (** {1 File Operations} *) 372 399 373 373 - let load path = 400 400 + let load ~clock path = 374 401 Log.info (fun m -> m "Loading cookies from %a" Eio.Path.pp path); 375 402 376 403 try 377 404 let content = Eio.Path.load path in 378 378 - from_mozilla_format content 405 405 + from_mozilla_format ~clock content 379 406 with 380 407 | Eio.Io _ -> 381 408 Log.info (fun m -> m "Cookie file not found, creating empty jar");

+34 -12

lib/cookeio.mli

··· 101 101 val create : unit -> jar 102 102 (** Create an empty cookie jar *) 103 103 104 104 - val load : Eio.Fs.dir_ty Eio.Path.t -> jar 105 105 - (** Load cookies from Mozilla format file *) 104 104 + val load : clock:_ Eio.Time.clock -> Eio.Fs.dir_ty Eio.Path.t -> jar 105 105 + (** Load cookies from Mozilla format file. 106 106 + 107 107 + Loads cookies from a file in Mozilla format, using the provided clock to set 108 108 + creation and last access times. Returns an empty jar if the file doesn't 109 109 + exist or cannot be loaded. *) 106 110 107 111 val save : Eio.Fs.dir_ty Eio.Path.t -> jar -> unit 108 112 (** Save cookies to Mozilla format file *) ··· 113 117 (** Add a cookie to the jar *) 114 118 115 119 val get_cookies : 116 116 - jar -> domain:string -> path:string -> is_secure:bool -> t list 117 117 - (** Get cookies applicable for a URL *) 120 120 + jar -> 121 121 + clock:_ Eio.Time.clock -> 122 122 + domain:string -> 123 123 + path:string -> 124 124 + is_secure:bool -> 125 125 + t list 126 126 + (** Get cookies applicable for a URL. 127 127 + 128 128 + Returns all cookies that match the given domain and path, and satisfy the 129 129 + secure flag requirement. Also updates the last access time of matching 130 130 + cookies using the provided clock. *) 118 131 119 132 val clear : jar -> unit 120 133 (** Clear all cookies *) ··· 136 149 137 150 (** {1 Cookie Creation and Parsing} *) 138 151 139 139 - val parse_set_cookie : domain:string -> path:string -> string -> t option 152 152 + val parse_set_cookie : 153 153 + clock:_ Eio.Time.clock -> domain:string -> path:string -> string -> t option 140 154 (** Parse Set-Cookie header value into a cookie. 141 155 142 156 Parses a Set-Cookie header value following RFC specifications: 143 157 - Basic format: [NAME=VALUE; attribute1; attribute2=value2] 144 144 - - Supports all standard attributes: [expires], [domain], [path], [secure], 145 145 - [httponly], [samesite] 146 146 - - Returns [None] if parsing fails or cookie is invalid 158 158 + - Supports all standard attributes: [expires], [max-age], [domain], [path], 159 159 + [secure], [httponly], [samesite] 160 160 + - Returns [None] if parsing fails or cookie validation fails 147 161 - The [domain] and [path] parameters provide the request context for default 148 162 values 163 163 + - The [clock] parameter is used for calculating expiry times from [max-age] 164 164 + attributes 165 165 + 166 166 + Cookie validation rules: 167 167 + - [SameSite=None] requires the [Secure] flag to be set 149 168 150 169 Example: 151 151 - [parse_set_cookie ~domain:"example.com" ~path:"/" "session=abc123; Secure; 152 152 - HttpOnly"] *) 170 170 + [parse_set_cookie ~clock ~domain:"example.com" ~path:"/" 171 171 + "session=abc123; Secure; HttpOnly"] *) 153 172 154 173 val make_cookie_header : t list -> string 155 174 (** Create cookie header value from cookies. ··· 177 196 val to_mozilla_format : jar -> string 178 197 (** Write cookies in Mozilla format *) 179 198 180 180 - val from_mozilla_format : string -> jar 181 181 - (** Parse Mozilla format cookies *) 199 199 + val from_mozilla_format : clock:_ Eio.Time.clock -> string -> jar 200 200 + (** Parse Mozilla format cookies. 201 201 + 202 202 + Creates a cookie jar from a string in Mozilla cookie format, using the 203 203 + provided clock to set creation and last access times. *)

+26 -18

test/test_cookeio.ml

··· 21 21 && Option.equal Ptime.equal (Cookeio.expires c1) (Cookeio.expires c2) 22 22 && Option.equal ( = ) (Cookeio.same_site c1) (Cookeio.same_site c2)) 23 23 24 24 - let test_load_mozilla_cookies () = 24 24 + let test_load_mozilla_cookies env = 25 25 + let clock = Eio.Stdenv.clock env in 25 26 let content = 26 27 {|# Netscape HTTP Cookie File 27 28 # http://curl.haxx.se/rfc/cookie_spec.html ··· 36 37 #HttpOnly_.example.com TRUE /foo/ FALSE 1257894000 cookie-7 v$7 37 38 |} 38 39 in 39 39 - let jar = from_mozilla_format content in 40 40 + let jar = from_mozilla_format ~clock content in 40 41 let cookies = get_all_cookies jar in 41 42 42 43 (* Check total number of cookies (should skip commented lines) *) ··· 114 115 115 116 let test_load_from_file env = 116 117 (* This test loads from the actual test/cookies.txt file using the load function *) 118 118 + let clock = Eio.Stdenv.clock env in 117 119 let cwd = Eio.Stdenv.cwd env in 118 120 let cookie_path = Eio.Path.(cwd / "cookies.txt") in 119 119 - let jar = load cookie_path in 121 121 + let jar = load ~clock cookie_path in 120 122 let cookies = get_all_cookies jar in 121 123 122 124 (* Should have the same 5 cookies as the string test *) ··· 145 147 Alcotest.(check (option (Alcotest.testable Ptime.pp Ptime.equal))) 146 148 "file cookie-2 expires" None (Cookeio.expires cookie2) 147 149 148 148 - let test_cookie_matching () = 150 150 + let test_cookie_matching env = 151 151 + let clock = Eio.Stdenv.clock env in 149 152 let jar = create () in 150 153 151 154 (* Add test cookies with different domain patterns *) ··· 171 174 172 175 (* Test exact domain matching *) 173 176 let cookies_http = 174 174 - get_cookies jar ~domain:"example.com" ~path:"/" ~is_secure:false 177 177 + get_cookies jar ~clock ~domain:"example.com" ~path:"/" ~is_secure:false 175 178 in 176 179 Alcotest.(check int) "http cookies count" 2 (List.length cookies_http); 177 180 178 181 let cookies_https = 179 179 - get_cookies jar ~domain:"example.com" ~path:"/" ~is_secure:true 182 182 + get_cookies jar ~clock ~domain:"example.com" ~path:"/" ~is_secure:true 180 183 in 181 184 Alcotest.(check int) "https cookies count" 3 (List.length cookies_https); 182 185 183 186 (* Test subdomain matching *) 184 187 let cookies_sub = 185 185 - get_cookies jar ~domain:"sub.example.com" ~path:"/" ~is_secure:false 188 188 + get_cookies jar ~clock ~domain:"sub.example.com" ~path:"/" ~is_secure:false 186 189 in 187 190 Alcotest.(check int) "subdomain cookies count" 1 (List.length cookies_sub); 188 191 let sub_cookie = List.hd cookies_sub in 189 192 Alcotest.(check string) "subdomain cookie name" "subdomain" (Cookeio.name sub_cookie) 190 193 191 191 - let test_empty_jar () = 194 194 + let test_empty_jar env = 195 195 + let clock = Eio.Stdenv.clock env in 192 196 let jar = create () in 193 197 Alcotest.(check bool) "empty jar" true (is_empty jar); 194 198 Alcotest.(check int) "empty count" 0 (count jar); ··· 196 200 "empty cookies" [] (get_all_cookies jar); 197 201 198 202 let cookies = 199 199 - get_cookies jar ~domain:"example.com" ~path:"/" ~is_secure:false 203 203 + get_cookies jar ~clock ~domain:"example.com" ~path:"/" ~is_secure:false 200 204 in 201 205 Alcotest.(check int) "no matching cookies" 0 (List.length cookies) 202 206 203 203 - let test_round_trip_mozilla_format () = 207 207 + let test_round_trip_mozilla_format env = 208 208 + let clock = Eio.Stdenv.clock env in 204 209 let jar = create () in 205 210 206 211 let test_cookie = ··· 213 218 214 219 (* Convert to Mozilla format and back *) 215 220 let mozilla_format = to_mozilla_format jar in 216 216 - let jar2 = from_mozilla_format mozilla_format in 221 221 + let jar2 = from_mozilla_format ~clock mozilla_format in 217 222 let cookies2 = get_all_cookies jar2 in 218 223 219 224 Alcotest.(check int) "round trip count" 1 (List.length cookies2); ··· 236 241 [ 237 242 ( "mozilla_format", 238 243 [ 239 239 - test_case "Load Mozilla format from string" `Quick 240 240 - test_load_mozilla_cookies; 244 244 + test_case "Load Mozilla format from string" `Quick (fun () -> 245 245 + test_load_mozilla_cookies env); 241 246 test_case "Load Mozilla format from file" `Quick (fun () -> 242 247 test_load_from_file env); 243 243 - test_case "Round trip Mozilla format" `Quick 244 244 - test_round_trip_mozilla_format; 248 248 + test_case "Round trip Mozilla format" `Quick (fun () -> 249 249 + test_round_trip_mozilla_format env); 245 250 ] ); 246 251 ( "cookie_matching", 247 247 - [ test_case "Domain and security matching" `Quick test_cookie_matching ] 252 252 + [ 253 253 + test_case "Domain and security matching" `Quick (fun () -> 254 254 + test_cookie_matching env); 255 255 + ] ); 256 256 + ( "basic_operations", 257 257 + [ test_case "Empty jar operations" `Quick (fun () -> test_empty_jar env) ] 248 258 ); 249 249 - ( "basic_operations", 250 250 - [ test_case "Empty jar operations" `Quick test_empty_jar ] ); 251 259 ]