X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2FDEVEL%2Focaml-http%2Fhttp_message.ml;h=ad3f38b50addf63e0ec62f8833fbb22c049f7b19;hb=5325734bc2e4927ed7ec146e35a6f0f2b49f50c1;hp=24621e05ded56b21584bdaa52d4b3f7990fdbaed;hpb=ca9cd0aeee0ce78a891f7f6091ca8704231a446d;p=helm.git diff --git a/helm/DEVEL/ocaml-http/http_message.ml b/helm/DEVEL/ocaml-http/http_message.ml index 24621e05d..ad3f38b50 100644 --- a/helm/DEVEL/ocaml-http/http_message.ml +++ b/helm/DEVEL/ocaml-http/http_message.ml @@ -24,15 +24,15 @@ 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 +;; - (* 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 +class virtual message ~body ~headers ~version ~clisockaddr ~srvsockaddr = let ((cliaddr, cliport), (srvaddr, srvport)) = (Http_misc.explode_sockaddr clisockaddr, @@ -43,14 +43,14 @@ class virtual message ~body ~headers ~version ~clisockaddr ~srvsockaddr = val _contentsBuf = Buffer.create 1024 val _headers = Hashtbl.create 11 - val mutable _version: version = version + val mutable _version: version option = version initializer self#setBody body; self#addHeaders headers method version = _version - method setVersion v = _version <- v + method setVersion v = _version <- Some v method body = Buffer.contents _contentsBuf method setBody c = @@ -64,20 +64,26 @@ class virtual message ~body ~headers ~version ~clisockaddr ~srvsockaddr = 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 = hashtbl_remove_all _headers name - method hasHeader ~name = Hashtbl.mem _headers name + 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); + 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