idl/gen_client: Don't specify argument values when they're equal to defaults (#6693)

#6652 added a new parameter
to `Host.disable`. Since the method is used during an RPU, when a new
client calls an older server unaware of the parameter, this broke it.
Add a test reproducing what happens during an RPU and fix the issue in
`client.ml`.

---

Adds an older `server.ml` and `client.ml` from xapi 25.30.0 (with
`server.ml`
modified to compile after the XSA-474 interface changes), before
`Host.disable`
gained the `auto_enable` parameter.

Adds compatibility tests verifying that an older client can talk to a
newer
server and the other way around.

Before the fix, both `test_compatibility_with_old_server_*` fail,
showing that
`auto_enable` in `Host.disable` is an unexpected parameter. This failure
is
triggered on RPUs, when a newer xapi talks to an older one:

[exception] Server_error(MESSAGE_PARAMETER_COUNT_MISMATCH, [
host.disable; 1; 2 ])

So allow `client.ml` to skip specifying an arbitrary number of rightmost
arguments if they're all equal to their default values (since arguments
are
positional, once an argument is not skipped, no arguments to its left
can be
skipped).

Generated code for `host.disable` looks like the following:

```
let session_id = rpc_of_ref_session session_id in
let host = rpc_of_ref_host host in
let auto_enable = rpc_of_bool auto_enable in

let needed_args, _ = List.fold_right2
 (fun param default (acc, skipped)->
   (* Since arguments are positional, we can only skip specifying an
      argument that's equal to its default value if all the arguments to
      its right were also not specified *)
   if skipped then
     (match default with
     | Some default_value when param = default_value -> (acc, true)
     | _ -> (param::acc, false))
   else
     (param :: acc, false)
 ) [ session_id; host; auto_enable ] [ None; None; Some (Rpc.Bool true) ] ([], true)
in

rpc_wrapper rpc "host.disable" needed_args >>= fun x -> return (ignore x)
```

This fixes an issue with `client.ml` always specifying values for new
parameters
that older `server.ml` did not know about (which happens during an RPU).

This makes `test_compatibility_with_old_server_default` pass, so drop
the
`try with` for it. `test_compatibility_with_old_server_non_default`
still fails,
indicating that everything works as intended.

