From: Stefano Zacchiroli Date: Tue, 16 Aug 2005 08:56:08 +0000 (+0000) Subject: integrated Eric's patch for HTTP/1.1 persistant connections X-Git-Tag: V_0_1_1_1~2 X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=commitdiff_plain;h=a25dc2ceb44a9f0acf6e2d7fc9e18ab316fe3b15;p=helm.git integrated Eric's patch for HTTP/1.1 persistant connections --- diff --git a/helm/DEVEL/ocaml-http/debian/changelog b/helm/DEVEL/ocaml-http/debian/changelog index 2db109c18..2122b4376 100644 --- a/helm/DEVEL/ocaml-http/debian/changelog +++ b/helm/DEVEL/ocaml-http/debian/changelog @@ -2,6 +2,11 @@ ocaml-http (0.1.1+dev) UNRELEASED; urgency=low * added ?default parameter to "param" method * fixed bug in response status line parsing + * integrated patch for HTTP/1.1 persistent connections from + Eric Cooped : + - added support for persistent connections to http_daemon.ml: server + now loops until End_of_file (or any exception) occurs when trying + to parse the next request -- Stefano Zacchiroli Wed, 16 Mar 2005 09:24:07 +0100 diff --git a/helm/DEVEL/ocaml-http/examples/damned_recursion.ml b/helm/DEVEL/ocaml-http/examples/damned_recursion.ml index bf2cf31ad..be2e30629 100644 --- a/helm/DEVEL/ocaml-http/examples/damned_recursion.ml +++ b/helm/DEVEL/ocaml-http/examples/damned_recursion.ml @@ -22,21 +22,28 @@ open Printf open Http_types +let port = 9999 + let callback (req: Http_types.request) outchan = let i = int_of_string (req#param "x") in - match i with - | 0 -> output_string outchan "1" - | x when x > 0 -> - let data = - Http_user_agent.get (sprintf "http://127.0.0.1/foo?x=%d" (x - 1)) - in - output_string outchan (sprintf "%s %d" data x) - | _ -> assert false + let body = + match i with + | 0 -> "0" + | x when x > 0 -> + let data = + Http_user_agent.get (sprintf "http://127.0.0.1:%d/foo?x=%d" + port (x - 1)) + in + sprintf "%s %d" data x + | _ -> assert false + in + Http_daemon.respond ~code:(`Code 200) ~body outchan; + close_out outchan (* Http_user_agent relies on EOF, not Content-Length *) let spec = { Http_daemon.default_spec with callback = callback; - port = 9999; + port = port; mode = `Thread; } diff --git a/helm/DEVEL/ocaml-http/examples/dump_args.ml b/helm/DEVEL/ocaml-http/examples/dump_args.ml index b7cf02a86..ab082112a 100644 --- a/helm/DEVEL/ocaml-http/examples/dump_args.ml +++ b/helm/DEVEL/ocaml-http/examples/dump_args.ml @@ -23,8 +23,6 @@ open Printf open Http_types let callback req outchan = - Http_daemon.send_basic_headers ~code:(`Code 200) outchan; - Http_daemon.send_CRLF outchan; let str = (sprintf "request path = %s\n" req#path) ^ (sprintf "request GET params = %s\n" @@ -36,9 +34,9 @@ let callback req outchan = (sprintf "request ALL params = %s\n" (String.concat ";" (List.map (fun (h,v) -> String.concat "=" [h;v]) req#params))) ^ - (sprintf "request BODY = '%s'\n" req#body) + (sprintf "request BODY = '%s'\n\n" req#body) in - output_string outchan str + Http_daemon.respond ~code:(`Code 200) ~body: str outchan let spec = { Http_daemon.default_spec with diff --git a/helm/DEVEL/ocaml-http/http_daemon.ml b/helm/DEVEL/ocaml-http/http_daemon.ml index caa51af13..60f186cd4 100644 --- a/helm/DEVEL/ocaml-http/http_daemon.ml +++ b/helm/DEVEL/ocaml-http/http_daemon.ml @@ -105,8 +105,7 @@ let send_empty_response (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 @@ -233,19 +232,15 @@ let pp_parse_exc e = 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: ' '" ^ - "
\nwhile received request 1st line was:
\n" ^ req) + ~body:("request 1st line format should be: " ^ + "'<method> <url> <version>'" ^ + "
\nwhile received request 1st line was:
\n" ^ req) outchan; raise Again | (Invalid_HTTP_method meth) as e -> @@ -276,10 +271,6 @@ let rec wrap_parse_request_w_safety parse_function inchan outchan = ~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 @@ -370,17 +361,31 @@ let main spec = 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 @@ -424,7 +429,7 @@ class connection inchan outchan sockaddr = self#assertNotClosed; try Some (safe_parse_request' inchan outchan) - with Again -> None + with _ -> None method respond_with res = self#assertNotClosed;