Instead of closing the socket to avoid persistent connections (a bugged

solution in Ocaml 3.09.2), we use the new ~auto_close feature of libhttp-ocaml.

diff --git a/helm/software/daemons/graphs/tools/drawGraph.ml b/helm/software/daemons/graphs/tools/drawGraph.ml
index 0dc9800fe1c3dac2f226d1ce74dda762c7f8e9dd..dc6bc42d8f6acf3f68c4099823c22698c3d20eb6 100644 (file)
--- a/helm/software/daemons/graphs/tools/drawGraph.ml
+++ b/helm/software/daemons/graphs/tools/drawGraph.ml
@@ -56,7 +56,7 @@ let string_of_exit_status = function
   | Unix.WSIGNALED n -> sprintf "Process killed by signal %d" n
   | Unix.WSTOPPED n -> sprintf "Process stopped by signal %d" n
 in
-let callback ((req: Http_types.request), outchan) =
+let callback (req: Http_types.request) outchan =
   try
     (match req#path with
     | "/draw" ->
@@ -90,18 +90,13 @@ let callback ((req: Http_types.request), outchan) =
         ~body:(sprintf "Parameter '%s' is missing" attr_name)
         outchan
 in
-let callback req ch =
-  HExtlib.finally
-    (fun () -> try close_out ch with Sys_error _ -> ())
-    callback (req, ch)
-in
 Helm_registry.load_from configuration_file;
 let port = Helm_registry.get_int "draw_graph.port" in
 Sys.chdir (Helm_registry.get "draw_graph.dir");
 printf "%s started and listening on port %d\n" daemon_name port;
 printf "current directory is %s\n" (Sys.getcwd ());
 flush stdout;
-let d_spec = Http_daemon.daemon_spec ~port ~callback () in
+let d_spec = Http_daemon.daemon_spec ~port ~callback ~auto_close:true () in
 Http_daemon.main d_spec;
 printf "%s is terminating, bye!\n" daemon_name
 

diff --git a/helm/software/daemons/graphs/tools/uriSetQueue.ml b/helm/software/daemons/graphs/tools/uriSetQueue.ml
index 9c94d4e9a18a4461a2f678fc59711238f8e7fbdb..e55fcd2142fee8256d9008c45116665005630828 100644 (file)
--- a/helm/software/daemons/graphs/tools/uriSetQueue.ml
+++ b/helm/software/daemons/graphs/tools/uriSetQueue.ml
@@ -76,7 +76,7 @@ let queue_mem item queue =  (* mem function over queues *)
   with Found -> true
 ;;
 
-let callback ((req: Http_types.request), outchan) =
+let callback (req: Http_types.request) outchan =
   try
     let res = new Http_response.response () in
     res#addBasicHeaders;
@@ -181,18 +181,11 @@ let callback ((req: Http_types.request), outchan) =
         outchan
 in
 
-let callback req ch =
-  HExtlib.finally
-    (fun () -> try close_out ch with Sys_error _ -> ())
-    callback (req, ch)
-
-in
-
 Helm_registry.load_from configuration_file;
 let port = Helm_registry.get_int "uri_set_queue.port" in
 printf "%s started and listening on port %d\n" daemon_name port;
 flush stdout;
-let d_spec = Http_daemon.daemon_spec ~port ~mode:`Thread ~callback () in
+let d_spec = Http_daemon.daemon_spec ~port ~mode:`Thread ~auto_close:true ~callback () in
 Http_daemon.main d_spec;
 printf "%s is terminating, bye!\n" daemon_name
 

diff --git a/helm/software/daemons/http_getter/main.ml b/helm/software/daemons/http_getter/main.ml
index 572e9de1b932419203400a630186111002fec218..199a8b463f5920e66eaee3ff8681b12a1b494e73 100644 (file)
--- a/helm/software/daemons/http_getter/main.ml
+++ b/helm/software/daemons/http_getter/main.ml
@@ -263,7 +263,7 @@ let respond_xslt patch_xslt xslt_name outchan =
 
   (* thread action *)
 
-let callback ((req: Http_types.request), outchan) =
+let callback (req: Http_types.request) outchan =
   try
     Http_getter_logger.log ("Connection from " ^ req#clientAddr);
     Http_getter_logger.log ("Received request: " ^ req#uri);
@@ -334,11 +334,6 @@ let callback ((req: Http_types.request), outchan) =
           log_failure msg;
           return_html_error ("uncaught_exception", msg) msg outchan)
 
-let callback req outchan =
-  HExtlib.finally
-    (fun () -> try close_out outchan with Sys_error _ -> ())
-    callback (req, outchan)
-
 let batch_update = ref false      
 
 let args = [ ]
@@ -354,6 +349,7 @@ let main () =
   let d_spec = Http_daemon.daemon_spec
      ~mode:`Thread ~timeout:(Some 600) 
      ~port:(Lazy.force Http_getter_env.port)
+     ~auto_close:true
      ~callback:callback ()
   in
   try

diff --git a/helm/software/daemons/proofChecker/proofChecker.ml b/helm/software/daemons/proofChecker/proofChecker.ml
index 928881373470067ba133aafdb34fb76427809d30..1b3661e3471dcdb262f4da1dd19fe5f82bb3c125 100644 (file)
--- a/helm/software/daemons/proofChecker/proofChecker.ml
+++ b/helm/software/daemons/proofChecker/proofChecker.ml
@@ -92,7 +92,7 @@ let _ =
     flush !outchan)
 ;;
 
-let callback ((req : Http_types.request), outchan') =
+let callback (req : Http_types.request) outchan' =
   match req#path with
   | "/proofCheck" ->
       begin
@@ -125,17 +125,11 @@ let callback ((req : Http_types.request), outchan') =
 
 in
 
-let callback req ch =
-  HExtlib.finally
-    (fun () -> try close_out ch with Sys_error _ -> ())
-    callback (req, ch)
-
-in
 
 printf "Proof Checker started and listening on port %d\n" port;
 flush stdout;
 CicEnvironment.set_trust (fun _ -> false);
-let d_spec = Http_daemon.daemon_spec ~port ~mode:`Fork ~callback () in
+let d_spec = Http_daemon.daemon_spec ~port ~mode:`Fork ~callback ~auto_close:true () in
 Http_daemon.main d_spec;
 printf "Proof Checker is terminating, bye!\n"
 

diff --git a/helm/software/daemons/rdfly/rdfly.ml b/helm/software/daemons/rdfly/rdfly.ml
index 54c87b8d8a43a7481baee5833c25b54a87e41623..8dbb6b051c484a48101d68f590a3adeb18c87d75 100644 (file)
--- a/helm/software/daemons/rdfly/rdfly.ml
+++ b/helm/software/daemons/rdfly/rdfly.ml
@@ -152,7 +152,7 @@ let password = get_option "rdfly.mysql_connection.password";;
 let user = get_option "rdfly.mysql_connection.user";;
 let daemonport = Helm_registry.get_int "rdfly.port";;
 
-let callback ((req: Http_types.request), ch) =
+let callback (req: Http_types.request) ch =
   try
     debug_print ("Connection from " ^ req#clientAddr) ;
     debug_print ("Received request: " ^ req#uri) ;
@@ -180,16 +180,11 @@ let callback ((req: Http_types.request), ch) =
   | exc ->
       return_html_error ("Uncaught exception: " ^ (Printexc.to_string exc)) ch
 
-let callback req ch =
-  HExtlib.finally
-    (fun () -> try close_out ch with Sys_error _ -> ())
-    callback (req, ch)
-
 let main () =
   Sys.catch_break true;
   try
     let d_spec =
-      Http_daemon.daemon_spec ~timeout:(Some 600) ~port:daemonport ~callback ()
+      Http_daemon.daemon_spec ~timeout:(Some 600) ~port:daemonport ~callback ~auto_close:true ()
     in
     Http_daemon.main d_spec
   with Sys.Break -> ()

diff --git a/helm/software/daemons/uwobo/uwobo.ml b/helm/software/daemons/uwobo/uwobo.ml
index 7b8a20954f973743eb9a57351d45ce55a8b26124..e7aa1e8f9fc478d8589c3bf749f5a98aa1340280 100644 (file)
--- a/helm/software/daemons/uwobo/uwobo.ml
+++ b/helm/software/daemons/uwobo/uwobo.ml
@@ -566,13 +566,6 @@ let callback
       return_error ("Uncaught exception: " ^ (Printexc.to_string exc)) outchan
 ;;
 
-let callback
-  ~syslogger ~styles ~cmd_pipe ~res_pipe () (req: Http_types.request) outchan
-=
-  HExtlib.finally
-    (fun () -> try close_out outchan with Sys_error _ -> ())
-    (callback ~syslogger ~styles ~cmd_pipe ~res_pipe () req) outchan
-
   (* UWOBO's startup *)
 let main () =
     (* (1) system logger *)
@@ -809,7 +802,8 @@ let main () =
           requests until it will get killed by father *)
         let d_spec = Http_daemon.daemon_spec
             ~port ~mode:`Fork
-            ~callback:(callback ~syslogger ~styles ~cmd_pipe ~res_pipe ()) ()
+            ~callback:(callback ~syslogger ~styles ~cmd_pipe ~res_pipe ())
+            ~auto_close:true ()
         in
         Http_daemon.main d_spec
     | _ (* < 0 *) ->  (* fork failed :-((( *)

diff --git a/helm/software/daemons/whelp/searchEngine.ml b/helm/software/daemons/whelp/searchEngine.ml
index fc49116196d4cb96ff0518d43527e76ab27ef753..8524588ca76ea9b4c557ca266242c2ed98f6a390 100644 (file)
--- a/helm/software/daemons/whelp/searchEngine.ml
+++ b/helm/software/daemons/whelp/searchEngine.ml
@@ -403,7 +403,7 @@ let exec_action dbd (req: Http_types.request) outchan =
          ^ " type")))
         req outchan
 
-let callback (dbd, (req: Http_types.request), outchan) =
+let callback dbd (req: Http_types.request) outchan =
   try
     debug_print (sprintf "Received request: %s" req#path);
     (match req#path with
@@ -481,11 +481,6 @@ let callback (dbd, (req: Http_types.request), outchan) =
       let msg = MooglePp.pp_error "Uncaught exception" exn_string in
       send_results (`Error msg) req outchan
 
-let callback dbd req ch =
-  HExtlib.finally
-    (fun () -> try close_out ch with Sys_error _ -> ())
-    callback (dbd, req, ch)
-
 let restore_environment () =
   match
     Helm_registry.get_opt Helm_registry.string "search_engine.environment_dump"
@@ -519,7 +514,7 @@ let _ =
   in
   restore_environment ();
   read_notation ();
-  let d_spec = Http_daemon.daemon_spec ~port ~callback:(callback dbd) () in
+  let d_spec = Http_daemon.daemon_spec ~port ~callback:(callback dbd) ~auto_close:true () in
   Http_daemon.main d_spec;
   printf "%s is terminating, bye!\n" daemon_name