open Printf;;
let broker_url = "localhost:49081/act";;
+let dump_environment_on_exit = false;;
let init_tutor = Hbugs_id_generator.new_tutor_id;;
val hint: hint
val hint_type: hint_type
val description: string
+ val environment_file: string
end
module BuildTutor (Dsc: HbugsTutorDescription) : HbugsTutor =
(sprintf "Bye, I've completed my duties (success = %b)" success)
let hbugs_callback =
+ (* hashtbl mapping musings ids to PID of threads doing the related (dirty)
+ work *)
+ let slaves = Hashtbl.create 17 in
let forbidden () =
prerr_endline "ignoring request from unauthorized broker";
Exception ("forbidden", "")
in
- function
+ function (* _the_ callback *)
| 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
prerr_endline
(sprintf "starting a new musing (id = %s)" new_musing_id);
- ignore (Thread.create slave (state, new_musing_id));
+(* let slave_thread = Thread.create slave (state, new_musing_id) in *)
+ let slave_thread =
+ Hbugs_deity.create slave (state, new_musing_id)
+ in
+ Hashtbl.add slaves new_musing_id slave_thread;
Musing_started (my_own_id, new_musing_id)
end else (* broker unauthorized *)
forbidden ();
| Abort_musing (broker_id, musing_id) ->
if is_authenticated broker_id then begin
- prerr_endline "Ignoring 'Abort_musing' message ...";
+ (try (* kill thread responsible for "musing_id" *)
+ let slave_thread = Hashtbl.find slaves musing_id in
+ Hbugs_deity.kill slave_thread;
+ Hashtbl.remove slaves musing_id
+ with
+ | Hbugs_deity.Can_t_kill (pid, reason) ->
+ prerr_endline (sprintf "Unable to kill slave %d: %s" pid reason)
+ | Not_found ->
+ prerr_endline (sprintf
+ "Can't find slave corresponding to musing %s, can't kill it"
+ musing_id));
Musing_aborted (my_own_id, musing_id)
end else (* broker unauthorized *)
forbidden ();
(Exception ("parse_error", reason)))
outchan
+ let restore_environment () =
+ let ic = open_in Dsc.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 Dsc.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 () -> unregister_from_broker my_own_id);
+ at_exit (fun () ->
+ if dump_environment_on_exit then
+ dump_environment ();
+ unregister_from_broker my_own_id);
broker_id :=
Some (register_to_broker
my_own_id my_own_url Dsc.hint_type Dsc.description);
+ if Sys.file_exists Dsc.environment_file then
+ restore_environment ();
Http_daemon.start'
~addr:my_own_addr ~port:my_own_port ~mode:`Thread callback
with Sys.Break -> () (* exit nicely, invoking at_exit functions *)