- moved exceptions in http_types

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

diff --git a/helm/DEVEL/ocaml-http/http_response.ml b/helm/DEVEL/ocaml-http/http_response.ml
index 3c58f13fa033d244e77992bf2c66243761b9bdf9..5ca7878acf4f8ee4fadf2153e4876316e1873670 100644 (file)
--- a/helm/DEVEL/ocaml-http/http_response.ml
+++ b/helm/DEVEL/ocaml-http/http_response.ml
@@ -19,15 +19,12 @@
   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 *)
 
+open Http_types;;
+open Http_constants;;
 open Http_common;;
 open Http_daemon;;
 open Printf;;
 
-exception Invalid_status_line of string
-exception Header_not_found of string
-
-  (* TODO sanity checks on set* methods' arguments (e.g. dates 822 compliant,
-  code values < 600, ...) *)
 class response =
   let default_code = 200 in
     (* remove all bindings of 'name' from hashtbl 'tbl' *)
@@ -38,7 +35,7 @@ class response =
     if Hashtbl.mem tbl name then hashtbl_remove_all tbl name
   in
     (* "version code reason_phrase" *)
-  let status_line_re = Pcre.regexp "^(HTTP/\d\.\d) (\d{3}) (.*)$" in
+  let status_line_re = Pcre.regexp "^(HTTP/\\d\\.\\d) (\\d{3}) (.*)$" in
   object (self)
     val mutable version = http_version
     val mutable code = default_code
@@ -50,12 +47,14 @@ class response =
     method setVersion v = version <- v
 
     method code = code
-    method setCode c = code <- c
+    method setCode c =
+      ignore (status_of_code c);  (* sanity check on c *)
+      code <- c
     method status = status_of_code code
     method setStatus (s: Http_types.status) = code <- code_of_status s
     method reason =
       match reason with
-      | None -> reason_phrase_of_code code
+      | None -> Http_misc.reason_phrase_of_code code
       | Some r -> r
     method setReason r = reason <- Some r
     method statusLine =
@@ -89,12 +88,18 @@ class response =
     method addContents s = Buffer.add_string contentsBuf s
     method addContentsBuf b = Buffer.add_buffer contentsBuf b
 
-    method addHeader ~name ~value = Hashtbl.add headers name value
+    method addHeader ~name ~value =
+      Http_parser.heal_header (name, value);
+      Hashtbl.add headers name value
+
+    method replaceHeader ~name ~value =
+      Http_parser.heal_header (name, value);
+      Hashtbl.replace headers name value
+
       (* FIXME duplication of code between this and send_basic_headers *)
     method addBasicHeaders =
       self#addHeader ~name:"Date" ~value:(Http_misc.date_822 ());
       self#addHeader ~name:"Server" ~value:server_string
-    method replaceHeader ~name ~value = Hashtbl.replace headers name value
     method removeHeader ~name = hashtbl_remove_all headers name
     method hasHeader ~name = Hashtbl.mem headers name
     method header ~name =
@@ -132,15 +137,6 @@ class response =
     method serialize outchan =
       output_string outchan self#toString;
       flush outchan
-(*
-      (* OLD VERSION *)
-      output_string outchan self#statusLine;
-      send_CRLF outchan;
-      send_headers self#headers outchan;
-      send_CRLF outchan;
-      Buffer.output_buffer outchan contentsBuf;
-      flush outchan
-*)
 
   end