From 7cfc146e523e2cab0b2b68e881135024babd93f9 Mon Sep 17 00:00:00 2001 From: Claudio Sacerdoti Coen Date: Mon, 29 May 2006 16:54:47 +0000 Subject: [PATCH] ensure connections get closed after having been served --- daemons/uwobo/uwobo.ml | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/daemons/uwobo/uwobo.ml b/daemons/uwobo/uwobo.ml index 1a5b44f62..21fa2c851 100644 --- a/daemons/uwobo/uwobo.ml +++ b/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 ;; @@ -548,7 +548,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 +568,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 *) -- 2.39.2