ensure connections get closed after having been served

[helm.git] / helm / software / daemons / uwobo / uwobo.ml

diff --git a/helm/software/daemons/uwobo/uwobo.ml b/helm/software/daemons/uwobo/uwobo.ml
index 1a5b44f620264f3c862bc09f3759b25c68dd311c..9cad8bd55fb53ac61527ca7c51bd6604310061e1 100644 (file)
--- a/helm/software/daemons/uwobo/uwobo.ml
+++ b/helm/software/daemons/uwobo/uwobo.ml
@@ -31,7 +31,7 @@ open Uwobo_common;;
 
  (* debugging settings *)
 let debug = false ;;
-let debug_level = `Notice ;;
+let debug_level = `Debug ;;
 let debug_print s = if debug then prerr_endline s ;;
 Http_common.debug := false ;;
 
@@ -288,9 +288,7 @@ let start_new_session cmd_pipe res_pipe outchan port logfile =
           Unix.environment ()
          in
          (* 4. We exec a new copy of uwobo *)
-         Unix.execve Sys.executable_name [||] environment ; 
-         (* It should never reach this point *)
-         assert false
+         Unix.execve Sys.executable_name [||] environment
        ) ()
   | child when child > 0 ->
      (* let's check if the new UWOBO started correctly *)
@@ -476,7 +474,7 @@ let callback
            | None -> Http_daemon.respond_error ~code:(`Status (`Client_error `Bad_request)) outchan ;
          end
     | "/apply" ->
-        let logger = new Uwobo_logger.processingLogger () in
+(*         let logger = new Uwobo_logger.processingLogger () in *)
         veillogger#clearMsgs;
        let profile = try Some (req#param "profile") with _ -> None in
        let password = try Some (req#param "password") with _ -> None in
@@ -548,7 +546,8 @@ let callback
           Http_daemon.send_basic_headers ~code:(`Code 200) outchan;
           Http_daemon.send_header "Content-Type" content_type outchan;
           Http_daemon.send_CRLF outchan;
-          write_result outchan
+          write_result outchan;
+          close_out outchan
         with Uwobo_failure errmsg ->
           return_error
             ("Stylesheet chain application failed: " ^ errmsg)
@@ -567,6 +566,13 @@ 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 *)