More rpcgen stuff:

. switch rpc param passing to using objects instead of arrays
. prettify client rpc method names
. rename xenvm-proto rpc method names

diff --git a/gen/rpc/codegen.ml b/gen/rpc/codegen.ml
index d2826ef9c87692c59de1c4a0fd65130df6dec534..4dd63011bcb7120898067b75f17db1e95647079b 100644 (file)
--- a/gen/rpc/codegen.ml
+++ b/gen/rpc/codegen.ml
@@ -78,7 +78,7 @@ module Server = struct
 
        let end_server ff =
                fprintf ff "@]@\nend@\n@\n@?"
-         
+
        let gen_dispatch_struct ff server rpc_list notif_list =
                let get_arg_types params =
                        match params with
@@ -109,14 +109,14 @@ module Server = struct
                fprintf ff "@]@\n}@\n@\n";
                sig_name
 
-       let gen_param ff venv arrvn i p =
+       let gen_param ff venv otvn i p =
                let arg, venv = Var_env.new_ident_from_name venv p.param_name in
-               fprintf ff "let %s = %s %s.(%d) in@," (name_of_var arg) (Type_conv.of_json p.param_type) arrvn i;
+               fprintf ff "let %s = %s (Json_conv.get_object_field %s \"%s\") in@," (name_of_var arg) (Type_conv.of_json p.param_type) otvn p.param_name;
                arg, venv
 
        let gen_request ff venv reqv impl_module rpc resp =
-               let arrv, venv = Var_env.new_ident_from_name venv "params" in
-               let arrvn, reqvn = name_of_var arrv, name_of_var reqv in
+               let otv, venv = Var_env.new_ident_from_name venv "params" in
+               let otvn, reqvn = name_of_var otv, name_of_var reqv in
                let methname = rpc.rpc_request.request_handler in
                let params = rpc.rpc_request.request_params in
                fprintf ff "@[<v 8>| \"%s\" ->@," rpc.rpc_request.request_name;
@@ -125,11 +125,10 @@ module Server = struct
                         | [] ->
                                "()", venv
                         | _  ->
-                               fprintf ff "let %s = Json_conv.get_array %s.Jsonrpc.params in@," arrvn reqvn;
-                               fprintf ff "Json_conv.check_array_with_length %s %d;@," arrvn (List.length params);
+                               fprintf ff "let %s = Json_conv.get_object_table %s.Jsonrpc.params in@," otvn reqvn;
                                let paramsv, venv, _ =
                                        List.fold_left (fun (alist, venv, i) p ->
-                                                               let a, venv = gen_param ff venv arrvn i p in
+                                                               let a, venv = gen_param ff venv otvn i p in
                                                                (a :: alist), venv, (i + 1)
                                                       ) ([], venv, 0) params in
 
@@ -144,8 +143,8 @@ module Server = struct
                fprintf ff "Jsonrpc.Result %s@]@," respjvn
 
        let gen_notification ff venv reqv impl_module rpc =
-               let arrv, venv = Var_env.new_ident_from_name venv "params" in
-               let arrvn, reqvn = name_of_var arrv, name_of_var reqv in
+               let otv, venv = Var_env.new_ident_from_name venv "params" in
+               let otvn, reqvn = name_of_var otv, name_of_var reqv in
                let methname = rpc.rpc_request.request_handler in
                let params = rpc.rpc_request.request_params in
                fprintf ff "@[<v 8>| \"%s\" ->@," rpc.rpc_request.request_name;
@@ -154,11 +153,10 @@ module Server = struct
                         | [] ->
                                "()", venv
                         | _  ->
-                               fprintf ff "let %s = Json_conv.get_array %s.Jsonrpc.params in@," arrvn reqvn;
-                               fprintf ff "Json_conv.check_array_with_length %s %d;@," arrvn (List.length params);
+                               fprintf ff "let %s = Json_conv.get_object_table %s.Jsonrpc.params in@," otvn reqvn;
                                let paramsv, venv, _ =
                                        List.fold_left (fun (alist, venv, i) p ->
-                                                               let a, venv = gen_param ff venv arrvn i p in
+                                                               let a, venv = gen_param ff venv otvn i p in
                                                                (a :: alist), venv, (i + 1)
                                                       ) ([], venv, 0) params in
                                (String.concat " " (List.map (fun v -> name_of_var v) (List.rev paramsv))), venv
