X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=DEVEL%2Focaml-http%2Fhttp_daemon.ml;h=992f3b99a8dc9a8bcf2ea31c19b2c05cfbd30f5f;hb=a10be3a13dcc22283717c86e660a95a9f113875d;hp=1b922ea16532947f902a7a00a7f44e8057efa3b8;hpb=78db8ab7c019c74f6dbebc6992dcf7cc9b2c061e;p=helm.git

diff --git a/DEVEL/ocaml-http/http_daemon.ml b/DEVEL/ocaml-http/http_daemon.ml
index 1b922ea16..992f3b99a 100644
--- a/DEVEL/ocaml-http/http_daemon.ml
+++ b/DEVEL/ocaml-http/http_daemon.ml
@@ -303,7 +303,15 @@ let invoke_callback req spec outchan =
   let callback req outchan =
     if spec.auto_close then
       Http_misc.finally
-        (fun () -> try close_out outchan with Sys_error _ -> ())
+        (fun () ->
+          (* XXX the pair flush + shutdown is a temporary solution since double
+           * close on a socket make ocaml 3.09.2 segfault (see
+           * http://caml.inria.fr/mantis/view.php?id=4059). The right thing to
+           * do is probably invoke try_close outchan here *)
+          flush outchan;
+          try
+            Unix.shutdown (Unix.descr_of_out_channel outchan) Unix.SHUTDOWN_ALL
+          with Unix.Unix_error(_, "shutdown", "") -> ())
         (fun () -> spec.callback req outchan) ()
     else
       spec.callback req outchan in