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 c2d9728955a6a70adc7edb4f0b4d078ef4f6bc8f..65cba9710d95a00e29fd5f4cea335c441c3f89d6 100644 (file)
--- a/helm/DEVEL/ocaml-http/http_request.ml
+++ b/helm/DEVEL/ocaml-http/http_request.ml
@@ -19,27 +19,110 @@
   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 *)
 
+open Printf;;
+
 open Http_common;;
+open Http_types;;
+
+let debug_dump_request path params =
+  debug_print ("request path = " ^ path);
+  debug_print (
+    sprintf"request params = %s"
+      (String.concat ";"
+        (List.map (fun (h,v) -> String.concat "=" [h;v]) params)))
 
-exception Param_not_found of string
+exception Fallback;;  (* used internally by request class *)
+
+class request ic =
+  let (meth, uri, version) = Http_parser.parse_request_fst_line ic in
+  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, 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
+  let query_post_params =
+    match meth with
+    | `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 *)
+  let _ = debug_dump_request path params in
+  let (clisockaddr, srvsockaddr) =
+    (Http_misc.peername_of_in_channel ic, Http_misc.sockname_of_in_channel ic)
+  in
 
-class request ~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
-    val uri =
-      path ^ "?" ^
-      (String.concat "&" (List.map (fun (n, v) -> n ^ "=" ^ v) params))
-    method uri = uri
+
+    method meth = meth
+    method uri = uri_str
     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 param ?meth name =
+      (match (meth: meth option) with
+      | None ->
+          (try
+            Hashtbl.find params_tbl name
+          with Not_found -> raise (Param_not_found name))
+      | Some `GET -> List.assoc name query_get_params
+      | Some `POST -> List.assoc name query_post_params)
+    method paramAll ?meth name =
+      (match (meth: meth option) with
+      | None -> List.rev (Hashtbl.find_all params_tbl name)
+      | Some `GET -> Http_misc.list_assoc_all name query_get_params
+      | Some `POST -> Http_misc.list_assoc_all name query_post_params)
     method params = params
+    method params_GET = query_get_params
+    method params_POST = query_post_params
+
+    method private fstLineToString =
+      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