From 53c6ab80c6f7e9da28dc30f6ed11b9af5561737a Mon Sep 17 00:00:00 2001 From: Stefano Zacchiroli Date: Wed, 25 Dec 2002 15:19:02 +0000 Subject: [PATCH] - added inheritance from message class --- helm/DEVEL/ocaml-http/http_response.ml | 88 +++++++------------------ helm/DEVEL/ocaml-http/http_response.mli | 7 +- 2 files changed, 27 insertions(+), 68 deletions(-) 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 diff --git a/helm/DEVEL/ocaml-http/http_response.mli b/helm/DEVEL/ocaml-http/http_response.mli index 08c5d9db5..78ef0fa42 100644 --- a/helm/DEVEL/ocaml-http/http_response.mli +++ b/helm/DEVEL/ocaml-http/http_response.mli @@ -19,9 +19,12 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) +open Http_types;; + class response: - ?body:string -> ?headers:(string * string) list -> - ?version:Http_types.version -> ?code:int -> ?status:Http_types.status -> + ?body:string -> ?headers:(string * string) list -> ?version: version -> + ?clisockaddr: Unix.sockaddr -> ?srvsockaddr: Unix.sockaddr -> + ?code:int -> ?status:Http_types.status -> unit -> Http_types.response -- 2.39.2