[http-svr] parse the content-type of the request and store that information in the...

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

diff --git a/http-svr/http.ml b/http-svr/http.ml
index f8e2456c6ee9342da311b62317d6aee25ab4a394..38592f9bb21da9a23ae36eaffad8eea2c8db4476 100644 (file)
--- a/http-svr/http.ml
+++ b/http-svr/http.ml
@@ -76,6 +76,8 @@ let task_id_hdr = "Task-id"
 
 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 @@ type request = { m: method_t;
                 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 @@ let nullreq = { m=Unknown "";
                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 request_of_string x =
       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 @@ let pretty_string_of_request x =
     (kvpairs x.cookie)
     (default "" x.task)
     (default "" x.subtask_of)
+    (default "" x.content_type)
     (default "" x.user_agent)
 
 let escape uri =

diff --git a/http-svr/http.mli b/http-svr/http.mli
index d6f96a030e281c15edc78461bb52341621c1f5cf..ff8d800be83a24f4e1e36c421330d112dd61a1de 100644 (file)
--- a/http-svr/http.mli
+++ b/http-svr/http.mli
@@ -25,19 +25,22 @@ type authorization =
     | 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 @@ val subtask_of_hdr : string
 (** 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 --git a/http-svr/http_svr.ml b/http-svr/http_svr.ml
index 5a7f6c880d7e9b9eac8bca2a685efd564ee176e1..4d187fce4e56d8cc9c6a353f065d7a4c956ea029 100644 (file)
--- a/http-svr/http_svr.ml
+++ b/http-svr/http_svr.ml
@@ -170,6 +170,7 @@ let handle_connection _ ss =
     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 handle_connection _ ss =
        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 @@ let handle_connection _ ss =
        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 @@ let handle_connection _ ss =
                    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