X-Git-Url: http://matita.cs.unibo.it/gitweb/?p=helm.git;a=blobdiff_plain;f=helm%2FDEVEL%2Focaml-http%2Fhttp_message.ml;fp=helm%2FDEVEL%2Focaml-http%2Fhttp_message.ml;h=0000000000000000000000000000000000000000;hp=ad3f38b50addf63e0ec62f8833fbb22c049f7b19;hb=3ef089a4c58fbe429dd539af6215991ecbe11ee2;hpb=1c7fb836e2af4f2f3d18afd0396701f2094265ff diff --git a/helm/DEVEL/ocaml-http/http_message.ml b/helm/DEVEL/ocaml-http/http_message.ml deleted file mode 100644 index ad3f38b50..000000000 --- a/helm/DEVEL/ocaml-http/http_message.ml +++ /dev/null @@ -1,118 +0,0 @@ - -(* - 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;; - - (* 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 -;; - -class virtual message ~body ~headers ~version ~clisockaddr ~srvsockaddr = - - 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 option = version - - initializer - self#setBody body; - self#addHeaders headers - - method version = _version - method setVersion v = _version <- Some 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 = - let name = String.lowercase name in - 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 = - let name = String.lowercase name in - 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 = - let name = String.lowercase name in - hashtbl_remove_all _headers name - method hasHeader ~name = - let name = String.lowercase name in - Hashtbl.mem _headers name - method header ~name = - if not (self#hasHeader name) then raise (Header_not_found name); - let name = String.lowercase name in - 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 -