From: Stefano Zacchiroli Date: Wed, 25 Dec 2002 14:56:10 +0000 (+0000) Subject: - common parent class for request and response X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=commitdiff_plain;h=1a44a0e4e82fb0b6340787a3ea42f37afc04db2a;p=helm.git - common parent class for request and response --- diff --git a/helm/DEVEL/ocaml-http/http_message.ml b/helm/DEVEL/ocaml-http/http_message.ml new file mode 100644 index 000000000..24621e05d --- /dev/null +++ b/helm/DEVEL/ocaml-http/http_message.ml @@ -0,0 +1,112 @@ + +(* + OCaml HTTP - do it yourself (fully OCaml) HTTP daemon + + Copyright (C) <2002> Stefano Zacchiroli + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +*) + +open Http_common;; +open Http_constants;; +open Http_types;; +open Printf;; + +class virtual message ~body ~headers ~version ~clisockaddr ~srvsockaddr = + + (* 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 ((cliaddr, cliport), (srvaddr, srvport)) = + (Http_misc.explode_sockaddr clisockaddr, + Http_misc.explode_sockaddr srvsockaddr) + in + + object (self) + + val _contentsBuf = Buffer.create 1024 + val _headers = Hashtbl.create 11 + val mutable _version: version = version + + initializer + self#setBody body; + self#addHeaders headers + + method version = _version + method setVersion v = _version <- v + + method body = Buffer.contents _contentsBuf + method setBody c = + Buffer.clear _contentsBuf; + Buffer.add_string _contentsBuf c + method bodyBuf = _contentsBuf + method setBodyBuf b = + Buffer.clear _contentsBuf; + Buffer.add_buffer _contentsBuf b + method addBody s = Buffer.add_string _contentsBuf s + method addBodyBuf b = Buffer.add_buffer _contentsBuf b + + method addHeader ~name ~value = + Http_parser_sanity.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_sanity.heal_header (name, value); + Hashtbl.replace _headers name value + method replaceHeaders = + List.iter (fun (name, value) -> self#replaceHeader ~name ~value) + 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 clientSockaddr = clisockaddr + method clientAddr = cliaddr + method clientPort = cliport + + method serverSockaddr = srvsockaddr + method serverAddr = srvaddr + method serverPort = srvport + + method private virtual fstLineToString: string + method toString = + self#fstLineToString ^ (* {request,status} line *) + crlf ^ + (String.concat (* headers, crlf terminated *) + "" + (List.map (fun (h,v) -> h ^ ": " ^ v ^ crlf) self#headers)) ^ + (sprintf "Content-Length: %d" (String.length self#body)) ^ crlf ^ + crlf ^ + self#body (* body *) + method serialize outchan = + output_string outchan self#toString; + flush outchan + + end + diff --git a/helm/DEVEL/ocaml-http/http_message.mli b/helm/DEVEL/ocaml-http/http_message.mli new file mode 100644 index 000000000..e3f06f03f --- /dev/null +++ b/helm/DEVEL/ocaml-http/http_message.mli @@ -0,0 +1,64 @@ + +(* + OCaml HTTP - do it yourself (fully OCaml) HTTP daemon + + Copyright (C) <2002> Stefano Zacchiroli + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +*) + +open Http_types;; + + (** OO representation of an HTTP message + @param entity body included in the message + @param headers message headers shipped with the message *) +class virtual message: + body: string -> headers: (string * string) list -> version: version -> + clisockaddr: Unix.sockaddr -> srvsockaddr: Unix.sockaddr -> + object + + method version: version + method setVersion: version -> unit + + method body: string + method setBody: string -> unit + method bodyBuf: Buffer.t + method setBodyBuf: Buffer.t -> unit + method addBody: string -> unit + method addBodyBuf: Buffer.t -> unit + + method addHeader: name:string -> value:string -> unit + method addHeaders: (string * string) list -> unit + method replaceHeader: name:string -> value:string -> unit + method replaceHeaders: (string * string) list -> unit + method removeHeader: name:string -> unit + method hasHeader: name:string -> bool + method header: name:string -> string + method headers: (string * string) list + + method clientSockaddr: Unix.sockaddr + method clientAddr: string + method clientPort: int + + method serverSockaddr: Unix.sockaddr + method serverAddr: string + method serverPort: int + + method private virtual fstLineToString: string + method toString: string + method serialize: out_channel -> unit + + end +