# HG changeset patch
# User Thomas Gazagnaire <thomas.gazagnaire@xxxxxxxxxx>
[http-svr] parse the content-type of the request and store that information in the request structure

Signed-off-by: Thomas Gazagnaire <thomas.gazagnaire@xxxxxxxxxx>

diff -r e1c6ccfb5f5d http-svr/http.ml
--- a/http-svr/http.ml	Tue Jan 05 19:42:29 2010 +0000
+++ b/http-svr/http.ml	Wed Jan 06 10:25:28 2010 +0000
@@ -76,6 +76,8 @@
 
 let subtask_of_hdr = "Subtask-of"
 
+let content_type_hdr = "Content-Type"
+
 let user_agent_hdr = "User-Agent"
 
 let myprint fmt = debug fmt
@@ -114,7 +116,8 @@
 		 auth: authorization option;
 		 cookie: (string * string) list;
 		 task: string option;
-     subtask_of: string option;
+		 subtask_of: string option;
+		 content_type: string option;
 		 user_agent: string option;
 		 close: bool ref;
 		 headers: string list;}
@@ -128,7 +131,8 @@
 		auth=None;
 		cookie=[];
 		task=None;
-    subtask_of=None;
+		subtask_of=None;
+		content_type = None;
 		user_agent = None;
 		close= ref true;
 		headers=[];}
@@ -214,12 +218,12 @@
       let uri, query = parse_uri uri in
       { m = method_t_of_string m; uri = uri; query = query; 
 	content_length = None; transfer_encoding = None;
-	version = version; cookie = []; auth = None; task = None; subtask_of = None; user_agent = None; close=ref false; headers=[] } 
+	version = version; cookie = []; auth = None; task = None; subtask_of = None; content_type = None; user_agent = None; close=ref false; headers=[] } 
   | _ -> raise Http_parse_failure
 
 let pretty_string_of_request x =
   let kvpairs x = String.concat "; " (List.map (fun (k, v) -> k ^ "=" ^ v) x) in
-  Printf.sprintf "{ method = %s; uri = %s; query = [ %s ]; content_length = [ %s ]; transfer encoding = %s; version = %s; cookie = [ %s ]; task = %s; subtask_of = [ %s]; user_agent = %s }" 
+  Printf.sprintf "{ method = %s; uri = %s; query = [ %s ]; content_length = [ %s ]; transfer encoding = %s; version = %s; cookie = [ %s ]; task = %s; subtask_of = %s; content-type = %s; user_agent = %s }" 
     (string_of_method_t x.m) x.uri 
     (kvpairs x.query)
     (default "" (may Int64.to_string x.content_length))
@@ -228,6 +232,7 @@
     (kvpairs x.cookie)
     (default "" x.task)
     (default "" x.subtask_of)
+    (default "" x.content_type)
     (default "" x.user_agent)
 
 let escape uri =
diff -r e1c6ccfb5f5d http-svr/http.mli
--- a/http-svr/http.mli	Tue Jan 05 19:42:29 2010 +0000
+++ b/http-svr/http.mli	Wed Jan 06 10:25:28 2010 +0000
@@ -25,19 +25,22 @@
     | UnknownAuth of string
 
 (** Parsed form of the HTTP request line plus cookie info *)
-type request = { m: method_t; 
-		 uri: string; 
-		 query: (string*string) list; 
-		 version: string; 
-		 transfer_encoding: string option;
-		 content_length: int64 option;
-		 auth: authorization option;
-		 cookie: (string * string) list;
-		 task: string option;
-     subtask_of: string option;
-		 user_agent: string option;
-		 close: bool ref;
-                 headers: string list;}
+type request = {
+	m: method_t; 
+	uri: string; 
+	query: (string*string) list; 
+	version: string; 
+	transfer_encoding: string option;
+	content_length: int64 option;
+	auth: authorization option;
+	cookie: (string * string) list;
+	task: string option;
+	subtask_of: string option;
+	content_type: string option;
+	user_agent: string option;
+	close: bool ref;
+    headers: string list;
+}
  
 val nullreq : request
 val authorization_of_string : string -> authorization
@@ -64,6 +67,8 @@
 (** Header used for User-Agent string *)
 val user_agent_hdr : string
 
+val content_type_hdr : string
+
 val output_http : Unix.file_descr -> string list -> unit
 
 val strip_cr : string -> string
diff -r e1c6ccfb5f5d http-svr/http_svr.ml
--- a/http-svr/http_svr.ml	Tue Jan 05 19:42:29 2010 +0000
+++ b/http-svr/http_svr.ml	Wed Jan 06 10:25:28 2010 +0000
@@ -170,6 +170,7 @@
     let auth = ref None in
     let task = ref None in
     let subtask_of = ref None in
+	let content_type = ref None in
     let user_agent = ref None in
     
     content_length := -1L;
@@ -199,6 +200,7 @@
 	let auth_hdr = "authorization: " in
 	let task_hdr = String.lowercase Http.task_id_hdr ^ ": " in
 	let subtask_of_hdr = String.lowercase Http.subtask_of_hdr ^ ": " in
+	let content_type_hdr = String.lowercase Http.content_type_hdr ^ ": " in
 	let user_agent_hdr = String.lowercase Http.user_agent_hdr ^ ": " in
 	let r = Buf_io.input_line ~timeout:Buf_io.infinite_timeout ic in
 	let r = strip_cr r in
@@ -218,6 +220,8 @@
 	then task := Some (end_of_string r (String.length task_hdr));
 	if String.startswith subtask_of_hdr lowercase_r
 	then subtask_of := Some (end_of_string r (String.length subtask_of_hdr));
+	if String.startswith content_type_hdr lowercase_r
+	then content_type := Some (end_of_string r (String.length content_type_hdr));
 	if String.startswith user_agent_hdr lowercase_r
 	then user_agent := Some (end_of_string r (String.length user_agent_hdr));
 	if String.startswith connection_hdr lowercase_r 
@@ -243,15 +247,17 @@
 		    auth = !auth;
 		    task = !task;
 		    subtask_of = !subtask_of;
+			content_type = !content_type;
 		    user_agent = !user_agent;
 		    headers = headers;
 		} in
       let ty = Http.string_of_method_t req.m in
-      D.debug "HTTP %s %s %s%s%s%s"
+      D.debug "HTTP %s %s %s%s%s%s%s"
 	ty req.uri 
 	(Opt.default " " (Opt.map (fun x -> Printf.sprintf " (Content-length: %Ld)" x) req.content_length))
 	(Opt.default " " (Opt.map (fun x -> Printf.sprintf " (Task: %s)" x) req.task))
 	(Opt.default " " (Opt.map (fun x -> Printf.sprintf " (Subtask-of: %s)" x) req.subtask_of))
+	(Opt.default " " (Opt.map (fun x -> Printf.sprintf " (Content-Type: %s)" x) req.content_type))
 	(Opt.default " " (Opt.map (fun x -> Printf.sprintf " (User-agent: %s)" x) req.user_agent));
       let table = handler_table req.m in
       (* Find a specific handler: the last one whose URI is a prefix of the received