Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*)
+open Http_types;;
+open Http_constants;;
open Http_common;;
open Http_daemon;;
open Printf;;
-exception Invalid_status_line of string
-exception Header_not_found of string
-
- (* TODO sanity checks on set* methods' arguments (e.g. dates 822 compliant,
- code values < 600, ...) *)
class response =
let default_code = 200 in
(* remove all bindings of 'name' from hashtbl 'tbl' *)
if Hashtbl.mem tbl name then hashtbl_remove_all tbl name
in
(* "version code reason_phrase" *)
- let status_line_re = Pcre.regexp "^(HTTP/\d\.\d) (\d{3}) (.*)$" in
+ let status_line_re = Pcre.regexp "^(HTTP/\\d\\.\\d) (\\d{3}) (.*)$" in
object (self)
val mutable version = http_version
val mutable code = default_code
method setVersion v = version <- v
method code = code
- method setCode c = code <- c
+ method setCode c =
+ ignore (status_of_code c); (* sanity check on c *)
+ code <- c
method status = status_of_code code
method setStatus (s: Http_types.status) = code <- code_of_status s
method reason =
match reason with
- | None -> reason_phrase_of_code code
+ | None -> Http_misc.reason_phrase_of_code code
| Some r -> r
method setReason r = reason <- Some r
method statusLine =
method addContents s = Buffer.add_string contentsBuf s
method addContentsBuf b = Buffer.add_buffer contentsBuf b
- method addHeader ~name ~value = Hashtbl.add headers name value
+ method addHeader ~name ~value =
+ Http_parser.heal_header (name, value);
+ Hashtbl.add headers name value
+
+ method replaceHeader ~name ~value =
+ Http_parser.heal_header (name, value);
+ Hashtbl.replace headers 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 replaceHeader ~name ~value = Hashtbl.replace headers name value
method removeHeader ~name = hashtbl_remove_all headers name
method hasHeader ~name = Hashtbl.mem headers name
method header ~name =
method serialize outchan =
output_string outchan self#toString;
flush outchan
-(*
- (* OLD VERSION *)
- output_string outchan self#statusLine;
- send_CRLF outchan;
- send_headers self#headers outchan;
- send_CRLF outchan;
- Buffer.output_buffer outchan contentsBuf;
- flush outchan
-*)
end