bug fix: reset timeout after processing request in Tcp_server.simple

diff --git a/helm/DEVEL/ocaml-http/examples/dont_fork.ml b/helm/DEVEL/ocaml-http/examples/dont_fork.ml
index 8d8eb45ccdec087789e8017d5b74f4875fc96031..a64e661d045528177a8c69d6136ca8bc66697164 100644 (file)
--- a/helm/DEVEL/ocaml-http/examples/dont_fork.ml
+++ b/helm/DEVEL/ocaml-http/examples/dont_fork.ml
@@ -20,9 +20,6 @@
 *)
 
 let callback req outchan =
-  output_string outchan "FOO\n";
-  flush outchan;
-  Unix.sleep 5;
   Http_daemon.respond_error ~body:"AH AH AH :-P" outchan
 in
-Http_daemon.start' ~port:9999 ~fork:false callback
+Http_daemon.start' ~port:9999 ~fork:false ~timeout:(Some 5) callback

diff --git a/helm/DEVEL/ocaml-http/http_parser.ml b/helm/DEVEL/ocaml-http/http_parser.ml
index a753e40bbb12cfe5e67df2c5701b2fa8d826b65f..ea78eaf29a7ae20464219bdc87e0e4434fe3dd2a 100644 (file)
--- a/helm/DEVEL/ocaml-http/http_parser.ml
+++ b/helm/DEVEL/ocaml-http/http_parser.ml
@@ -20,6 +20,7 @@
 *)
 
 open Neturl;;
+open Printf;;
 
 exception Malformed_query of string
 exception Malformed_query_binding of string * string
@@ -145,6 +146,13 @@ let parse_request =
         let query_params =
           try split_query_params (url_query request_uri) with Not_found -> []
         in
+        Http_common.debug_print
+          (sprintf
+            "recevied request; path: %s; params: %s"
+            path
+            (String.concat
+              ", "
+              (List.map (fun (n, v) -> n ^ "=" ^ v) query_params)));
         (path, query_params)
     | _ -> raise (Malformed_request request_line)
 

diff --git a/helm/DEVEL/ocaml-http/tcp_server.ml b/helm/DEVEL/ocaml-http/tcp_server.ml
index 70b303eeb0f06fe0ba4ffb2f9daac7ac0c5ef64a..44e4df1d57586f1010821e084f2015f8342daa68 100644 (file)
--- a/helm/DEVEL/ocaml-http/tcp_server.ml
+++ b/helm/DEVEL/ocaml-http/tcp_server.ml
@@ -45,7 +45,10 @@ let simple ~sockaddr ~timeout callback =
     let (inchan, outchan) =
       (Unix.in_channel_of_descr suck, Unix.out_channel_of_descr suck)
     in
-    (try callback inchan outchan with Timeout -> ());
+    (try
+      callback inchan outchan;
+      ignore (Unix.alarm 0)
+    with Timeout -> ());
     close_out outchan (* this close also inchan, because socket is the same *)
   done