CA-352073: Ensure all serialized calls can pass rbac checks

[psafont]

Explicitly define a list of tuples with names and values so the rbac checks can never fail at runtime on differing lengths for these. Instead now the check happens at build time, by list construction.

Calls with defaults allowed the values list to be shorter as they never bothered to contain the default values. Now the default values are collected to match all the names of the parameters.

To help with this, I've removed some custom functions with default ones, and changed how lists are generated to stop using cons, as it doesn't lend itself to determine a particular number of elements in a list.

• Ring3 BST + BVT internal test run: 175912 (all tests green except one because of an unrelated testing issue)

To give an idea on how these changes impact the code generated here are a couple of examples:

Call without defaults before:

    | "subject.get_record" | "subject_get_record" -> 
        begin match __params with
        | session_id_rpc::self_rpc::[] -> 
            (* has no side-effect; should be handled by DB action *) 
            (* has no asynchronous mode *)
            let session_id = ref_session_of_rpc session_id_rpc in
            let self = ref_subject_of_rpc self_rpc in
            Session_check.check ~intra_pool_only:false ~session_id;
            let arg_names = "session_id"::"self"::[] in
            let key_names = [] in
            let rbac __context fn = Rbac.check session_id __call ~args:(arg_names,__params) ~keys:key_names ~__context ~fn in

after:

    | "subject.get_record" | "subject_get_record" -> 
        begin match __params with
        | [session_id_rpc; self_rpc] -> 
            (* has no side-effect; should be handled by DB action *) 
            (* has no asynchronous mode *)
            let session_id = ref_session_of_rpc session_id_rpc in
            let self = ref_subject_of_rpc self_rpc in
            Session_check.check ~intra_pool_only:false ~session_id;
            let arg_names_values = [("session_id", session_id_rpc); ("self", self_rpc)] in
            let arg_names, arg_values = List.split arg_names_values in
            let key_names = [] in
            let rbac __context fn = Rbac.check session_id __call ~args:(arg_names, arg_values) ~keys:key_names ~__context ~fn in

Call with defaults before:

    | "GPU_group.create" | "GPU_group_create" -> 
        begin match __params with
        | session_id_rpc::default_args -> 
            (* has side-effect (with locks and no automatic DB action) *)
            (* has asynchronous mode *)
            let session_id = ref_session_of_rpc session_id_rpc in
            let name_label = string_of_rpc (try Server_helpers.nth 1 default_args with _ -> Rpc.String "") in
            let name_description = string_of_rpc (try Server_helpers.nth 2 default_args with _ -> Rpc.String "") in
            let other_config = string_to_string_map_of_rpc (try Server_helpers.nth 3 default_args with _ -> Rpc.Dict []) in
            Session_check.check ~intra_pool_only:false ~session_id;
            let arg_names = "session_id"::"name_label"::"name_description"::"other_config"::[] in
            let key_names = [] in
            let rbac __context fn = Rbac.check session_id __call ~args:(arg_names,__params) ~keys:key_names ~__context ~fn in

after:

    | "GPU_group.create" | "GPU_group_create" -> 
        begin match __params with
        | session_id_rpc :: default_args -> 
            (* has side-effect (with locks and no automatic DB action) *)
            (* has asynchronous mode *)
            let name_label_rpc = try List.nth default_args 0 with _ -> Rpc.String "" in
            let name_description_rpc = try List.nth default_args 1 with _ -> Rpc.String "" in
            let other_config_rpc = try List.nth default_args 2 with _ -> Rpc.Dict [] in
            let session_id = ref_session_of_rpc session_id_rpc in
            let name_label = string_of_rpc name_label_rpc in
            let name_description = string_of_rpc name_description_rpc in
            let other_config = string_to_string_map_of_rpc other_config_rpc in
            Session_check.check ~intra_pool_only:false ~session_id;
            let arg_names_values = [("session_id", session_id_rpc); ("name_label", name_label_rpc); ("name_description", name_description_rpc); ("other_config", other_config_rpc)] in
            let arg_names, arg_values = List.split arg_names_values in
            let key_names = [] in
            let rbac __context fn = Rbac.check session_id __call ~args:(arg_names, arg_values) ~keys:key_names ~__context ~fn in

This not only gets rids of the rbac_audit spurious warnings, but the RBAC code spends a copious amount of time at time ensuring that ~args contains 2 lists of the same length, this is because this doesn't happen just once, but pervasively in the code. This is an identified bottleneck when there are many calls happening at the same. While this PR doesn't fix this bottleneck, I've experimented with removing all these check and will open a PR once the code is cleaned up: master...psafont:xen-api:private/paus/rbacuum

[robhoes]

It's quite hard to see what is exactly going on in gen_server.ml, but this looks right to me. Thanks for splitting it up in logical commits, otherwise I'd be totally lost. The changes make the code generator clearer and safer, and server.ml more efficient.

[robhoes]

This now doesn't call my_assoc anymore, but that is just List.assoc with a different exception raised. The exception won't be raised here, so that is fine.

[robhoes]

Brilliant.

[lindig]

Would it be possible to use records rather than lists? Or a map? I assume we don't want to have duplicate keys either.

[psafont]

Which usage do you mean? for arguments it makes sense to use a map. I don't think it makes sense to use records because each call will have different arguments and the code to process them won't be easily generalizable

[lindig]

I was thinking about the list matching and extracting parameters by position. The alternative is to have matches of different lengths and capturing each argument by a named pattern variable.

[psafont]

In the end it comes down to serializarion of xmlrpc calls, if arguments is modeled as a list in the xml, the deserialization to a record will still need to extract the default one by position. So this step is unavoidable, whether is done before this match or within it.

Since changing how the calls are modelled in xml means changing the API, it will mean we will have to accept both, which needs serious time and effort, in part because we're not too familiar with this part of xapi.

[lindig]

Yes. I think you solved the problem nicely. I also like to use the monadic let* for cases like this - you fail, when the structure is unexpected but the regular path is straight. Anyway, fine as is.