(int_of_code code) func_name)
else begin (* status code suitable for answering *)
let headers =
- [ "Connection", "close";
- "Content-Type", "text/html; charset=iso-8859-1" ] @ headers
+ [ "Content-Type", "text/html; charset=iso-8859-1" ] @ headers
in
let body = (foo_body (int_of_code code) body) ^ body in
respond ?version ~code ~headers ~body outchan
will support http keep alive signaling that a new request has to be parsed
from client) *)
let rec wrap_parse_request_w_safety parse_function inchan outchan =
-(* try *)
(try
parse_function inchan
with
- | (End_of_file) as e ->
- debug_print (pp_parse_exc e);
- respond_error ~code:(`Code 400) ~body:"Unexpected End Of File" outchan;
- raise Again
| (Malformed_request req) as e ->
debug_print (pp_parse_exc e);
respond_error ~code:(`Code 400)
- ~body:("request 1st line format should be: '<method> <url> <version>'" ^
- "<br />\nwhile received request 1st line was:<br />\n" ^ req)
+ ~body:("request 1st line format should be: " ^
+ "'<method> <url> <version>'" ^
+ "<br />\nwhile received request 1st line was:<br />\n" ^ req)
outchan;
raise Again
| (Invalid_HTTP_method meth) as e ->
~body:(sprintf "Malformed query part '%s' in query '%s'" binding query)
outchan;
raise Again)
-(* (* preliminary support for HTTP keep alive connections ... *)
- with Again ->
- wrap_parse_request_w_safety parse_function inchan outchan
-*)
(* wrapper around Http_parser.parse_request which catch parsing exceptions and
return error messages to client as needed
chdir_to_document_root spec.root_dir;
let sockaddr = Http_misc.build_sockaddr (spec.address, spec.port) in
let daemon_callback inchan outchan =
- try
- let req = safe_parse_request' inchan outchan in
- handle_auth req spec outchan;
- flush outchan
+ let next_req () =
+ try Some (safe_parse_request' inchan outchan)
+ with _ -> None
+ in
+ let rec loop n =
+ match next_req () with
+ | Some req ->
+ debug_print (sprintf "request #%d" n);
+ handle_auth req spec outchan;
+ flush outchan;
+ loop (n + 1)
+ | None ->
+ debug_print "server exiting";
+ ()
+ in
+ debug_print "server starting";
+ try loop 1
with exn ->
+ debug_print (sprintf "uncaught exception: %s" (Printexc.to_string exn));
(match spec.exn_handler with
| Some f ->
- debug_print "uncaught exception: executing handler";
+ debug_print "executing handler";
f exn outchan
| None ->
- debug_print "uncaught exception but no handler given: re-raising";
+ debug_print "no handler given: re-raising";
raise exn)
in
try
self#assertNotClosed;
try
Some (safe_parse_request' inchan outchan)
- with Again -> None
+ with _ -> None
method respond_with res =
self#assertNotClosed;