--- /dev/null
+(* $Id$ *)
+
+open Hbugs_types;;
+open Printf;;
+
+exception Empty_must;;
+
+module MQI = MQueryInterpreter
+module MQIC = MQIConn
+
+let broker_id = ref None
+let my_own_id = Hbugs_tutors.init_tutor ()
+let my_own_addr, my_own_port = "127.0.0.1", 50011
+let my_own_url = sprintf "%s:%d" my_own_addr my_own_port
+let environment_file = "search_pattern_apply.environment"
+let dump_environment_on_exit = false
+
+let is_authenticated id =
+ match !broker_id with
+ | None -> false
+ | Some broker_id -> id = broker_id
+
+ (* thread who do the dirty work *)
+let slave mqi_handle (state, musing_id) =
+ try
+ prerr_endline (sprintf "Hi, I'm the slave for musing %s" musing_id);
+ let (proof, goal) = Hbugs_tutors.load_state state in
+ let hint =
+ try
+ let choose_must must only = (* euristic: use 2nd precision level
+ 1st is more precise but is more slow *)
+ match must with
+ | [] -> raise Empty_must
+ | _::hd::tl -> hd
+ | hd::tl -> hd
+ in
+ let uris =
+ TacticChaser.matchConclusion mqi_handle
+ ~output_html:prerr_endline ~choose_must () ~status:(proof, goal)
+ in
+ if uris = [] then
+ Sorry
+ else
+ Eureka (Hints (List.map (fun uri -> Use_apply uri) uris))
+ with Empty_must -> Sorry
+ in
+ let answer = Musing_completed (my_own_id, musing_id, hint) in
+ ignore (Hbugs_messages.submit_req ~url:Hbugs_tutors.broker_url answer);
+ prerr_endline
+ (sprintf "Bye, I've completed my duties (success = %b)" (hint <> Sorry))
+ with
+ (Pxp_types.At _) as e ->
+ let rec unbox_exception =
+ function
+ Pxp_types.At (_,e) -> unbox_exception e
+ | e -> e
+ in
+ prerr_endline ("Uncaught PXP exception: " ^ Pxp_types.string_of_exn e) ;
+ (* e could be the Thread.exit exception; otherwise we will release an *)
+ (* uncaught exception and the Pxp_types.At was already an uncaught *)
+ (* exception ==> no additional arm *)
+ raise (unbox_exception e)
+
+let hbugs_callback mqi_handle =
+ let ids = Hashtbl.create 17 in
+ let forbidden () =
+ prerr_endline "ignoring request from unauthorized broker";
+ Exception ("forbidden", "")
+ in
+ function
+ | Start_musing (broker_id, state) ->
+ if is_authenticated broker_id then begin
+ prerr_endline "received Start_musing";
+ let new_musing_id = Hbugs_id_generator.new_musing_id () in
+ let id = ExtThread.create (slave mqi_handle) (state, new_musing_id) in
+ prerr_endline (sprintf "starting a new musing (id = %s)" new_musing_id);
+ Hashtbl.add ids new_musing_id id;
+ (*ignore (Thread.create slave (state, new_musing_id));*)
+ Musing_started (my_own_id, new_musing_id)
+ end else (* broker unauthorized *)
+ forbidden ();
+ | Abort_musing (broker_id, musing_id) ->
+ prerr_endline "CSC: Abort_musing received" ;
+ if is_authenticated broker_id then begin
+ (* prerr_endline "Ignoring 'Abort_musing' message ..."; *)
+ (try
+ ExtThread.kill (Hashtbl.find ids musing_id) ;
+ Hashtbl.remove ids musing_id ;
+ with
+ Not_found
+ | ExtThread.Can_t_kill _ ->
+ prerr_endline ("Can not kill slave " ^ musing_id)) ;
+ Musing_aborted (my_own_id, musing_id)
+ end else (* broker unauthorized *)
+ forbidden ();
+ | unexpected_msg ->
+ Exception ("unexpected_msg",
+ Hbugs_messages.string_of_msg unexpected_msg)
+
+let callback mqi_handle (req: Http_types.request) outchan =
+ try
+ let req_msg = Hbugs_messages.msg_of_string req#body in
+ let answer = hbugs_callback mqi_handle req_msg in
+ Http_daemon.respond ~body:(Hbugs_messages.string_of_msg answer) outchan
+ with Hbugs_messages.Parse_error (subj, reason) ->
+ Http_daemon.respond
+ ~body:(Hbugs_messages.string_of_msg
+ (Exception ("parse_error", reason)))
+ outchan
+
+let restore_environment () =
+ let ic = open_in environment_file in
+ prerr_endline "Restoring environment ...";
+ CicEnvironment.restore_from_channel
+ ~callback:(fun uri -> prerr_endline uri) ic;
+ prerr_endline "... done!";
+ close_in ic
+
+let dump_environment () =
+ let oc = open_out environment_file in
+ prerr_endline "Dumping environment ...";
+ CicEnvironment.dump_to_channel
+ ~callback:(fun uri -> prerr_endline uri) oc;
+ prerr_endline "... done!";
+ close_out oc
+
+let main () =
+ try
+ Sys.catch_break true;
+ at_exit (fun () ->
+ if dump_environment_on_exit then
+ dump_environment ();
+ Hbugs_tutors.unregister_from_broker my_own_id);
+ broker_id :=
+ Some (Hbugs_tutors.register_to_broker
+ my_own_id my_own_url "FOO" "Search_pattern_apply tutor");
+ let mqi_handle = MQIC.init ~log:prerr_string () in
+ if Sys.file_exists environment_file then
+ restore_environment ();
+ Http_daemon.start'
+ ~addr:my_own_addr ~port:my_own_port ~mode:`Thread (callback mqi_handle);
+ MQIC.close mqi_handle
+ with Sys.Break -> () (* exit nicely, invoking at_exit functions *)
+;;
+
+main ()
+