(*
OCaml HTTP - do it yourself (fully OCaml) HTTP daemon
- Copyright (C) <2002> Stefano Zacchiroli <zack@cs.unibo.it>
+ Copyright (C) <2002-2005> Stefano Zacchiroli <zack@cs.unibo.it>
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.
+ it under the terms of the GNU Library General Public License as
+ published by the Free Software Foundation, version 2.
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.
+ GNU Library 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
+ You should have received a copy of the GNU Library 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_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,
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 =
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