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

ensure connections get closed after having been served
---

diff --git a/daemons/http_getter/main.ml b/daemons/http_getter/main.ml
index c200c161d..572e9de1b 100644
--- a/daemons/http_getter/main.ml
+++ b/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,6 +334,11 @@ 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 = [ ]