-
Notifications
You must be signed in to change notification settings - Fork 74
/
rFC2616.ml
76 lines (60 loc) · 1.86 KB
/
rFC2616.ml
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
open Angstrom
module P = struct
let is_space =
function | ' ' | '\t' -> true | _ -> false
let is_eol =
function | '\r' | '\n' -> true | _ -> false
let is_hex =
function | '0' .. '9' | 'a' .. 'f' | 'A' .. 'F' -> true | _ -> false
let is_digit =
function '0' .. '9' -> true | _ -> false
let is_separator =
function
| ')' | '(' | '<' | '>' | '@' | ',' | ';' | ':' | '\\' | '"'
| '/' | '[' | ']' | '?' | '=' | '{' | '}' | ' ' | '\t' -> true
| _ -> false
let is_token =
(* The commented-out ' ' and '\t' are not necessary because of the range at
* the top of the match. *)
function
| '\000' .. '\031' | '\127'
| ')' | '(' | '<' | '>' | '@' | ',' | ';' | ':' | '\\' | '"'
| '/' | '[' | ']' | '?' | '=' | '{' | '}' (* | ' ' | '\t' *) -> false
| _ -> true
end
let token = take_while1 P.is_token
let digits = take_while1 P.is_digit
let spaces = skip_while P.is_space
let lex p = p <* spaces
let version =
string "HTTP/" *>
lift2 (fun major minor -> major, minor)
(digits <* char '.')
digits
let uri =
take_till P.is_space
let meth = token
let eol = string "\r\n"
let request_first_line =
lift3 (fun meth uri version -> (meth, uri, version))
(lex meth)
(lex uri)
version
let response_first_line =
lift3 (fun version status msg -> (version, status, msg))
(lex version)
(lex (take_till P.is_space))
(take_till P.is_eol)
let header =
let colon = char ':' <* spaces in
lift2 (fun key value -> (key, value))
token
(colon *> take_till P.is_eol)
let request =
lift2 (fun (meth, uri, version) headers -> (meth, uri, version, headers))
(request_first_line <* eol)
(many (header <* eol) <* eol)
let response =
lift2 (fun (version, status, msg) headers -> (version, status, msg, headers))
(response_first_line <* eol)
(many (header <* eol) <* eol)