Fixes: cf5be62 ("host.disable: Add auto_enabled parameter for
persistency")

Author: last-genius

ocaml/idl/ocaml_backend/gen_client.ml

@@ -92,27 +92,34 @@ let ctor_fields (obj : obj) =
     (function {DT.qualifier= DT.StaticRO | DT.RW; _} -> true | _ -> false)
     (DU.fields_of_obj obj)
 
-(* Compute a message parameter list from a message suitable for the client (only!) *)
-let args_of_message ?(expand_record = true) (obj : obj)
+(* Compute a list of message parameters and their default values from a
+   message suitable for the client (only!) *)
+let args_of_message_with_default ?(expand_record = true) (obj : obj)
     ({msg_tag= tag; _} as msg) =
   let arg_of_param = function
-    | {param_type= Record x; _} -> (
+    | {param_type= Record x; param_default= default; _} -> (
       match tag with
       | FromObject Make ->
           if x <> obj.DT.name then failwith "args_of_message" ;
           if expand_record then
-            List.map param_of_field (ctor_fields obj)
+            List.map
+              (fun x -> (x, None))
+              (List.map param_of_field (ctor_fields obj))
           else
-            [custom _value (Record x)]
+            [(custom _value (Record x), default)]
       | _ ->
           failwith "arg_of_param: encountered a Record in an unexpected place"
     )
     | p ->
-        [of_param p]
+        [(of_param p, p.param_default)]
   in
-  let session = if msg.msg_session then [session] else [] in
+  let session = if msg.msg_session then [(session, None)] else [] in
   List.concat (session :: List.map arg_of_param msg.msg_params)
 
+(* Compute a message parameter list from a message suitable for the client (only!) *)
+let args_of_message ?(expand_record = true) obj x =
+  List.map fst (args_of_message_with_default ~expand_record obj x)
+
 let gen_module api : O.Module.t =
   (* Generate any additional helper functions for an operation here *)
   let helper_record_constructor ~sync (obj : obj) (x : message) =
@@ -148,7 +155,8 @@ let gen_module api : O.Module.t =
   in
   (* Convert an operation into a Let-binding *)
   let operation ~sync (obj : obj) (x : message) =
-    let args = args_of_message obj x in
+    let args_with_default = args_of_message_with_default obj x in
+    let args = List.map fst args_with_default in
     let to_rpc (arg : O.param) =
       let binding = O.string_of_param arg in
       let converter = O.type_of_param arg in
@@ -172,6 +180,31 @@ let gen_module api : O.Module.t =
       else
         List.map O.string_of_param args
     in
+    let defaults =
+      List.map
+        (fun (_, default_value) ->
+          match default_value with
+          | Some x ->
+              Printf.sprintf "Some (%s)" (Datamodel_values.to_ocaml_string x)
+          | None ->
+              "None"
+        )
+        args_with_default
+    in
+    let rightmost_arg_default =
+      Some true
+      = List.fold_right
+          (fun (_, x) rightmost_arg_default ->
+            match rightmost_arg_default with
+            | None when Option.is_some x ->
+                Some true
+            | Some true ->
+                Some true
+            | _ ->
+                Some false
+          )
+          args_with_default None
+    in
     let task = DT.Ref Datamodel_common._task in
     let from_xmlrpc t =
       match (x.msg_custom_marshaller, t, sync) with
@@ -203,15 +236,41 @@ let gen_module api : O.Module.t =
         (List.map to_rpc args
         @ [
             (if is_ctor then ctor_record else "")
+          ; ( if (not is_ctor) && rightmost_arg_default then
+                (* Skip specifying arguments which are equal to their default
+                   values. This way, when a newer client talks to an older
+                   server that does not know about a new parameter, it can
+                   silently skip sending it, avoiding an error *)
+                Printf.sprintf
+                  {|
+      let needed_args, _ = List.fold_right2
+        (fun param default (acc, skipped)->
+          (* Since arguments are positional, we can only skip specifying an
+             argument that's equal to its default value if all the arguments to
+             its right were also not specified *)
+          if skipped then
+            (match default with
+            | Some default_value when param = default_value -> (acc, true)
+            | _ -> (param::acc, false))
+          else
+            (param :: acc, false)
+        ) [ %s ] [ %s ] ([], true)
+      in
+      |}
+                  (String.concat "; " rpc_args)
+                  (String.concat "; " defaults)
+              else
+                Printf.sprintf "let needed_args = [ %s ] in"
+                  (String.concat "; " rpc_args)
+            )
           ; Printf.sprintf
-              "rpc_wrapper rpc %s [ %s ] >>= fun x -> return (%s x)"
+              "rpc_wrapper rpc %s needed_args >>= fun x -> return (%s x)"
               ( if sync then
                   Printf.sprintf "\"%s\"" wire_name
                 else
                   Printf.sprintf {|(Printf.sprintf "%%s%s" AQ.async_qualifier)|}
                     wire_name
               )
-              (String.concat "; " rpc_args)
               (from_xmlrpc x.msg_result)
           ]
         )
@@ -227,9 +286,6 @@ let gen_module api : O.Module.t =
         obj.messages
     in
     let fields = fields_of (operations @ helpers) in
-    (*
-    let fields = List.map (fun x -> O.Module.Let (operation ~sync obj x)) obj.messages in
-*)
     O.Module.make ~name:(OU.ocaml_of_obj_name obj.DT.name) ~elements:fields ()
   in
   let preamble =

ocaml/idl/ocaml_backend/gen_test.ml

@@ -25,7 +25,7 @@ verify-cert () {
 }
 
 mli-files () {
-  N=462
+  N=461
   X="ocaml/tests"
   X+="|ocaml/quicktest"
   X+="|ocaml/message-switch/core_test"