@@ -207,6 +205,16 @@ module Server = struct
 end
 
 module Client = struct
+       let gen_method_name pn =
+               let nm = String.copy pn in
+               for i = 0 to (String.length pn) - 1 do
+                       match pn.[i] with
+                       | '.' -> nm.[i] <- '_'
+                       | 'A' .. 'Z' -> nm.[i] <- Char.lowercase pn.[i]
+                       | _ -> ()
+               done;
+               nm
+
        let start_maker ff s =
                let rpcid_maker = "Rpc_id_maker" in
                fprintf ff "module Make_%s_client (%s : Jsonrpc.Rpc_id_generator) =@\n" (String.lowercase s.server_name) rpcid_maker ;
@@ -223,25 +231,30 @@ module Client = struct
                let vvlist, venv = Var_env.new_idents_from_names venv ~prefix:"j_" args in
                let rpcv, venv = Var_env.new_ident_from_name venv "rpc_id" in
                let rpcvn = name_of_var rpcv in
+               let meth_name = gen_method_name rpc.rpc_request.request_name in
                let args_str =
                        (match args with
                         | [] ->
-                               fprintf ff "@,@[<v 8>let jrpc_%s () =@," rpc.rpc_request.request_name;
+                               fprintf ff "@,@[<v 8>let jrpc_%s () =@," meth_name;
                                ""
                         | _  ->
-                               fprintf ff "@,@[<v 8>let jrpc_%s %s =@," rpc.rpc_request.request_name (String.concat " " (List.map name_of_var avlist));
+                               fprintf ff "@,@[<v 8>let jrpc_%s %s =@," meth_name (String.concat " " (List.map name_of_var avlist));
                                List.iter2 (fun p (a, v) ->
                                                fprintf ff "let %s = %s %s in@,"
                                                         (name_of_var v) (Type_conv.to_json p.param_type) (name_of_var a)
                                           ) params (List.combine avlist vvlist);
-                               String.concat "; " (List.map name_of_var vvlist))
+                               String.concat "; " (List.map2 (fun a v ->
+                                                                Printf.sprintf "\"%s\", %s" a (name_of_var v)
+                                                             ) args vvlist
+                                                  )
+                       )
                in
                (match rpc.rpc_response with
                | None ->   fprintf ff "let %s = None in@," rpcvn
                | Some _ -> fprintf ff "let %s = Some (%s.get_rpc_request_id ()) in@," rpcvn rpcid_maker);
                fprintf ff "@[<v 2>{ Jsonrpc.request_id = %s;@," rpcvn;
                fprintf ff "Jsonrpc.method_name = \"%s\";@," rpc.rpc_request.request_name;
-               fprintf ff "Jsonrpc.params = Json.Array (Array.of_list [ %s ])" args_str;
+               fprintf ff "Jsonrpc.params = Json.Object (Array.of_list [ %s ])" args_str;
                fprintf ff "@]@,}@]"
 end
 

diff --git a/xenvm/proto/xenvm_control.json b/xenvm/proto/xenvm_control.json
index e2b7892ef734ea1f98b00a9acc511e61d1a175fa..796a0b8504ce0b56a1d198e44f8fce788af682a3 100644 (file)
--- a/xenvm/proto/xenvm_control.json
+++ b/xenvm/proto/xenvm_control.json
@@ -10,7 +10,7 @@
   "rpc_doc": "",
   "rpc_version": "0.1",
 
