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 *)
| 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 =
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)
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