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

View File

@ -155,14 +155,26 @@ let issue_banner cin cout =
else true
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 =
match Message.message_of_sexp status with
| Message.Create_ok info ->
send_method conn 1 (ok_fn info)
| Message.Create_failed reason ->
(match reason with
| Sexp.Str s -> send_warning conn precondition_failed s
| _ -> send_warning conn precondition_failed "See server logs for details")
| Sexp.Arr [Sexp.Str "factory"; Sexp.Str "class-not-found"] ->
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"
let make_queue_declare_ok info =

View File

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