2
# User John Aspden <john.aspden@xensource.com>
4
# Node ID 212dd2e2b166e496681b7531e6c075d08cefa58f
5
# Parent cfceb249cbfd3126f61089e6713655e21722eb02
6
modification to the server code to record in its log file when exceptions not listed in the data model are thrown.
8
To see the output, you must also comment out the line
10
log = debug;dispatcher;nil
12
in /etc/xapi.conf on the server.
14
diff -r cfceb249cbfd -r 212dd2e2b166 ocaml/idl/ocaml_backend/gen_server.ml
15
--- a/ocaml/idl/ocaml_backend/gen_server.ml Tue Nov 13 10:33:34 2007 +0000
16
+++ b/ocaml/idl/ocaml_backend/gen_server.ml Tue Nov 13 12:36:28 2007 +0000
17
@@ -243,7 +243,7 @@ let gen_module api : O.Module.t =
18
" Fault(0l, \"No async mode for this operation (rpc: \"^__call^\")\") in" ] @
20
debug "%s %s" [ "__call"; "(if __async then \"(async)\" else \"\")" ];
21
- "Server_helpers.dispatch_exn_wrapper (fun () -> (match (__call, __params) with ";
22
+ "Server_helpers.dispatch_exn_wrapper __call (fun () -> (match (__call, __params) with ";
23
] @ (List.flatten (List.map obj all_objs)) @ [
25
" " ^ (debug "Unknown rpc \"%s\"" [ "__call" ]);
26
diff -r cfceb249cbfd -r 212dd2e2b166 ocaml/idl/ocaml_backend/server_helpers.ml
27
--- a/ocaml/idl/ocaml_backend/server_helpers.ml Tue Nov 13 10:33:34 2007 +0000
28
+++ b/ocaml/idl/ocaml_backend/server_helpers.ml Tue Nov 13 12:36:28 2007 +0000
29
@@ -1,5 +1,6 @@ open Locking_helpers
34
module D = Debug.Debugger(struct let name = "dispatcher" end)
36
@@ -88,10 +89,29 @@ let empty_context =
37
Context.origin = Context.Internal "server_helpers: empty_context";
38
Context.name = "empty_context" }
40
-let dispatch_exn_wrapper f =
42
+open Datamodel_types;;
45
+let classes = objects_of_api Datamodel.all_api;;
48
+let dispatch_exn_wrapper __call f =
51
- with exn -> let code, params = ExnHelper.error_of_exn exn in XMLRPC.Failure(code, params)
52
+ with exn -> let code, params = ExnHelper.error_of_exn exn in
54
+ (**when an exception is thrown, check that the data model allows it for this call. If not, then log the mismatch.*)
55
+ let lst = (String.split '.' __call) in
56
+ let object_name = (List.hd lst) in
57
+ let message_name = (List.hd (List.tl lst)) in
58
+ let datamodel_class = (List.find (fun x -> x.name=object_name) classes) in
59
+ let datamodel_message = (List.find (fun x -> x.msg_name=message_name) datamodel_class.messages) in
60
+ let allowed_errors = (List.map (fun x -> x.err_name) datamodel_message.msg_errors) in
61
+ let found = List.mem code allowed_errors in
62
+ if (not found) then debug "(unlisted exception is being thrown) %s %s" __call code;
63
+ XMLRPC.Failure(code, params)
66
(** Called by autogenerated dispatch code *)
67
let do_dispatch ?session_id ?forward_op ?op_fn ?self __type called_async supports_async called_fn_name op_fn