-  "rpc_request": { "request_name": "Cmd_Quit",
+  "rpc_request": { "request_name": "Cmd.Quit",
                    "request_doc": "Commands XenVM to exit.",
                    "request_handler": "quit_handler",
                    "request_params": [ ]
@@ -31,7 +31,7 @@
   "rpc_doc": "",
   "rpc_version": "0.1",
 
-  "rpc_request": { "request_name": "Cmd_ReadConfig",
+  "rpc_request": { "request_name": "Cmd.ReadConfig",
                    "request_doc": "Commands XenVM to (re) load the specified config.",
                    "request_handler": "read_config_handler",
                    "request_params": [ { "param_name": "location",
@@ -56,7 +56,7 @@
   "rpc_doc": "",
   "rpc_version": "0.1",
 
-  "rpc_request": { "request_name": "VM_Start",
+  "rpc_request": { "request_name": "VM.Start",
                    "request_doc": "",
                    "request_handler": "vm_start_handler",
                    "request_params": [ ]
@@ -76,7 +76,7 @@
   "rpc_doc": "",
   "rpc_version": "0.1",
 
-  "rpc_request": { "request_name": "VM_Pause",
+  "rpc_request": { "request_name": "VM.Pause",
                    "request_doc": "",
                    "request_handler": "vm_pause_handler",
                    "request_params": [ ]
@@ -96,7 +96,7 @@
   "rpc_doc": "",
   "rpc_version": "0.1",
 
-  "rpc_request": { "request_name": "VM_Unpause",
+  "rpc_request": { "request_name": "VM.Unpause",
                    "request_doc": "",
                    "request_handler": "vm_unpause_handler",
                    "request_params": [ ]
@@ -116,7 +116,7 @@
   "rpc_doc": "",
   "rpc_version": "0.1",
 
-  "rpc_request": { "request_name": "VM_Reboot",
+  "rpc_request": { "request_name": "VM.Reboot",
                    "request_doc": "",
                    "request_handler": "vm_reboot_handler",
                    "request_params": [ ]
@@ -136,7 +136,7 @@
   "rpc_doc": "",
   "rpc_version": "0.1",
 
-  "rpc_request": { "request_name": "VM_Restart",
+  "rpc_request": { "request_name": "VM.Restart",
                    "request_doc": "",
                    "request_handler": "vm_restart_handler",
                    "request_params": [ { "param_name": "force",
@@ -159,7 +159,7 @@
   "rpc_doc": "",
   "rpc_version": "0.1",
 
-  "rpc_request": { "request_name": "VM_Halt",
+  "rpc_request": { "request_name": "VM.Halt",
                    "request_doc": "",
                    "request_handler": "vm_halt_handler",
                    "request_params": [ { "param_name": "force",
@@ -182,7 +182,7 @@
   "rpc_doc": "",
   "rpc_version": "0.1",
 
-  "rpc_request": { "request_name": "VM_Suspend",
+  "rpc_request": { "request_name": "VM.Suspend",
                    "request_doc": "",
                    "request_handler": "vm_suspend_handler",
                    "request_params": [ { "param_name": "flags",
@@ -208,7 +208,7 @@
   "rpc_doc": "",
   "rpc_version": "0.1",
 
-  "rpc_request": { "request_name": "VM_Restore",
+  "rpc_request": { "request_name": "VM.Restore",
                    "request_doc": "",
                    "request_handler": "vm_restore_handler",
                    "request_params": [ { "param_name": "flags",
@@ -234,7 +234,7 @@
   "rpc_doc": "",
   "rpc_version": "0.1",
 
-  "rpc_request": { "request_name": "VM_Checkpoint",
+  "rpc_request": { "request_name": "VM.Checkpoint",
                    "request_doc": "",
                    "request_handler": "vm_checkpoint_handler",
                    "request_params": [ { "param_name": "location",
@@ -257,7 +257,7 @@
   "rpc_doc": "",
   "rpc_version": "0.1",
 
-  "rpc_request": { "request_name": "VM_GetStatus",
+  "rpc_request": { "request_name": "VM.GetStatus",
                    "request_doc": "",
                    "request_handler": "vm_getstatus_handler",
                    "request_params": [ ]
@@ -277,7 +277,7 @@
   "rpc_doc": "",
   "rpc_version": "0.1",
 
-  "rpc_request": { "request_name": "VM_GetVNC",
+  "rpc_request": { "request_name": "VM.GetVNC",
                    "request_doc": "",
                    "request_handler": "vm_getvnc_handler",
                    "request_params": [ ]
@@ -297,7 +297,7 @@
   "rpc_doc": "",
   "rpc_version": "0.1",
 
-  "rpc_request": { "request_name": "VM_GetDomId",
+  "rpc_request": { "request_name": "VM.GetDomId",
                    "request_doc": "",
                    "request_handler": "vm_getdomid_handler",
                    "request_params": [ ]
@@ -317,7 +317,7 @@
   "rpc_doc": "",
   "rpc_version": "0.1",
 
-  "rpc_request": { "request_name": "Device_Plug",
+  "rpc_request": { "request_name": "Device.Plug",
                    "request_doc": "",
                    "request_handler": "device_plug_handler",
                    "request_params": [ { "param_name": "device",
@@ -340,7 +340,7 @@
   "rpc_doc": "",
   "rpc_version": "0.1",
 
-  "rpc_request": { "request_name": "Device_Unplug",
+  "rpc_request": { "request_name": "Device.Unplug",
                    "request_doc": "",
                    "request_handler": "device_unplug_handler",
                    "request_params": [ { "param_name": "device",
@@ -363,7 +363,7 @@
   "rpc_doc": "",
   "rpc_version": "0.1",
 
-  "rpc_request": { "request_name": "Device_List",
+  "rpc_request": { "request_name": "Device.List",
                    "request_doc": "",
                    "request_handler": "device_list_handler",
                    "request_params": [ { "param_name": "devtype",
@@ -386,7 +386,7 @@
   "rpc_doc": "",
   "rpc_version": "0.1",
 
-  "rpc_request": { "request_name": "VM_State_Get",
+  "rpc_request": { "request_name": "VM.State.Get",
                    "request_doc": "",
                    "request_handler": "vmstate_get_handler",
                    "request_params": [ { "param_name": "field",
@@ -410,7 +410,7 @@
   "rpc_doc": "",
   "rpc_version": "0.1",
 
-  "rpc_request": { "request_name": "VM_State_Set",
+  "rpc_request": { "request_name": "VM.State.Set",
                    "request_doc": "",
                    "request_handler": "vmstate_set_handler",
                    "request_params": [ { "param_name": "field",

diff --git a/xenvm/proto/xenvm_notify.json b/xenvm/proto/xenvm_notify.json
index 5128572c400bcf34e15ff759aa4754962c64e9a1..bf759fc1400738f114b80b9d90c1c3567c68183c 100644 (file)
--- a/xenvm/proto/xenvm_notify.json
+++ b/xenvm/proto/xenvm_notify.json
@@ -10,7 +10,7 @@
   "rpc_doc": "",
   "rpc_version": "0.1",
 
-  "rpc_request": { "request_name": "Proto_Hup",
+  "rpc_request": { "request_name": "Proto.Hup",
                    "request_doc": "This is the last message sent on the connection before a clean exit.",
                    "request_handler": "hup_handler",
                    "request_params": []
@@ -22,7 +22,7 @@
   "rpc_doc": "",
   "rpc_version": "0.1",
 
-  "rpc_request": { "request_name": "VM_Status",
+  "rpc_request": { "request_name": "VM.Status",
                    "request_doc": "This is usually sent when the VM changes its state, but is also sent on startup.",
                    "request_handler": "vm_status_handler",
                    "request_params": [ { "param_name": "current_state",
@@ -38,7 +38,7 @@
   "rpc_doc": "",
   "rpc_version": "0.1",
 
-  "rpc_request": { "request_name": "VM_Error",
+  "rpc_request": { "request_name": "VM.Error",
                    "request_doc": "This is sent whenever XenVM experiences any error.",
                    "request_handler": "vm_error_handler",
                    "request_params": [ { "param_name": "error",