An OCaml webserver, but the allocating version (vs httpz which doesnt)
1(* header_name.ml - HTTP header names *)
2
3type t =
4 | Cache_control
5 | Connection
6 | Date
7 | Transfer_encoding
8 | Upgrade
9 | Via
10 | Accept
11 | Accept_charset
12 | Accept_encoding
13 | Accept_language
14 | Accept_ranges
15 | Authorization
16 | Cookie
17 | Expect
18 | Host
19 | If_match
20 | If_modified_since
21 | If_none_match
22 | If_range
23 | If_unmodified_since
24 | Range
25 | Referer
26 | User_agent
27 | Age
28 | Etag
29 | Location
30 | Retry_after
31 | Server
32 | Set_cookie
33 | Www_authenticate
34 | Allow
35 | Content_disposition
36 | Content_encoding
37 | Content_language
38 | Content_length
39 | Content_location
40 | Content_range
41 | Content_type
42 | Expires
43 | Last_modified
44 | X_forwarded_for
45 | X_forwarded_proto
46 | X_forwarded_host
47 | X_request_id
48 | X_correlation_id
49 | Other
50
51(* Canonical header name string for known headers, "(unknown)" for Other *)
52let canonical = function
53 | Cache_control -> "Cache-Control"
54 | Connection -> "Connection"
55 | Date -> "Date"
56 | Transfer_encoding -> "Transfer-Encoding"
57 | Upgrade -> "Upgrade"
58 | Via -> "Via"
59 | Accept -> "Accept"
60 | Accept_charset -> "Accept-Charset"
61 | Accept_encoding -> "Accept-Encoding"
62 | Accept_language -> "Accept-Language"
63 | Accept_ranges -> "Accept-Ranges"
64 | Authorization -> "Authorization"
65 | Cookie -> "Cookie"
66 | Expect -> "Expect"
67 | Host -> "Host"
68 | If_match -> "If-Match"
69 | If_modified_since -> "If-Modified-Since"
70 | If_none_match -> "If-None-Match"
71 | If_range -> "If-Range"
72 | If_unmodified_since -> "If-Unmodified-Since"
73 | Range -> "Range"
74 | Referer -> "Referer"
75 | User_agent -> "User-Agent"
76 | Age -> "Age"
77 | Etag -> "ETag"
78 | Location -> "Location"
79 | Retry_after -> "Retry-After"
80 | Server -> "Server"
81 | Set_cookie -> "Set-Cookie"
82 | Www_authenticate -> "WWW-Authenticate"
83 | Allow -> "Allow"
84 | Content_disposition -> "Content-Disposition"
85 | Content_encoding -> "Content-Encoding"
86 | Content_language -> "Content-Language"
87 | Content_length -> "Content-Length"
88 | Content_location -> "Content-Location"
89 | Content_range -> "Content-Range"
90 | Content_type -> "Content-Type"
91 | Expires -> "Expires"
92 | Last_modified -> "Last-Modified"
93 | X_forwarded_for -> "X-Forwarded-For"
94 | X_forwarded_proto -> "X-Forwarded-Proto"
95 | X_forwarded_host -> "X-Forwarded-Host"
96 | X_request_id -> "X-Req-Id"
97 | X_correlation_id -> "X-Correlation-Id"
98 | Other -> "(unknown)"
99;;
100
101let to_string _buf t = canonical t
102
103let lowercase = function
104 | Cache_control -> "cache-control"
105 | Connection -> "connection"
106 | Date -> "date"
107 | Transfer_encoding -> "transfer-encoding"
108 | Upgrade -> "upgrade"
109 | Via -> "via"
110 | Accept -> "accept"
111 | Accept_charset -> "accept-charset"
112 | Accept_encoding -> "accept-encoding"
113 | Accept_language -> "accept-language"
114 | Accept_ranges -> "accept-ranges"
115 | Authorization -> "authorization"
116 | Cookie -> "cookie"
117 | Expect -> "expect"
118 | Host -> "host"
119 | If_match -> "if-match"
120 | If_modified_since -> "if-modified-since"
121 | If_none_match -> "if-none-match"
122 | If_range -> "if-range"
123 | If_unmodified_since -> "if-unmodified-since"
124 | Range -> "range"
125 | Referer -> "referer"
126 | User_agent -> "user-agent"
127 | Age -> "age"
128 | Etag -> "etag"
129 | Location -> "location"
130 | Retry_after -> "retry-after"
131 | Server -> "server"
132 | Set_cookie -> "set-cookie"
133 | Www_authenticate -> "www-authenticate"
134 | Allow -> "allow"
135 | Content_disposition -> "content-disposition"
136 | Content_encoding -> "content-encoding"
137 | Content_language -> "content-language"
138 | Content_length -> "content-length"
139 | Content_location -> "content-location"
140 | Content_range -> "content-range"
141 | Content_type -> "content-type"
142 | Expires -> "expires"
143 | Last_modified -> "last-modified"
144 | X_forwarded_for -> "x-forwarded-for"
145 | X_forwarded_proto -> "x-forwarded-proto"
146 | X_forwarded_host -> "x-forwarded-host"
147 | X_request_id -> "x-request-id"
148 | X_correlation_id -> "x-correlation-id"
149 | Other -> ""
150;;
151
152(* Parse header name from span. TODO: replace with a DFA *)
153let of_span buf (sp : Span.t) : t =
154 match Span.len sp with
155 | 3 ->
156 if Span.equal_caseless buf sp "age"
157 then Age
158 else if Span.equal_caseless buf sp "via"
159 then Via
160 else Other
161 | 4 ->
162 if Span.equal_caseless buf sp "date"
163 then Date
164 else if Span.equal_caseless buf sp "etag"
165 then Etag
166 else if Span.equal_caseless buf sp "host"
167 then Host
168 else Other
169 | 5 ->
170 if Span.equal_caseless buf sp "allow"
171 then Allow
172 else if Span.equal_caseless buf sp "range"
173 then Range
174 else Other
175 | 6 ->
176 if Span.equal_caseless buf sp "accept"
177 then Accept
178 else if Span.equal_caseless buf sp "cookie"
179 then Cookie
180 else if Span.equal_caseless buf sp "expect"
181 then Expect
182 else if Span.equal_caseless buf sp "server"
183 then Server
184 else Other
185 | 7 ->
186 if Span.equal_caseless buf sp "expires"
187 then Expires
188 else if Span.equal_caseless buf sp "referer"
189 then Referer
190 else if Span.equal_caseless buf sp "upgrade"
191 then Upgrade
192 else Other
193 | 8 ->
194 if Span.equal_caseless buf sp "if-match"
195 then If_match
196 else if Span.equal_caseless buf sp "if-range"
197 then If_range
198 else if Span.equal_caseless buf sp "location"
199 then Location
200 else Other
201 | 10 ->
202 if Span.equal_caseless buf sp "connection"
203 then Connection
204 else if Span.equal_caseless buf sp "set-cookie"
205 then Set_cookie
206 else if Span.equal_caseless buf sp "user-agent"
207 then User_agent
208 else Other
209 | 11 -> if Span.equal_caseless buf sp "retry-after" then Retry_after else Other
210 | 12 ->
211 if Span.equal_caseless buf sp "content-type"
212 then Content_type
213 else if Span.equal_caseless buf sp "x-request-id"
214 then X_request_id
215 else Other
216 | 13 ->
217 if Span.equal_caseless buf sp "accept-ranges"
218 then Accept_ranges
219 else if Span.equal_caseless buf sp "authorization"
220 then Authorization
221 else if Span.equal_caseless buf sp "cache-control"
222 then Cache_control
223 else if Span.equal_caseless buf sp "content-range"
224 then Content_range
225 else if Span.equal_caseless buf sp "if-none-match"
226 then If_none_match
227 else if Span.equal_caseless buf sp "last-modified"
228 then Last_modified
229 else Other
230 | 14 ->
231 if Span.equal_caseless buf sp "accept-charset"
232 then Accept_charset
233 else if Span.equal_caseless buf sp "content-length"
234 then Content_length
235 else Other
236 | 15 ->
237 if Span.equal_caseless buf sp "accept-encoding"
238 then Accept_encoding
239 else if Span.equal_caseless buf sp "accept-language"
240 then Accept_language
241 else if Span.equal_caseless buf sp "x-forwarded-for"
242 then X_forwarded_for
243 else if Span.equal_caseless buf sp "x-correlation-id"
244 then X_correlation_id
245 else Other
246 | 16 ->
247 if Span.equal_caseless buf sp "content-encoding"
248 then Content_encoding
249 else if Span.equal_caseless buf sp "content-language"
250 then Content_language
251 else if Span.equal_caseless buf sp "content-location"
252 then Content_location
253 else if Span.equal_caseless buf sp "www-authenticate"
254 then Www_authenticate
255 else if Span.equal_caseless buf sp "x-forwarded-host"
256 then X_forwarded_host
257 else Other
258 | 17 ->
259 if Span.equal_caseless buf sp "if-modified-since"
260 then If_modified_since
261 else if Span.equal_caseless buf sp "transfer-encoding"
262 then Transfer_encoding
263 else if Span.equal_caseless buf sp "x-forwarded-proto"
264 then X_forwarded_proto
265 else Other
266 | 19 ->
267 if Span.equal_caseless buf sp "content-disposition"
268 then Content_disposition
269 else if Span.equal_caseless buf sp "if-unmodified-since"
270 then If_unmodified_since
271 else Other
272 | _ -> Other
273;;
274
275let pp fmt t =
276 let name = to_string (Base_bigstring.create 0) t in
277 Stdlib.Format.fprintf fmt "%s" name
278;;