X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=blobdiff_plain;f=helm%2Fsoftware%2Fdaemons%2Fwhelp%2FsearchEngine.ml;h=2924f6eb16fa4b2e9aa0a5391113d949485be4db;hb=f505d9e257aa3209652264b97bb62d87ce592091;hp=fc49116196d4cb96ff0518d43527e76ab27ef753;hpb=71b3673b0d4f5e615315ea586fc6174e898abbfc;p=helm.git diff --git a/helm/software/daemons/whelp/searchEngine.ml b/helm/software/daemons/whelp/searchEngine.ml index fc4911619..2924f6eb1 100644 --- a/helm/software/daemons/whelp/searchEngine.ml +++ b/helm/software/daemons/whelp/searchEngine.ml @@ -260,6 +260,7 @@ let send_results results moogle_TPL let exec_action dbd (req: Http_types.request) outchan = + let dbd = dbd () in let term_str = req#param "expression" in try if req#path = "/elim" && @@ -372,7 +373,7 @@ let exec_action dbd (req: Http_types.request) outchan = | "/match" -> Whelp.match_term ~dbd term | "/instance" -> Whelp.instance ~dbd term | "/hint" -> - let status = ProofEngineTypes.initial_status term metasenv in + let status = ProofEngineTypes.initial_status term metasenv [] in let intros = PrimitiveTactics.intros_tac () in let subgoals = ProofEngineTypes.apply_tactic intros status in (match subgoals with @@ -403,7 +404,7 @@ let exec_action dbd (req: Http_types.request) outchan = ^ " type"))) req outchan -let callback (dbd, (req: Http_types.request), outchan) = +let callback dbd (req: Http_types.request) outchan = try debug_print (sprintf "Received request: %s" req#path); (match req#path with @@ -449,7 +450,7 @@ let callback (dbd, (req: Http_types.request), outchan) = if expression = "" then send_results (`Results []) req outchan else begin - let results = Whelp.locate ~dbd expression in + let results = Whelp.locate ~dbd:(dbd ()) expression in let results = List.map UriManager.string_of_uri results in send_results (`Results results) req outchan end @@ -481,11 +482,6 @@ let callback (dbd, (req: Http_types.request), outchan) = let msg = MooglePp.pp_error "Uncaught exception" exn_string in send_results (`Error msg) req outchan -let callback dbd req ch = - HExtlib.finally - (fun () -> try close_out ch with Sys_error _ -> ()) - callback (dbd, req, ch) - let restore_environment () = match Helm_registry.get_opt Helm_registry.string "search_engine.environment_dump" @@ -510,7 +506,7 @@ let _ = printf "HTML directory is %s\n" pages_dir; flush stdout; Unix.putenv "http_proxy" ""; - let dbd = + let dbd () = HMysql.quick_connect ~host:(Helm_registry.get "db.host") ~database:(Helm_registry.get "db.database") @@ -519,7 +515,7 @@ let _ = in restore_environment (); read_notation (); - let d_spec = Http_daemon.daemon_spec ~port ~callback:(callback dbd) () in + let d_spec = Http_daemon.daemon_spec ~port ~callback:(callback dbd) ~auto_close:true () in Http_daemon.main d_spec; printf "%s is terminating, bye!\n" daemon_name