- added support for multithreaded daemons

[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 dd145b84094ccd364a70b34f56b57846f86004d2..3c58f13fa033d244e77992bf2c66243761b9bdf9 100644 (file)
--- a/helm/DEVEL/ocaml-http/http_response.ml
+++ b/helm/DEVEL/ocaml-http/http_response.ml
@@ -21,6 +21,7 @@
 
 open Http_common;;
 open Http_daemon;;
+open Printf;;
 
 exception Invalid_status_line of string
 exception Header_not_found of string
@@ -39,7 +40,7 @@ class response =
     (* "version code reason_phrase" *)
   let status_line_re = Pcre.regexp "^(HTTP/\d\.\d) (\d{3}) (.*)$" in
   object (self)
-    val mutable version = Http_common.http_version
+    val mutable version = http_version
     val mutable code = default_code
     val mutable reason: string option = None
     val contentsBuf = Buffer.create 1024
@@ -64,7 +65,7 @@ class response =
     method setStatusLine s =
       try
         let subs = Pcre.extract ~rex:status_line_re s in
-        self#setVersion (Http_common.version_of_string subs.(1));
+        self#setVersion (version_of_string subs.(1));
         self#setCode (int_of_string subs.(2));
         self#setReason subs.(3)
       with Not_found ->
@@ -92,7 +93,7 @@ class response =
       (* 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:(Http_common.server_string)
+      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
@@ -118,13 +119,28 @@ class response =
     method server = self#header "Server"
     method setServer s = self#replaceHeader "Server" s
 
+    method toString =
+      sprintf
+        "%s%s%s%s%s"
+        self#statusLine (* status line *)
+        crlf
+        (String.concat  (* headers, crlf terminated *)
+          ""
+          (List.map (fun (h,v) -> h ^ ": " ^ v ^ crlf) self#headers))
+        crlf
+        (Buffer.contents contentsBuf) (* body *)
     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