syndicate-lang
/
hop-2012
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Improve error messages from declaration of resources

This commit is contained in:
Tony Garnock-Jones 2012-03-05 16:55:14 -05:00
parent 16a865580f
commit f159347646
2 changed files with 28 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
amqp_relay.ml
View File

@ -155,14 +155,26 @@ let issue_banner cin cout =
else true else true
with End_of_file -> false with End_of_file -> false
let reference_to_logs = "See server logs for details"
let extract_str v =
match v with
| Sexp.Str s -> s
| _ -> reference_to_logs
let reply_to_declaration conn status ok_fn = let reply_to_declaration conn status ok_fn =
match Message.message_of_sexp status with match Message.message_of_sexp status with
| Message.Create_ok info -> | Message.Create_ok info ->
send_method conn 1 (ok_fn info) send_method conn 1 (ok_fn info)
| Message.Create_failed reason -> | Message.Create_failed reason ->
(match reason with (match reason with
| Sexp.Str s -> send_warning conn precondition_failed s | Sexp.Arr [Sexp.Str "factory"; Sexp.Str "class-not-found"] ->
| _ -> send_warning conn precondition_failed "See server logs for details") send_error conn command_invalid "Object type not supported by server"
| Sexp.Arr [Sexp.Str "constructor"; Sexp.Str "class-mismatch"] ->
send_error conn not_allowed "Redeclaration with different object type not permitted"
| Sexp.Arr [Sexp.Str who; explanation] ->
send_warning conn precondition_failed (who^" failed: "^(extract_str explanation))
| _ ->
send_warning conn precondition_failed reference_to_logs)
| _ -> die internal_error "Declare reply malformed" | _ -> die internal_error "Declare reply malformed"
let make_queue_declare_ok info = let make_queue_declare_ok info =

25
factory.ml
View File

@ -19,20 +19,23 @@ let lookup_class name =
let factory_handler n sexp = let factory_handler n sexp =
match Message.message_of_sexp sexp with match Message.message_of_sexp sexp with
| Message.Create (Str classname, arg, Str reply_sink, Str reply_name) -> | Message.Create (Str classname, arg, Str reply_sink, Str reply_name) ->
(match lookup_class classname with let reply =
| Some factory -> match lookup_class classname with
let reply = | Some factory ->
match factory arg with (match factory arg with
| Status.Ok info -> | Status.Ok info ->
Log.info "Node create ok" [Str classname; arg; Str reply_sink; Str reply_name]; Log.info "Node create ok"
[Str classname; arg; Str reply_sink; Str reply_name; info];
Message.create_ok info Message.create_ok info
| Status.Problem explanation -> | Status.Problem explanation ->
Log.info "Node create failed" [Str classname; arg; Str reply_sink; Str reply_name]; Log.info "Node create failed"
Message.create_failed explanation [Str classname; arg; Str reply_sink; Str reply_name; explanation];
in Message.create_failed (Arr [Str "constructor"; explanation]))
Node.post_ignore reply_sink (Str reply_name) reply (Str "") | None ->
| None -> Log.warn "Node class not found" [Str classname];
Log.warn "Node class not found" [Str classname]) Message.create_failed (Arr [Str "factory"; Str "class-not-found"])
in
Node.post_ignore reply_sink (Str reply_name) reply (Str "")
| m -> | m ->
Util.message_not_understood "factory" m Util.message_not_understood "factory" m