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 2db109c18bfb1ac4c0c4bc210d2c3127e6916ad0..2122b43767e1f23e61086e9c4aeb1c78a6a3997c 100644 (file)
--- 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 <ecc@cmu.edu>:
+    - 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 <zack@debian.org>  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 bf2cf31ada3faef48ae61a0d6089cecb3fc12180..be2e3062983331e92cdf28640d392b16ea816c4f 100644 (file)
--- 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 b7cf02a86c97f332b1da0b8064512c6200d3adaa..ab082112aca95e554a1a67ac4a9442059fa137a5 100644 (file)
--- 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 caa51af13bf2c41e06485ebc0341f4e2d7dd25a0..60f186cd43c509309c2e3c638b62e5a638f69e4e 100644 (file)
--- 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: '<method> <url> <version>'" ^
-          "<br />\nwhile received request 1st line was:<br />\n" ^ req)
+        ~body:("request 1st line format should be: " ^
+               "'&lt;method&gt; &lt;url&gt; &lt;version&gt;'" ^
+               "<br />\nwhile received request 1st line was:<br />\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;