X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2FDEVEL%2Focaml-http%2Fhttp_response.ml;h=913c227551acd60a960cb42a5c60ee428ec8ff3b;hb=ca9cd0aeee0ce78a891f7f6091ca8704231a446d;hp=a0bda358250158ca56ceaec0eadf0d3e1b965b67;hpb=b5703de4f7697426ebda94fce2558add7c4f0285;p=helm.git

diff --git a/helm/DEVEL/ocaml-http/http_response.ml b/helm/DEVEL/ocaml-http/http_response.ml
index a0bda3582..913c22755 100644
--- a/helm/DEVEL/ocaml-http/http_response.ml
+++ b/helm/DEVEL/ocaml-http/http_response.ml
@@ -27,36 +27,34 @@ open Printf;;
 
 let status_line_RE = Pcre.regexp "^(HTTP/\\d\\.\\d) (\\d{3}) (.*)$"
 
+let anyize = function
+  | Some addr -> addr
+  | None -> Unix.ADDR_INET (Unix.inet_addr_any, -1)
+
 class response
   (* Warning: keep default values in sync with Http_daemon.respond function *)
-  ?(body = "") ?(headers = [])
-  ?(version = http_version) ?(code = 200) ?status ()
+  ?(body = "") ?(headers = []) ?(version = http_version)
+  ?clisockaddr ?srvsockaddr (* optional because response have to be easily
+                            buildable in callback functions *)
+  ?(code = 200) ?status
+  ()
   =
-    (* remove all bindings of 'name' from hashtbl 'tbl' *)
-  let rec hashtbl_remove_all tbl name =
-    if not (Hashtbl.mem tbl name) then
-      raise (Header_not_found name);
-    Hashtbl.remove tbl name;
-    if Hashtbl.mem tbl name then hashtbl_remove_all tbl name
-  in
+
+    (** if no address were supplied for client and/or server, use a foo address
+    instead *)
+  let (clisockaddr, srvsockaddr) = (anyize clisockaddr, anyize srvsockaddr) in
+
     (* "version code reason_phrase" *)
   object (self)
 
-    val mutable _version = version
+    inherit
+      Http_message.message ~body ~headers ~version ~clisockaddr ~srvsockaddr
+
     val mutable _code =
       match status with
       | None -> code
       | Some (s: Http_types.status) -> code_of_status s
     val mutable _reason: string option = None
-    val _contentsBuf = Buffer.create 1024
-    val _headers = Hashtbl.create 11
-
-    initializer
-      self#setContents body;
-      self#addHeaders headers
-
-    method version = _version
-    method setVersion v = _version <- v
 
     method code = _code
     method setCode c =
@@ -89,45 +87,10 @@ class response
     method isServerError = is_server_error _code
     method isError = is_error _code
 
-    method contents = Buffer.contents _contentsBuf
-    method setContents c =
-      Buffer.clear _contentsBuf;
-      Buffer.add_string _contentsBuf c
-    method contentsBuf = _contentsBuf
-    method setContentsBuf b =
-      Buffer.clear _contentsBuf;
-      Buffer.add_buffer _contentsBuf b
-    method addContents s = Buffer.add_string _contentsBuf s
-    method addContentsBuf b = Buffer.add_buffer _contentsBuf b
-
-    method addHeader ~name ~value =
-      Http_parser.heal_header (name, value);
-      Hashtbl.add _headers name value
-    method addHeaders =
-      List.iter (fun (name, value) -> self#addHeader ~name ~value)
-
-    method replaceHeader ~name ~value =
-      Http_parser.heal_header (name, value);
-      Hashtbl.replace _headers name value
-    method replaceHeaders =
-      List.iter (fun (name, value) -> self#replaceHeader ~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 removeHeader ~name = hashtbl_remove_all _headers name
-    method hasHeader ~name = Hashtbl.mem _headers name
-    method header ~name =
-      if not (self#hasHeader name) then
-        raise (Header_not_found name);
-      String.concat ", " (List.rev (Hashtbl.find_all _headers name))
-    method headers =
-      List.rev
-        (Hashtbl.fold
-          (fun name _ headers -> (name, self#header ~name)::headers)
-          _headers
-          [])
 
     method contentType = self#header "Content-Type"
     method setContentType t = self#replaceHeader "Content-Type" t
@@ -140,19 +103,12 @@ class response
     method server = self#header "Server"
     method setServer s = self#replaceHeader "Server" s
 
-    method toString =
+    method private fstLineToString =
       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
+        "%s %d %s"
+        (string_of_version self#version)
+        self#code
+        self#reason
 
   end