Merge pull request #4903 from psafont/private/paus/old-vdi

ocaml/idl/datamodel.ml

@@ -459,16 +459,16 @@ end
 let iobandwidth =
   let msg = "Disabled and replaced by RRDs" in
   [
-    field ~persist:false ~qualifier:DynamicRO ~ty:Float "read_kbs"
-      "Read bandwidth (KiB/s)"
+    field ~persist:false ~qualifier:DynamicRO ~ty:Float
+      ~default_value:(Some (VFloat 0.)) "read_kbs" "Read bandwidth (KiB/s)"
       ~lifecycle:
         [
           (Published, rel_rio, "")
         ; (Deprecated, rel_tampa, "Dummy transition")
         ; (Removed, rel_tampa, msg)
         ]
-  ; field ~persist:false ~qualifier:DynamicRO ~ty:Float "write_kbs"
-      "Write bandwidth (KiB/s)"
+  ; field ~persist:false ~qualifier:DynamicRO ~ty:Float
+      ~default_value:(Some (VFloat 0.)) "write_kbs" "Write bandwidth (KiB/s)"
       ~lifecycle:
         [
           (Published, rel_rio, "")
@@ -922,7 +922,7 @@ module Host_metrics = struct
     [
       field ~qualifier:DynamicRO "total" "Total host memory (bytes)"
         ~doc_tags:[Memory]
-    ; field "free" "Free host memory (bytes)"
+    ; field "free" "Free host memory (bytes)" ~default_value:(Some (VInt 0L))
         ~lifecycle:
           [
             (Published, rel_rio, "")
@@ -2670,6 +2670,7 @@ module VIF = struct
         @ [namespace ~name:"qos" ~contents:(qos "VIF") ()]
         @ [
             field ~qualifier:DynamicRO ~ty:(Ref _vif_metrics)
+              ~default_value:(Some (VRef null_ref))
               ~lifecycle:
                 [
                   (Published, rel_rio, "")
@@ -4697,6 +4698,7 @@ module VBD = struct
         @ [namespace ~name:"qos" ~contents:(qos "VBD") ()]
         @ [
             field ~qualifier:DynamicRO ~ty:(Ref _vbd_metrics)
+              ~default_value:(Some (VRef null_ref))
               ~lifecycle:
                 [
                   (Published, rel_rio, "")
@@ -4731,6 +4733,7 @@ module VBD_metrics = struct
           uid _vbd_metrics
         ; namespace ~name:"io" ~contents:iobandwidth ()
         ; field ~qualifier:DynamicRO ~ty:DateTime
+            ~default_value:(Some (VDateTime Date.never))
             ~lifecycle:
               [
                 (Published, rel_rio, "")
@@ -5064,6 +5067,7 @@ module VM_metrics = struct
         ~ty:(Map (Int, Float))
         ~persist:false "utilisation"
         "Utilisation for all of guest's current VCPUs"
+        ~default_value:(Some (VMap []))
         ~lifecycle:
           [
             (Published, rel_rio, "")
@@ -5175,6 +5179,7 @@ module VM_guest_metrics = struct
             "Logically equivalent to PV_drivers_detected"
         ; field ~qualifier:DynamicRO
             ~ty:(Map (String, String))
+            ~default_value:(Some (VMap []))
             ~lifecycle:
               [
                 (Published, rel_rio, "free/used/total")
@@ -5189,6 +5194,7 @@ module VM_guest_metrics = struct
              memory_internal_free RRD data-sources instead."
         ; field ~qualifier:DynamicRO
             ~ty:(Map (String, String))
+            ~default_value:(Some (VMap []))
             ~lifecycle:
               [
                 (Published, rel_rio, "Disk configuration/free space")

ocaml/idl/datamodel_common.ml

@@ -10,7 +10,7 @@ open Datamodel_roles
               to leave a gap for potential hotfixes needing to increment the schema version.*)
 let schema_major_vsn = 5
 
-let schema_minor_vsn = 759
+let schema_minor_vsn = 760
 
 (* Historical schema versions just in case this is useful later *)
 let rio_schema_major_vsn = 5

ocaml/idl/datamodel_schema.ml

@@ -20,9 +20,6 @@ let of_datamodel () =
     match fs with
     | [] ->
         acc
-    | Datamodel_types.(Field {lifecycle= {state; _}; _}) :: fs
-      when state = Removed_s ->
-        flatten_fields fs acc
     | Datamodel_types.Field f :: fs ->
         flatten_fields fs (f :: acc)
     | Datamodel_types.Namespace (_, internal_fs) :: fs ->

ocaml/idl/datamodel_utils.ml

@@ -152,7 +152,7 @@ module Relations = struct
 end
 
 (** Compute a flat list of fields from a datamodel object *)
-let all_fields_of_obj (x : obj) : field list =
+let fields_of_obj (x : obj) : field list =
   let rec of_contents = function
     | Namespace (_, xs) ->
         List.concat (List.map of_contents xs)
@@ -161,26 +161,14 @@ let all_fields_of_obj (x : obj) : field list =
   in
   List.concat (List.map of_contents x.contents)
 
-(* Like [fields_of_obj], but without Removed fields*)
-let active_fields_of_obj x =
-  let rec of_contents = function
-    | Namespace (_, xs) ->
-        List.concat (List.map of_contents xs)
-    | Field x when x.lifecycle.state <> Removed_s ->
-        [x]
-    | _ ->
-        []
-  in
-  List.concat (List.map of_contents x.contents)
-
 (* True if an object has a label (and therefore should have a get_by_name_label message *)
 let obj_has_get_by_name_label x =
-  let all_fields = all_fields_of_obj x in
+  let all_fields = fields_of_obj x in
   List.filter (fun fld -> fld.full_name = ["name"; "label"]) all_fields <> []
 
 (* True if an object has tags (and therefore should have a get_tags message *)
 let obj_has_get_tags x =
-  let all_fields = all_fields_of_obj x in
+  let all_fields = fields_of_obj x in
   List.filter (fun fld -> fld.full_name = ["tags"]) all_fields <> []
 
 (** XXX: unfortunately we don't mark which parameters of a message refer to the self;
@@ -198,7 +186,7 @@ let find_self_parameter (msg : message) =
         )
 
 let plural name =
-  if String.ends_with ~suffix:"metrics" name then
+  if Xstringext.String.endswith "metrics" name then
     name ^ " instances"
   else
     name ^ "s"
@@ -493,7 +481,7 @@ let all_new_messages_of_field obj fld =
     implicit ones.
     NB this list requires filtering before being used for (eg) a client *)
 let messages_of_obj (x : obj) document_order : message list =
-  let all_fields = all_fields_of_obj x in
+  let all_fields = fields_of_obj x in
   let self = self_of_obj x in
 
   (* Generate appropriate get/set/add/remove messages for each field.

ocaml/idl/json_backend/gen_json.ml

@@ -240,7 +240,7 @@ end = struct
             let ctor_fields =
               List.filter
                 (function {qualifier= StaticRO | RW; _} -> true | _ -> false)
-                (all_fields_of_obj obj)
+                (fields_of_obj obj)
               |> List.map (fun f ->
                      String.concat "_" f.full_name
                      ^ if f.default_value = None then "*" else ""

ocaml/idl/markdown_backend.ml

@@ -284,7 +284,7 @@ let print_field_table_of_obj printer ~is_class_deprecated ~is_class_removed x =
         )
     in
     x
-    |> Datamodel_utils.all_fields_of_obj
+    |> Datamodel_utils.fields_of_obj
     |> List.sort (fun x y ->
            compare_case_ins
              (Datamodel_utils.wire_name_of_field x)

ocaml/idl/ocaml_backend/gen_api.ml

@@ -120,8 +120,7 @@ let gen_record_type ~with_module highapi tys =
     | DT.Record record :: t ->
         let obj_name = OU.ocaml_of_record_name record in
         let all_fields =
-          DU.active_fields_of_obj
-            (Dm_api.get_obj_by_name highapi ~objname:record)
+          DU.fields_of_obj (Dm_api.get_obj_by_name highapi ~objname:record)
         in
         let field fld =
           OU.ocaml_of_record_field (obj_name :: fld.DT.full_name)
@@ -297,8 +296,7 @@ let toposort_types highapi types =
           true
       | DT.Record record ->
           let all_fields =
-            DU.active_fields_of_obj
-              (Dm_api.get_obj_by_name highapi ~objname:record)
+            DU.fields_of_obj (Dm_api.get_obj_by_name highapi ~objname:record)
           in
           List.exists (fun fld -> references name fld.DT.ty) all_fields
       | DT.Option ty ->

ocaml/idl/ocaml_backend/gen_client.ml

@@ -89,7 +89,7 @@ let client_api ~sync api =
 let ctor_fields (obj : obj) =
   List.filter
     (function {DT.qualifier= DT.StaticRO | DT.RW; _} -> true | _ -> false)
-    (DU.active_fields_of_obj obj)
+    (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)

ocaml/idl/ocaml_backend/gen_db_actions.ml

@@ -177,7 +177,7 @@ let args_of_message (obj : obj) ({msg_tag= tag; _} as msg) =
           if x <> obj.DT.name then failwith "args_of_message" ;
           (* Client constructor takes all object fields regardless of qualifier
              	       but excluding Set(Ref _) types *)
-          let fields = DU.active_fields_of_obj obj in
+          let fields = DU.fields_of_obj obj in
           let fields = List.filter field_in_this_table fields in
           List.map Client.param_of_field fields
       | _ ->
@@ -324,9 +324,7 @@ let db_action api : O.Module.t =
     String.concat "\n" mk_rec
   in
   let get_record_aux_fn (obj : obj) =
-    let record_fields =
-      List.filter client_side_field (DU.active_fields_of_obj obj)
-    in
+    let record_fields = List.filter client_side_field (DU.fields_of_obj obj) in
     O.Let.make ~name:"get_record'"
       ~params:
         [
@@ -338,7 +336,7 @@ let db_action api : O.Module.t =
       ()
   in
   let get_record_internal_aux_fn (obj : obj) =
-    let record_fields = DU.active_fields_of_obj obj in
+    let record_fields = DU.fields_of_obj obj in
     O.Let.make ~name:"get_record_internal'"
       ~params:
         [
@@ -449,9 +447,8 @@ let db_action api : O.Module.t =
             (Escaping.escape_obj obj.DT.name)
             Client._self
       | FromObject Make ->
-          let fields =
-            List.filter field_in_this_table (DU.active_fields_of_obj obj)
-          in
+          let fields = List.filter field_in_this_table (DU.fields_of_obj obj) in
+          (*	  let fields = db_fields_of_obj obj in *)
           let kvs =
             List.map
               (fun fld ->

ocaml/idl/ocaml_backend/gen_db_check.ml

@@ -19,6 +19,7 @@ module OU = Ocaml_utils
 module Client = Gen_client
 module DT = Datamodel_types
 module DU = Datamodel_utils
+module DM = Datamodel
 open DT
 
 (* Names of the modules we're going to use to perform the db operations *)
@@ -65,9 +66,7 @@ let db_check api : O.Module.t =
   let check_refs (obj : obj) =
     (* List all the fields of the object which are references AND stored in
        this table *)
-    let fields =
-      List.filter field_in_this_table (DU.active_fields_of_obj obj)
-    in
+    let fields = List.filter field_in_this_table (DU.fields_of_obj obj) in
     let fields =
       List.filter (function {DT.ty= Ref _; _} -> true | _ -> false) fields
     in

ocaml/idl/ocaml_backend/gen_test.ml

@@ -55,7 +55,7 @@ let rec gen_test_type highapi ty =
 and gen_record_type highapi record =
   let obj_name = OU.ocaml_of_record_name record in
   let all_fields =
-    DU.active_fields_of_obj (Dm_api.get_obj_by_name highapi ~objname:record)
+    DU.fields_of_obj (Dm_api.get_obj_by_name highapi ~objname:record)
   in
   let field fld = OU.ocaml_of_record_field (obj_name :: fld.DT.full_name) in
   let map_fields fn =

ocaml/idl/schematest.ml

@@ -1,7 +1,7 @@
 let hash x = Digest.string x |> Digest.to_hex
 
 (* BEWARE: if this changes, check that schema has been bumped accordingly *)
-let last_known_schema_hash = "24ec58d6f7fb24a2a6c48aa4973521ed"
+let last_known_schema_hash = "021c461d774cbfc67ba65e5616d21f41"
 
 let current_schema_hash : string =
   let open Datamodel_types in

ocaml/sdk-gen/csharp/gen_csharp_binding.ml

@@ -755,8 +755,7 @@ and gen_save_changes_to_field out_chan exposed_class_name fr =
 
 and ctor_call classname =
   let fields =
-    Datamodel_utils.active_fields_of_obj
-      (Dm_api.get_obj_by_name api ~objname:classname)
+    Datamodel_utils.fields_of_obj (Dm_api.get_obj_by_name api ~objname:classname)
   in
   let fields2 =
     List.filter

ocaml/sdk-gen/powershell/common_functions.ml

@@ -199,7 +199,7 @@ and cut_msg_name message_name fn_type =
 
 (* True if an object has a uuid (and therefore should have a get_by_uuid message *)
 and has_uuid x =
-  let all_fields = DU.active_fields_of_obj x in
+  let all_fields = DU.fields_of_obj x in
   List.filter (fun fld -> fld.full_name = ["uuid"]) all_fields <> []
 
 and has_name x = DU.obj_has_get_by_name_label x

ocaml/sdk-gen/powershell/gen_powershell_binding.ml

@@ -497,7 +497,7 @@ and print_params_constructor message obj classname =
     \        #endregion\n"
     (qualified_class_name classname)
     ( if is_real_constructor message then
-        gen_fields (DU.active_fields_of_obj obj)
+        gen_fields (DU.fields_of_obj obj)
     else
       gen_constructor_params message.msg_params
     )
@@ -589,7 +589,7 @@ and gen_make_record obj classname =
     \                Record = new %s(HashTable);\n\
     \            }\n"
     (qualified_class_name classname)
-    (gen_record_fields (DU.active_fields_of_obj obj))
+    (gen_record_fields (DU.fields_of_obj obj))
     (qualified_class_name classname)
 
 and gen_record_fields fields =
@@ -642,8 +642,8 @@ and gen_make_fields message obj =
     \            else if (HashTable != null)\n\
     \            {%s\n\
     \            }"
-    (explode_record_fields message (DU.active_fields_of_obj obj))
-    (explode_hashtable_fields message (DU.active_fields_of_obj obj))
+    (explode_record_fields message (DU.fields_of_obj obj))
+    (explode_hashtable_fields message (DU.fields_of_obj obj))
 
 and explode_record_fields message fields =
   let print_map tl hd =