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=5ca7878acf4f8ee4fadf2153e4876316e1873670;hpb=50b702f7ab48c12829a3b7328bcd47491c3c5262;p=helm.git

diff --git a/helm/DEVEL/ocaml-http/http_response.ml b/helm/DEVEL/ocaml-http/http_response.ml
index 5ca7878ac..913c22755 100644
--- a/helm/DEVEL/ocaml-http/http_response.ml
+++ b/helm/DEVEL/ocaml-http/http_response.ml
@@ -25,93 +25,72 @@ open Http_common;;
 open Http_daemon;;
 open Printf;;
 
-class response =
-  let default_code = 200 in
-    (* 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
+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)
+  ?clisockaddr ?srvsockaddr (* optional because response have to be easily
+                            buildable in callback functions *)
+  ?(code = 200) ?status
+  ()
+  =
+
+    (** 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" *)
-  let status_line_re = Pcre.regexp "^(HTTP/\\d\\.\\d) (\\d{3}) (.*)$" in
   object (self)
-    val mutable version = http_version
-    val mutable code = default_code
-    val mutable reason: string option = None
-    val contentsBuf = Buffer.create 1024
-    val headers = Hashtbl.create 11
 
-    method version = version
-    method setVersion v = version <- v
+    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
 
-    method code = code
+    method code = _code
     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
+      _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 -> Http_misc.reason_phrase_of_code code
+      match _reason with
+      | None -> Http_misc.reason_phrase_of_code _code
       | Some r -> r
-    method setReason r = reason <- Some r
+    method setReason r = _reason <- Some r
     method statusLine =
       String.concat
         " "
         [string_of_version self#version; string_of_int self#code; self#reason]
     method setStatusLine s =
       try
-        let subs = Pcre.extract ~rex:status_line_re s in
+        let subs = Pcre.extract ~rex:status_line_RE s in
         self#setVersion (version_of_string subs.(1));
         self#setCode (int_of_string subs.(2));
         self#setReason subs.(3)
       with Not_found ->
         raise (Invalid_status_line s)
 
-    method isInformational = is_informational code
-    method isSuccess = is_success code
-    method isRedirection = is_redirection code
-    method isClientError = is_client_error code
-    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 replaceHeader ~name ~value =
-      Http_parser.heal_header (name, value);
-      Hashtbl.replace headers name value
+    method isInformational = is_informational _code
+    method isSuccess = is_success _code
+    method isRedirection = is_redirection _code
+    method isClientError = is_client_error _code
+    method isServerError = is_server_error _code
+    method isError = is_error _code
 
       (* 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
@@ -124,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