···
(** {1 Cookie Parsing} *)
74
-
let parse_cookie_attribute attr attr_value cookie =
75
-
let attr_lower = String.lowercase_ascii attr in
74
+
(** Accumulated attributes from parsing Set-Cookie header *)
75
+
type cookie_attributes = {
76
+
mutable domain : string option;
77
+
mutable path : string option;
78
+
mutable secure : bool;
79
+
mutable http_only : bool;
80
+
mutable expires : Ptime.t option;
81
+
mutable same_site : same_site option;
84
+
(** Create empty attribute accumulator *)
85
+
let empty_attributes () =
95
+
(** Parse a single attribute and update the accumulator in-place *)
96
+
let parse_attribute clock attrs attr_name attr_value =
97
+
let attr_lower = String.lowercase_ascii attr_name in
77
-
| "domain" -> make ~domain:attr_value ~path:(path cookie) ~name:(name cookie)
78
-
~value:(value cookie) ~secure:(secure cookie) ~http_only:(http_only cookie)
79
-
?expires:(expires cookie) ?same_site:(same_site cookie)
80
-
~creation_time:(creation_time cookie) ~last_access:(last_access cookie) ()
81
-
| "path" -> make ~domain:(domain cookie) ~path:attr_value ~name:(name cookie)
82
-
~value:(value cookie) ~secure:(secure cookie) ~http_only:(http_only cookie)
83
-
?expires:(expires cookie) ?same_site:(same_site cookie)
84
-
~creation_time:(creation_time cookie) ~last_access:(last_access cookie) ()
99
+
| "domain" -> attrs.domain <- Some attr_value
100
+
| "path" -> attrs.path <- Some attr_value
87
-
let time, _tz_offset, _tz_string =
88
-
Ptime.of_rfc3339 attr_value |> Result.get_ok
90
-
make ~domain:(domain cookie) ~path:(path cookie) ~name:(name cookie)
91
-
~value:(value cookie) ~secure:(secure cookie) ~http_only:(http_only cookie)
92
-
~expires:time ?same_site:(same_site cookie)
93
-
~creation_time:(creation_time cookie) ~last_access:(last_access cookie) ()
95
-
Log.debug (fun m -> m "Failed to parse expires: %s" attr_value);
102
+
match Ptime.of_rfc3339 attr_value with
103
+
| Ok (time, _, _) -> attrs.expires <- Some time
104
+
| Error (`RFC3339 (_, err)) ->
106
+
m "Failed to parse expires attribute '%s': %a" attr_value
107
+
Ptime.pp_rfc3339_error err))
99
-
let seconds = int_of_string attr_value in
100
-
let now = Unix.time () in
101
-
let expires = Ptime.of_float_s (now +. float_of_int seconds) in
102
-
make ~domain:(domain cookie) ~path:(path cookie) ~name:(name cookie)
103
-
~value:(value cookie) ~secure:(secure cookie) ~http_only:(http_only cookie)
104
-
?expires ?same_site:(same_site cookie)
105
-
~creation_time:(creation_time cookie) ~last_access:(last_access cookie) ()
107
-
| "secure" -> make ~domain:(domain cookie) ~path:(path cookie) ~name:(name cookie)
108
-
~value:(value cookie) ~secure:true ~http_only:(http_only cookie)
109
-
?expires:(expires cookie) ?same_site:(same_site cookie)
110
-
~creation_time:(creation_time cookie) ~last_access:(last_access cookie) ()
111
-
| "httponly" -> make ~domain:(domain cookie) ~path:(path cookie) ~name:(name cookie)
112
-
~value:(value cookie) ~secure:(secure cookie) ~http_only:true
113
-
?expires:(expires cookie) ?same_site:(same_site cookie)
114
-
~creation_time:(creation_time cookie) ~last_access:(last_access cookie) ()
116
-
let same_site_val =
117
-
match String.lowercase_ascii attr_value with
118
-
| "strict" -> Some `Strict
119
-
| "lax" -> Some `Lax
120
-
| "none" -> Some `None
123
-
make ~domain:(domain cookie) ~path:(path cookie) ~name:(name cookie)
124
-
~value:(value cookie) ~secure:(secure cookie) ~http_only:(http_only cookie)
125
-
?expires:(expires cookie) ?same_site:same_site_val
126
-
~creation_time:(creation_time cookie) ~last_access:(last_access cookie) ()
109
+
match int_of_string_opt attr_value with
111
+
let now = Eio.Time.now clock in
112
+
let expires = Ptime.of_float_s (now +. float_of_int seconds) in
113
+
attrs.expires <- expires
115
+
Log.warn (fun m -> m "Failed to parse max-age attribute '%s'" attr_value))
116
+
| "secure" -> attrs.secure <- true
117
+
| "httponly" -> attrs.http_only <- true
119
+
match String.lowercase_ascii attr_value with
120
+
| "strict" -> attrs.same_site <- Some `Strict
121
+
| "lax" -> attrs.same_site <- Some `Lax
122
+
| "none" -> attrs.same_site <- Some `None
124
+
Log.warn (fun m -> m "Invalid samesite value '%s', ignoring" attr_value))
126
+
Log.debug (fun m -> m "Unknown cookie attribute '%s', ignoring" attr_name)
128
+
(** Validate cookie attributes and log warnings for invalid combinations *)
129
+
let validate_attributes attrs =
130
+
(* SameSite=None requires Secure flag *)
131
+
match attrs.same_site with
132
+
| Some `None when not attrs.secure ->
135
+
"Cookie has SameSite=None but Secure flag is not set; this violates \
136
+
RFC requirements");
140
+
(** Build final cookie from name/value and accumulated attributes *)
141
+
let build_cookie ~request_domain ~request_path ~name ~value attrs ~now =
142
+
let domain = Option.value attrs.domain ~default:request_domain in
143
+
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 ()
129
-
let rec parse_set_cookie ~domain:request_domain ~path:request_path header_value =
148
+
let rec parse_set_cookie ~clock ~domain:request_domain ~path:request_path
Log.debug (fun m -> m "Parsing Set-Cookie: %s" header_value);
(* Split into attributes *)
···
150
-
Ptime.of_float_s (Unix.time ()) |> Option.value ~default:Ptime.epoch
153
-
make ~domain:request_domain ~path:request_path ~name ~value:cookie_value ~secure:false ~http_only:false
154
-
?expires:None ?same_site:None ~creation_time:now ~last_access:now ()
170
+
Ptime.of_float_s (Eio.Time.now clock)
171
+
|> Option.value ~default:Ptime.epoch
157
-
(* Parse attributes *)
160
-
(fun cookie attr ->
161
-
match String.index_opt attr '=' with
162
-
| None -> parse_cookie_attribute attr "" cookie
164
-
let attr_name = String.sub attr 0 eq |> String.trim in
166
-
String.sub attr (eq + 1) (String.length attr - eq - 1)
169
-
parse_cookie_attribute attr_name attr_value cookie)
174
+
(* Parse all attributes into mutable accumulator *)
175
+
let accumulated_attrs = empty_attributes () in
178
+
match String.index_opt attr '=' with
180
+
(* Attribute without value (e.g., Secure, HttpOnly) *)
181
+
parse_attribute clock accumulated_attrs attr ""
183
+
let attr_name = String.sub attr 0 eq |> String.trim in
185
+
String.sub attr (eq + 1) (String.length attr - eq - 1)
188
+
parse_attribute clock accumulated_attrs attr_name attr_value)
173
-
Log.debug (fun m -> m "Parsed cookie: %a" pp cookie);
191
+
(* Validate attributes *)
192
+
if not (validate_attributes accumulated_attrs) then (
193
+
Log.warn (fun m -> m "Cookie validation failed, rejecting cookie");
197
+
build_cookie ~request_domain ~request_path ~name ~value:cookie_value
198
+
accumulated_attrs ~now
200
+
Log.debug (fun m -> m "Parsed cookie: %a" pp cookie);
and make_cookie_header cookies =
···
jar.cookies <- cookie :: jar.cookies;
Eio.Mutex.unlock jar.mutex
227
-
let get_cookies jar ~domain:request_domain ~path:request_path ~is_secure =
254
+
let get_cookies jar ~clock ~domain:request_domain ~path:request_path ~is_secure =
229
-
m "Getting cookies for domain=%s path=%s secure=%b" request_domain request_path is_secure);
256
+
m "Getting cookies for domain=%s path=%s secure=%b" request_domain
257
+
request_path is_secure);
Eio.Mutex.lock jar.mutex;
···
(* Update last access time *)
243
-
Ptime.of_float_s (Unix.time ()) |> Option.value ~default:Ptime.epoch
271
+
Ptime.of_float_s (Eio.Time.now clock) |> Option.value ~default:Ptime.epoch
···
if List.memq c applicable then
make ~domain:(domain c) ~path:(path c) ~name:(name c) ~value:(value c)
~secure:(secure c) ~http_only:(http_only c) ?expires:(expires c)
251
-
?same_site:(same_site c) ~creation_time:(creation_time c) ~last_access:now ()
279
+
?same_site:(same_site c) ~creation_time:(creation_time c)
280
+
~last_access:now ()
···
Eio.Mutex.unlock jar.mutex;
336
-
let from_mozilla_format content =
365
+
let from_mozilla_format ~clock content =
Log.debug (fun m -> m "Parsing Mozilla format cookies");
···
match String.split_on_char '\t' line with
| [ domain; _include_subdomains; path; secure; expires; name; value ] ->
348
-
Ptime.of_float_s (Unix.time ())
377
+
Ptime.of_float_s (Eio.Time.now clock)
|> Option.value ~default:Ptime.epoch
let exp_int = try int_of_string expires with _ -> 0 in
353
-
if exp_int = 0 then None
354
-
else Ptime.of_float_s (float_of_int exp_int)
382
+
if exp_int = 0 then None else Ptime.of_float_s (float_of_int exp_int)
358
-
make ~domain ~path ~name ~value
359
-
~secure:(secure = "TRUE") ~http_only:false
360
-
?expires ?same_site:None
361
-
~creation_time:now ~last_access:now ()
386
+
make ~domain ~path ~name ~value ~secure:(secure = "TRUE")
387
+
~http_only:false ?expires ?same_site:None ~creation_time:now
388
+
~last_access:now ()
Log.debug (fun m -> m "Loaded cookie: %s=%s" name value)
···
(** {1 File Operations} *)
400
+
let load ~clock path =
Log.info (fun m -> m "Loading cookies from %a" Eio.Path.pp path);
let content = Eio.Path.load path in
378
-
from_mozilla_format content
405
+
from_mozilla_format ~clock content
Log.info (fun m -> m "Cookie file not found, creating empty jar");
anil.recoil.org