X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=daemons%2Fuwobo%2Fuwobo.ml;h=e7aa1e8f9fc478d8589c3bf749f5a98aa1340280;hb=709805584b15f479b4afcf4220ea3fbe541fe674;hp=1a5b44f620264f3c862bc09f3759b25c68dd311c;hpb=8feb1cda5703daa4371c556593bab63514423a58;p=helm.git diff --git a/daemons/uwobo/uwobo.ml b/daemons/uwobo/uwobo.ml index 1a5b44f62..e7aa1e8f9 100644 --- a/daemons/uwobo/uwobo.ml +++ b/daemons/uwobo/uwobo.ml @@ -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) @@ -801,8 +800,12 @@ let main () = debug_print (sprintf "Starting HTTP daemon on port %d ..." port); (* next invocation doesn't return, process will keep on serving HTTP requests until it will get killed by father *) - Http_daemon.start'~port ~mode:`Fork - (callback ~syslogger ~styles ~cmd_pipe ~res_pipe ()) + let d_spec = Http_daemon.daemon_spec + ~port ~mode:`Fork + ~callback:(callback ~syslogger ~styles ~cmd_pipe ~res_pipe ()) + ~auto_close:true () + in + Http_daemon.main d_spec | _ (* < 0 *) -> (* fork failed :-((( *) failwith "Can't fork :-(" done