76 lines
1.9 KiB
OCaml
76 lines
1.9 KiB
OCaml
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)
|