added support for "ancient" HTTP requests like "GET /foo"

[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 cf86018507077929d755693c1500d4c7294b128f..65cba9710d95a00e29fd5f4cea335c441c3f89d6 100644 (file)
--- a/helm/DEVEL/ocaml-http/http_request.ml
+++ b/helm/DEVEL/ocaml-http/http_request.ml
@@ -38,31 +38,39 @@ 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 =
-    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 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 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
   let query_post_params =
     match meth with
@@ -110,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)
-
-  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)
+      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
-*)