first moogle template checkin

[helm.git] / helm / DEVEL / ocaml-http / http_request.ml

diff --git a/helm/DEVEL/ocaml-http/http_request.ml b/helm/DEVEL/ocaml-http/http_request.ml
index e3bc95bc1f5666d060802723448bd5e178563de6..65cba9710d95a00e29fd5f4cea335c441c3f89d6 100644 (file)
--- a/helm/DEVEL/ocaml-http/http_request.ml
+++ b/helm/DEVEL/ocaml-http/http_request.ml
@@ -38,34 +38,47 @@ class request ic =
   let uri_str = Neturl.string_of_url uri in
   let path = Http_parser.parse_path uri in
   let query_get_params = Http_parser.parse_query_get_params uri in
-  let headers = Http_parser.parse_headers ic in (* trailing \r\n consumed! *)
-  let body =
-    (* TODO fallback on Transfer-Encoding if Content-Length isn't defined *)
-    if meth = `POST then
-      Buffer.contents
-        (try  (* read only Content-Length bytes *)
-          let limit_raw =
-            (try
-              (snd (List.find
-                (fun (h,v) -> String.lowercase h = "content-length") headers))
-            with Not_found -> raise Fallback)
-          in
-          let limit =
-            (try  (* TODO supports only a maximum content-length of 1Gb *)
-              int_of_string limit_raw
-            with Failure "int_of_string" ->
-              raise (Invalid_header ("Content-Length: " ^ limit_raw)))
-          in
-          Http_misc.buf_of_inchan ~limit ic
-        with Fallback -> Http_misc.buf_of_inchan ic)  (* read until EOF *)
-    else "" (* TODO empty body for methods other than POST, is what we want? *)
+  let (headers, body) =
+    (match version with
+    | None -> [], ""  (* No version given, use request's 1st line only *)
+    | Some version -> (* Version specified, parse also headers and body *)
+        let headers =
+          List.map  (* lowercase header names to ease lookups before having a
+                    request object *)
+            (fun (h,v) -> (String.lowercase h, v))
+            (Http_parser.parse_headers ic) (* trailing \r\n consumed! *)
+        in
+        let body =
+            (* TODO fallback on size defined in Transfer-Encoding if
+              Content-Length isn't defined *)
+          if meth = `POST then
+            Buffer.contents
+              (try  (* read only Content-Length bytes *)
+                let limit_raw =
+                  (try
+                    List.assoc "content-length" headers
+                  with Not_found -> raise Fallback)
+                in
+                let limit =
+                  (try  (* TODO supports only a maximum content-length of 1Gb *)
+                    int_of_string limit_raw
+                  with Failure "int_of_string" ->
+                    raise (Invalid_header ("content-length: " ^ limit_raw)))
+                in
+                Http_misc.buf_of_inchan ~limit ic
+              with Fallback -> Http_misc.buf_of_inchan ic)  (* read until EOF *)
+          else  (* TODO empty body for methods other than POST, is ok? *)
+            ""
+        in
+        (headers, body))
   in
-    (* TODO brave assumption: when meth = `POST, Content-Type is
-    application/x-www-form-urlencoded and is therefore one-liner parsed as a GET
-    query *)
   let query_post_params =
     match meth with
-    | `POST -> Http_parser.split_query_params body
+    | `POST ->
+        let ct = try List.assoc "content-type" headers with Not_found -> "" in
+        if ct = "application/x-www-form-urlencoded" then
+          Http_parser.split_query_params body
+        else []
     | _ -> []
   in
   let params = query_post_params @ query_get_params in (* prefers POST params *)
@@ -105,46 +118,11 @@ class request ic =
     method params_POST = query_post_params
 
     method private fstLineToString =
-      sprintf "%s %s %s"
-        (string_of_method self#meth) self#uri (string_of_version self#version)
+      let method_string = string_of_method self#meth in
+      match self#version with
+      | Some version ->
+          sprintf "%s %s %s" method_string self#uri (string_of_version version)
+      | None -> sprintf "%s %s" method_string self#uri
 
   end
 
-(*    (* OLD IMPLEMENTATION *)
-class request
-  ~body ~headers ~version ~meth ~uri
-  ~clisockaddr ~srvsockaddr
-  ~path ~params
-  ()
-  =
-  object (self)
-
-    inherit
-      Http_message.message ~body ~headers ~version ~clisockaddr ~srvsockaddr
-
-    val params_tbl =
-      let tbl = Hashtbl.create (List.length params) in
-      List.iter (fun (n,v) -> Hashtbl.add tbl n v) params;
-      tbl
-
-    method meth = meth
-    method uri = uri
-    method path = path
-    method param name =
-      try
-        Hashtbl.find params_tbl name
-      with Not_found ->
-        raise (Param_not_found name)
-    method paramAll name = List.rev (Hashtbl.find_all params_tbl name)
-    method params = params
-
-    method private fstLineToString =
-      sprintf
-        "%s %s %s"
-        (string_of_method self#meth)
-        self#uri
-        (string_of_version self#version)
-
-  end
-*)
-