X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fdaemons%2Frdfly%2Frdfly.ml;fp=helm%2Fsoftware%2Fdaemons%2Frdfly%2Frdfly.ml;h=18c2e1587dfe0e3c007678b5590abb9b381b3c62;hb=a2dfb2a0f929852d05e38109a24b25b5cfa6585f;hp=b9a79d1397da4941f444b678bc6d62d04322e995;hpb=76b3c4e7fe26f98e56f05c0d45081261161f0b0d;p=helm.git

diff --git a/helm/software/daemons/rdfly/rdfly.ml b/helm/software/daemons/rdfly/rdfly.ml
index b9a79d139..18c2e1587 100644
--- 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,6 +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