X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fdaemons%2Fuwobo%2Fuwobo.ml;h=167dc04f89d3978d52045779938f56fce9919e19;hb=b8e20d61b2e76f7a36f05b8803e60cc3388c0882;hp=21fa2c851a26fab61edeee53cfa5e37cbccad10f;hpb=c32591eb2a479cba053d804c350dd0564a2679ae;p=helm.git diff --git a/helm/software/daemons/uwobo/uwobo.ml b/helm/software/daemons/uwobo/uwobo.ml index 21fa2c851..167dc04f8 100644 --- 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 = `Debug ;; +let debug_level = `Notice ;; 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,14 +474,14 @@ 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 let xmluri = req#param "xmluri" in let keys = Pcre.split ~pat:"," (req#param "keys") in (* notation: "local" parameters are those defined on a per-stylesheet - pasis (i.e. param.key.param=value), "global" parameters are those + basis (i.e. param.key.param=value), "global" parameters are those defined for all stylesheets (i.e. param.param=value) *) let (user_params, props) = parse_apply_params req#params in let profile_params = @@ -568,13 +566,6 @@ 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 *) @@ -809,8 +800,15 @@ 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 +(* FG: we set a timeout of 900 secs, which is the default of wget *) +(* : 300 secs is too short for some proofs like pr0_confluence.con.body *) + ~timeout:(Some 900) () + in + Http_daemon.main d_spec | _ (* < 0 *) -> (* fork failed :-((( *) failwith "Can't fork :-(" done