unikernel/duniverse/angstrom/examples/rFC2616.ml

@@ -0,0 +1,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)