Commits

Anonymous committed 149ccad

urilex: + content_type (for http header Content-Type)

Comments (0)

Files changed (1)

 {
 open Uri_type;;
+
+let failwith fmt = Printf.ksprintf failwith fmt
 }
 
 (* common part from rfc2616 *)
 
 let IP_literal    = "[" ( IPv6address | IPvFuture  ) "]"
 
+
+(* not an uri, but http *)
+
+let g_space = ['\x20' '\x09']
+
+let g_ctl = ['\x00' - '\x1F' '\x7F']
+
+let g_separator =
+  [ '(' ')' '<' '>' '@'
+    ',' ';' ':' '\\' '<' '>'
+    '/' '[' ']' '?' '='
+    '{' '}' '\x20' '\x09'
+  ]
+
+let token = (_ # g_ctl # g_separator)+
+
+let g_text = (_ # g_ctl)
+
+let g_char = ['\x00' - '\x7F']
+
+
 rule uri = parse
   (scheme as scheme) ":"
     {
 
 
 *)
+
+
+(* not an uri, but http *)
+
+and content_type = parse
+  g_space+
+    { content_type lexbuf }
+| (token as mtype) '/' (token as msubtype) g_space*
+    { try
+        let pars = parameters [] lexbuf in
+        `Ok (mtype, msubtype, pars)
+      with
+      | Failure msg -> `Error msg
+      | e -> `Error (Printexc.to_string e)
+    }
+
+| ((_ *) as txt)
+    { `Error (Printf.sprintf "bad Content-Type: %S" txt) }
+
+and parameters acc = parse
+  eof 
+    { List.rev acc }
+| ""
+    { let p = parameter lexbuf in
+      parameters (p :: acc) lexbuf
+    }
+
+and parameter = parse
+  ';' g_space* (token as par_name) '='
+    { let v = parameter_value lexbuf in
+      (par_name, v)
+    }
+
+| ((_ *) as txt)
+    { failwith "expected parameter, found %S" txt }
+
+and parameter_value = parse
+  (token as t) g_space*
+    { t }
+| '"'
+    { inside_quoted_string (Buffer.create 40) lexbuf }
+| ((_ *) as txt)
+    { failwith "expected parameter's value, found %S" txt }
+
+and inside_quoted_string buf = parse
+  '"' g_space*
+    { Buffer.contents buf }
+| '\\'
+    { let c = escaped_char lexbuf in
+      let () = Buffer.add_char buf c in
+      inside_quoted_string buf lexbuf
+    }
+| ((g_text # [^ '"' '\\'])+ as txt)
+    { let () = Buffer.add_string buf txt in
+      inside_quoted_string buf lexbuf
+    }
+| ((_ *) as txt)
+    { failwith "expected HTTP's TEXT, found %S" txt }
+
+and escaped_char = parse
+  g_char as c
+    { c }
+| (_ as c)
+    { failwith "expected \\x00..\\x7F after backslash, found %C" c }
+
+
+
+
+
+
+
+
+
+
+
+
+