Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Add the concept of versions to rpc-light

Add the line:

let version="<version>"

to your interface definition file, and this will autogenerate
a 'get_version' RPC call to the client and server. This will
_not_ be present in the server functor signature. The idea
is that the client calls this immediately and asserts that
the result is identical to its own binding of 'version'. If
this fails, the client can then try to find the correct server
version on a different URI.

Signed-off-by: Jon Ludlam <jonathan.ludlam@eu.citrix.com>
  • Loading branch information...
commit a0220a0bbc1a5baeb89428e05277cde994a163bf 1 parent e177763
@djs55 djs55 authored
Showing with 50 additions and 14 deletions.
  1. +50 −14 lib/p4_idl.ml
View
64 lib/p4_idl.ml
@@ -49,6 +49,28 @@ struct
return_type y
| t -> t
+ let find_version cur si =
+ match si with
+ | <:str_item< value version = $version$ >> ->
+ let version = match version with
+ | Ast.ExStr (_,version) -> version
+ | _ -> failwith "Cannot parse version"
+ in
+ Some version
+ | _ -> cur
+
+ let add_version_rpc rpcs version =
+ let _loc = Ast.Loc.ghost in
+ match version with
+ | None -> rpcs
+ | Some _ ->
+ Rpc { loc = _loc;
+ namespace = [];
+ fname = "get_version";
+ name = "get_version";
+ args = [ { MyRpc.kind=`Anonymous; ctyp = <:ctyp< unit >>} ];
+ rtype = <:ctyp< string >> }::rpcs
+
(* Find rpcs - any 'external' definitions in the module *)
let rec find_rpcs (cur,namespace) si =
match si with
@@ -225,7 +247,7 @@ struct
(* Make the functor that generates server modules. The generated module will
contain a single function - 'process' - which takes an Rpc.call and
unmarshals the arguments and passes them to the implementation module *)
- let make_server_functor rpcs =
+ let make_server_functor version rpcs =
let gen_match_case rpc =
let _loc = rpc.loc in
let cap_name = String.capitalize rpc.fname in
@@ -245,18 +267,25 @@ struct
rpc.args)
in
- let apply = MyRpc.list_foldi
- (fun accu e i ->
- match e.MyRpc.kind with
- | `Optional s -> <:expr< $accu$ ? $lid:s$ : params.$arg_path$.$lid:s$ >>
- | `Named s -> <:expr< $accu$ ~ $lid:s$ : params.$arg_path$.$lid:s$ >>
- | `Anonymous -> <:expr< $accu$ ($arg_path$.$lid:MyRpc.of_rpc
- (MyRpc.argi (i+1))$ $lid:MyRpc.argi (i+1)$) >>)
- <:expr< $impl_path$.$lid:rpc.fname$ x >>
- rpc.args
+ let inner =
+ let apply = MyRpc.list_foldi
+ (fun accu e i ->
+ match e.MyRpc.kind with
+ | `Optional s -> <:expr< $accu$ ? $lid:s$ : params.$arg_path$.$lid:s$ >>
+ | `Named s -> <:expr< $accu$ ~ $lid:s$ : params.$arg_path$.$lid:s$ >>
+ | `Anonymous -> <:expr< $accu$ ($arg_path$.$lid:MyRpc.of_rpc
+ (MyRpc.argi (i+1))$ $lid:MyRpc.argi (i+1)$) >>)
+ <:expr< $impl_path$.$lid:rpc.fname$ x >>
+ rpc.args
+ in
+ let default = <:expr< $arg_path$.rpc_of_response ($apply$) >> in
+
+ if rpc.fname = "get_version"
+ then match version with Some v -> <:expr< $arg_path$.rpc_of_response ($str:v$) >> | None -> default
+ else default
+
in
- let inner = <:expr< $arg_path$.rpc_of_response ($apply$) >> in
let outer =
if has_names
then <:expr< let params = $arg_path$.request_of_rpc arg in $inner$ >>
@@ -312,13 +341,20 @@ struct
AstFilters.register_str_item_filter begin fun si ->
let _loc = Ast.loc_of_str_item si in
- let (rev_rpcs,_) = List.fold_left find_rpcs ([],[]) (Ast.list_of_str_item si []) in
+ let version = List.fold_left find_version None (Ast.list_of_str_item si []) in
+
+ let (orig_rev_rpcs,_) = List.fold_left find_rpcs ([],[]) (Ast.list_of_str_item si []) in
+
+ let rev_rpcs = add_version_rpc orig_rev_rpcs version in
+
let rev_exns = List.fold_left find_exns [] (Ast.list_of_str_item si []) in
let rev_exns =
("Internal_error",Some <:ctyp< string >>) ::
("Message_param_count_mismatch",Some <:ctyp< (string * int * int) >>) ::
("Unknown_RPC",Some <:ctyp< string >>) :: rev_exns in
let rpcs = List.rev rev_rpcs in
+ let orig_rpcs = List.rev orig_rev_rpcs in
+
let rec flatten_rpcs rpcs =
List.flatten (List.map (function
| Rpc r -> [r]
@@ -387,8 +423,8 @@ struct
make_args rpcs;
rpc_type;
make_client rpcs;
- make_server_sig rpcs;
- make_server_functor flat_rpcs ] $ >>
+ make_server_sig orig_rpcs;
+ make_server_functor version flat_rpcs ] $ >>
end
end
Please sign in to comment.
Something went wrong with that request. Please try again.