- changed constructor: request object can now be build directly (and

  only) from an in_channel
- added inheritance from message class
- added methods to access GET/POST params
- added methods to access client/server TCP addresses

diff --git a/helm/DEVEL/ocaml-http/http_request.ml b/helm/DEVEL/ocaml-http/http_request.ml
index c135c95b31059294582dd98161fcfde6e5525f31..e3bc95bc1f5666d060802723448bd5e178563de6 100644 (file)
--- a/helm/DEVEL/ocaml-http/http_request.ml
+++ b/helm/DEVEL/ocaml-http/http_request.ml
@@ -19,19 +19,115 @@
   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 *)
 
+open Printf;;
+
 open Http_common;;
 open Http_types;;
 
-class request ~path ~params ~clisockaddr =
-  let (addr, port) = Http_misc.explode_sockaddr clisockaddr in
+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 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 = 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? *)
+  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
+    | _ -> []
+  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
+
+  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_str
+    method path = path
+    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 =
+      sprintf "%s %s %s"
+        (string_of_method self#meth) self#uri (string_of_version self#version)
+
+  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
-    val uri =
-      path ^ "?" ^
-      (String.concat "&" (List.map (fun (n, v) -> n ^ "=" ^ v) params))
+
+    method meth = meth
     method uri = uri
     method path = path
     method param name =
@@ -41,8 +137,14 @@ class request ~path ~params ~clisockaddr =
         raise (Param_not_found name)
     method paramAll name = List.rev (Hashtbl.find_all params_tbl name)
     method params = params
-    method clientSockaddr = clisockaddr
-    method clientAddr = addr
-    method clientPort = port
+
+    method private fstLineToString =
+      sprintf
+        "%s %s %s"
+        (string_of_method self#meth)
+        self#uri
+        (string_of_version self#version)
+
   end
+*)
 

diff --git a/helm/DEVEL/ocaml-http/http_request.mli b/helm/DEVEL/ocaml-http/http_request.mli
index 8cc2234444c8ab2c5c6025a2bbc5244918a3c62c..ee3494fee6e26c49a0395f7421fd22f185f277ae 100644 (file)
--- a/helm/DEVEL/ocaml-http/http_request.mli
+++ b/helm/DEVEL/ocaml-http/http_request.mli
@@ -19,12 +19,9 @@
   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 *)
 
+open Http_types;;
+
   (** OO representation of an HTTP request
-  @param path path requested by client
-  @param params list of <name, value> bindings enclosed in request
-  @param clisockaddr client's Unix.sockaddr *)
-class request:
-  path: string -> params: (string * string) list ->
-  clisockaddr: Unix.sockaddr ->
-    Http_types.request
+  @param inchan input channel from which parse an HTTP request *)
+class request: in_channel -> Http_types.request