From: Stefano Zacchiroli Date: Wed, 19 Feb 2003 13:46:36 +0000 (+0000) Subject: - better specialization of some error messages X-Git-Tag: V_0_0_4_1~35 X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=commitdiff_plain;h=f54edaccaf3d56499632ce349276be5c2e711a6c;p=helm.git - better specialization of some error messages - added some informational messages - use hint received from tutor instead of a fooish one - control over answer from gTopLevel when sending hint - commented out debugging wrapper which print all received messages --- diff --git a/helm/hbugs/broker/hbugs_broker.ml b/helm/hbugs/broker/hbugs_broker.ml index 87a60bba7..495fbf161 100644 --- a/helm/hbugs/broker/hbugs_broker.ml +++ b/helm/hbugs/broker/hbugs_broker.ml @@ -55,14 +55,24 @@ let return_xml_msg body outchan = let parse_musing_id = function | Musing_started (_, musing_id) -> musing_id | Musing_aborted (_, musing_id) -> musing_id - | _ -> assert false + | msg -> + prerr_endline (sprintf "Assertion failed, received msg: %s" + (Hbugs_messages.string_of_msg msg)); + assert false ;; let do_critical = let mutex = Mutex.create () in fun action -> try - Mutex.lock mutex; let res = Lazy.force action in Mutex.unlock mutex; res +(* debug_print "Acquiring lock ..."; *) + Mutex.lock mutex; +(* debug_print "Lock Acquired!"; *) + let res = Lazy.force action in +(* debug_print "Releaseing lock ..."; *) + Mutex.unlock mutex; +(* debug_print "Lock released!"; *) + res with e -> Mutex.unlock mutex; raise e ;; @@ -84,9 +94,9 @@ let dump_registries () = String.concat "\n" (List.map (fun o -> o#dump) registries) in -let handle_msg outchan = function - +let handle_msg outchan msg = (* messages from clients *) + (match msg with | Help -> Hbugs_messages.respond_msg (Usage usage_string) outchan @@ -133,6 +143,9 @@ let handle_msg outchan = function | State_change (client_id, new_state) -> do_critical (lazy ( if clients#isAuthenticated client_id then begin let active_musings = musings#getByClientId client_id in + prerr_endline (sprintf "ACTIVE MUSINGS: %s" (String.concat ", " active_musings)); + if List.length active_musings = 0 then + prerr_endline ("No active musings for client " ^ client_id); let stop_answers = List.map (* collect Abort_musing message's responses *) (fun id -> (* musing id *) @@ -142,6 +155,9 @@ let handle_msg outchan = function active_musings in List.iter musings#unregister active_musings; + let subscriptions = clients#getSubscription client_id in + if List.length subscriptions = 0 then + prerr_endline ("No subscriptions for client " ^ client_id); let started_musing_ids = List.map (* register new musings and collect their ids *) (fun tutor_id -> @@ -153,7 +169,7 @@ let handle_msg outchan = function let musing_id = parse_musing_id res in musings#register musing_id client_id tutor_id; musing_id) - (clients#getSubscription client_id) + subscriptions in let stopped_musing_ids = List.map parse_musing_id stop_answers in Hbugs_messages.respond_msg @@ -179,32 +195,41 @@ let handle_msg outchan = function end else Hbugs_messages.respond_exc "forbidden" tutor_id outchan )) + | Musing_completed (tutor_id, musing_id, result) -> do_critical (lazy ( - if tutors#isAuthenticated tutor_id then begin + if not (tutors#isAuthenticated tutor_id) then begin (* unauthorized *) + Hbugs_messages.respond_exc "forbidden" tutor_id outchan; + end else if not (musings#isActive musing_id) then begin (* too late *) + Hbugs_messages.respond_msg (Too_late (my_own_id, musing_id)) outchan; + end else begin (* all is ok: autorhized and on time *) (match result with | Sorry -> () - | Eureka extras -> + | Eureka hint -> + let client_url = + clients#getUrl (fst (musings#getByMusingId musing_id)) + in let res = - let hint = (* TODO decidere la hint *) "hint!!!!" in - let url = - clients#getUrl (fst (musings#getByMusingId musing_id)) - in - Hbugs_messages.submit_req ~url (Hint (my_own_id, hint)) + Hbugs_messages.submit_req ~url:client_url (Hint (my_own_id, hint)) in - ignore res (* TODO mi interessa la risposta? *) - ); + (match res with + | Wow _ -> () (* ok: client is happy with our hint *) + | unexpected_msg -> + prerr_endline + (sprintf + "Warning: unexpected msg from client: %s\nExpected was: Wow" + (Hbugs_messages.string_of_msg msg)))); Hbugs_messages.respond_msg (Thanks (my_own_id, musing_id)) outchan; musings#unregister musing_id - end else - Hbugs_messages.respond_exc "forbidden" tutor_id outchan + end )) | msg -> (* unexpected message *) debug_print "Unknown message!"; Hbugs_messages.respond_exc - "unexpected_msg" (Hbugs_messages.string_of_msg msg) outchan + "unexpected_msg" (Hbugs_messages.string_of_msg msg) outchan) in -let handle_msg outchan = (* debugging wrapper around 'handle_msg' *) +(* (* DEBUGGING wrapper around 'handle_msg' *) +let handle_msg outchan = if debug then (fun msg -> (* filter handle_msg through a function which dumps input messages *) @@ -213,6 +238,7 @@ let handle_msg outchan = (* debugging wrapper around 'handle_msg' *) else handle_msg outchan in +*) (* thread action *) let callback (req: Http_types.request) outchan = @@ -222,7 +248,9 @@ let callback (req: Http_types.request) outchan = (match req#path with (* TODO write help message *) | "/help" -> return_xml_msg " not yet written " outchan - | "/act" -> handle_msg outchan (Hbugs_messages.msg_of_string req#body) + | "/act" -> + let msg = Hbugs_messages.msg_of_string req#body in + handle_msg outchan msg | "/dump" -> if debug then Http_daemon.respond ~body:(dump_registries ()) outchan