From: Claudio Sacerdoti Coen <claudio.sacerdoticoen@unibo.it>
Date: Mon, 29 May 2006 17:36:36 +0000 (+0000)
Subject: ensure connections get closed after having been served
X-Git-Tag: 0.4.95@7852~1403
X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=commitdiff_plain;h=0dec3cb8c59ba272b6b00fdd959ad9357f00b837;p=helm.git

ensure connections get closed after having been served
---

diff --git a/daemons/whelp/searchEngine.ml b/daemons/whelp/searchEngine.ml
index e98bfe356..bb8c72297 100644
--- a/daemons/whelp/searchEngine.ml
+++ b/daemons/whelp/searchEngine.ml
@@ -404,7 +404,7 @@ prerr_endline "VIVO";
          ^ " 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
@@ -482,6 +482,11 @@ 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"