anil.recoil.org
An OCaml webserver, but the allocating version (vs httpz which doesnt)
1(* etag.ml - ETag parsing and comparison per RFC 7232 *)
2
3open Base
4
5(* Entity tag - record pointing into buffer *)
6type t =
7 { weak : bool
8 ; off : int
9 ; len : int
10 }
11
12type status =
13 | Valid
14 | Invalid
15
16let empty = { weak = false; off = 0; len = 0 }
17
18(* Maximum number of ETags in If-Match/If-None-Match header *)
19let max_tags = 16
20
21(* Parse a single ETag value.
22 Format: entity-tag = [ weak ] opaque-tag
23 weak = %x57.2F ; "W/", case-sensitive
24 opaque-tag = DQUOTE *etagc DQUOTE
25 etagc = %x21 / %x23-7E / obs-text *)
26let parse buf (sp : Span.t) =
27 let off = Span.off sp in
28 let len = Span.len sp in
29 if len < 2 then (Invalid, empty) (* Minimum: "" *)
30 else
31 let c0 = Base_bigstring.unsafe_get buf off in
32 let c1 = Base_bigstring.unsafe_get buf (off + 1) in
33 (* Check for weak indicator W/ *)
34 let weak, quote_start =
35 if Char.equal c0 'W' && Char.equal c1 '/' && len >= 4 then
36 (true, off + 2)
37 else
38 (false, off)
39 in
40 let remaining = len - (quote_start - off) in
41 if remaining < 2 then (Invalid, empty)
42 else
43 let first = Base_bigstring.unsafe_get buf quote_start in
44 let last = Base_bigstring.unsafe_get buf (quote_start + remaining - 1) in
45 if Char.equal first '"' && Char.equal last '"' then
46 let tag_off = quote_start + 1 in
47 let tag_len = remaining - 2 in
48 (Valid, { weak; off = tag_off; len = tag_len })
49 else
50 (Invalid, empty)
51;;
52
53let to_string buf etag =
54 Base_bigstring.To_string.sub buf ~pos:etag.off ~len:etag.len
55;;
56
57(* If-Match / If-None-Match parsing *)
58type match_condition =
59 | Any
60 | Tags
61 | Empty
62
63(* Skip optional whitespace *)
64let skip_ows buf ~pos ~len =
65 let p = ref pos in
66 while !p < len && (
67 let c = Base_bigstring.unsafe_get buf !p in
68 Char.equal c ' ' || Char.equal c '\t'
69 ) do
70 Int.incr p
71 done;
72 !p
73;;
74
75(* Parse comma-separated list of entity tags into array *)
76let parse_match_header buf (sp : Span.t) (tags : t array) =
77 let off = Span.off sp in
78 let len = Span.len sp in
79 let end_pos = off + len in
80 (* Skip leading whitespace *)
81 let start = skip_ows buf ~pos:off ~len:end_pos in
82 if start >= end_pos then (Empty, 0)
83 else if Char.equal (Base_bigstring.unsafe_get buf start) '*' then
84 (* Check it's just "*" possibly with trailing whitespace *)
85 let after_star = skip_ows buf ~pos:(start + 1) ~len:end_pos in
86 if after_star >= end_pos then (Any, 0) else (Empty, 0)
87 else
88 (* Parse comma-separated list of entity tags *)
89 let pos = ref start in
90 let count = ref 0 in
91 let valid = ref true in
92 while !valid && !pos < end_pos && !count < max_tags do
93 pos := skip_ows buf ~pos:!pos ~len:end_pos;
94 if !pos >= end_pos then
95 valid := false
96 else (
97 (* Find end of this tag (comma or end) *)
98 let tag_start = !pos in
99 let tag_end = ref !pos in
100 let in_quote = ref false in
101 while !tag_end < end_pos && (!in_quote || not (Char.equal (Base_bigstring.unsafe_get buf !tag_end) ',')) do
102 if Char.equal (Base_bigstring.unsafe_get buf !tag_end) '"' then
103 in_quote := not !in_quote;
104 Int.incr tag_end
105 done;
106 (* Trim trailing whitespace from tag *)
107 let trimmed_end = ref !tag_end in
108 while !trimmed_end > tag_start && (
109 let c = Base_bigstring.unsafe_get buf (!trimmed_end - 1) in
110 Char.equal c ' ' || Char.equal c '\t'
111 ) do
112 Int.decr trimmed_end
113 done;
114 let tag_span = Span.make ~off:tag_start ~len:(!trimmed_end - tag_start) in
115 let (status, etag) = parse buf tag_span in
116 (match status with
117 | Valid ->
118 Array.unsafe_set tags !count etag;
119 Int.incr count
120 | Invalid -> ());
121 (* Skip comma if present *)
122 if !tag_end < end_pos && Char.equal (Base_bigstring.unsafe_get buf !tag_end) ',' then
123 pos := !tag_end + 1
124 else
125 pos := !tag_end
126 )
127 done;
128 if !count > 0 then (Tags, !count) else (Empty, 0)
129;;
130
131(* Strong comparison: both must be strong, tags must match exactly *)
132let strong_match buf a b =
133 if a.weak || b.weak then false
134 else
135 let a_len = a.len in
136 let b_len = b.len in
137 if a_len <> b_len then false
138 else Base_bigstring.memcmp buf ~pos1:a.off buf ~pos2:b.off ~len:a_len = 0
139;;
140
141(* Weak comparison: only tags must match, ignore weak indicator *)
142let weak_match buf a b =
143 let a_len = a.len in
144 let b_len = b.len in
145 if a_len <> b_len then false
146 else Base_bigstring.memcmp buf ~pos1:a.off buf ~pos2:b.off ~len:a_len = 0
147;;
148
149let matches_any_weak buf etag tags ~count =
150 let i = ref 0 in
151 let found = ref false in
152 while (not !found) && !i < count do
153 if weak_match buf etag (Array.unsafe_get tags !i) then
154 found := true
155 else
156 Int.incr i
157 done;
158 !found
159;;
160
161let matches_any_strong buf etag tags ~count =
162 let i = ref 0 in
163 let found = ref false in
164 while (not !found) && !i < count do
165 if strong_match buf etag (Array.unsafe_get tags !i) then
166 found := true
167 else
168 Int.incr i
169 done;
170 !found
171;;
172
173(* Response writing *)
174
175let write_etag dst ~off etag src_buf =
176 (* ETag: [W/]"tag"\r\n *)
177 let off = Buf_write.string dst ~off "ETag: " in
178 let off = if etag.weak then Buf_write.string dst ~off "W/" else off in
179 let off = Buf_write.char dst ~off '"' in
180 (* Copy tag value from source buffer *)
181 let tag_off = etag.off in
182 let tag_len = etag.len in
183 for i = 0 to tag_len - 1 do
184 Bigarray.Array1.unsafe_set dst (off + i) (Base_bigstring.unsafe_get src_buf (tag_off + i))
185 done;
186 let off = off + tag_len in
187 let off = Buf_write.char dst ~off '"' in
188 Buf_write.crlf dst ~off
189;;
190
191let write_etag_string dst ~off ~weak tag =
192 let off = Buf_write.string dst ~off "ETag: " in
193 let off = if weak then Buf_write.string dst ~off "W/" else off in
194 let off = Buf_write.char dst ~off '"' in
195 let off = Buf_write.string dst ~off tag in
196 let off = Buf_write.char dst ~off '"' in
197 Buf_write.crlf dst ~off
198;;
199
200let pp buf fmt etag =
201 let tag = to_string buf etag in
202 if etag.weak then
203 Stdlib.Format.fprintf fmt "W/\"%s\"" tag
204 else
205 Stdlib.Format.fprintf fmt "\"%s\"" tag
206;;