CP-52881: add mechanism to filter out event fields

We should also add a similar mechanism to get_all_records.

A better fix might be to change the type of the field to a ref and move it out to a class of its own
and do a DB upgrade.

Signed-off-by: Edwin Török <[email protected]>

ocaml/xapi/xapi_event.ml

@@ -519,6 +519,26 @@ let rec next ~__context =
   else
     rpc_of_events relevant
 
+let omitted = Rpc.Null
+
+let[@tail_mod_cons] rec maybe_map_fields = function
+  | [] ->
+      []
+  | (key, _) :: tl when Xapi_globs.StringSet.mem key !Xapi_globs.event_filter ->
+      (key, omitted) :: (maybe_map_fields [@tailcall]) tl
+  | hd :: tl ->
+      hd :: (maybe_map_fields [@tailcall]) tl
+
+let apply_event_filter = function
+  | Rpc.Dict lst as orig ->
+      let lst' = maybe_map_fields lst in
+      if lst' == lst then
+        orig
+      else
+        Rpc.Dict lst'
+  | rpc ->
+      rpc
+
 let from_inner __context session subs from from_t timer batching =
   let open Xapi_database in
   let open From in
@@ -658,7 +678,10 @@ let from_inner __context session subs from from_t timer batching =
       (fun acc (table, objref, mtime) ->
         let serialiser = Eventgen.find_get_record table in
         try
-          let xml = serialiser ~__context ~self:objref () in
+          let xml =
+            serialiser ~__context ~self:objref ()
+            |> Option.map apply_event_filter
+          in
           let ev = event_of `_mod ?snapshot:xml (table, objref, mtime) in
           if Subscription.event_matches subs ev then ev :: acc else acc
         with _ -> acc
@@ -670,7 +693,10 @@ let from_inner __context session subs from from_t timer batching =
       (fun acc (table, objref, ctime) ->
         let serialiser = Eventgen.find_get_record table in
         try
-          let xml = serialiser ~__context ~self:objref () in
+          let xml =
+            serialiser ~__context ~self:objref ()
+            |> Option.map apply_event_filter
+          in
           let ev = event_of `add ?snapshot:xml (table, objref, ctime) in
           if Subscription.event_matches subs ev then ev :: acc else acc
         with _ -> acc

ocaml/xapi/xapi_globs.ml

@@ -1068,6 +1068,8 @@ let tgroups_enabled = ref false
 let xapi_requests_cgroup =
   "/sys/fs/cgroup/cpu/control.slice/xapi.service/request"
 
+let event_filter = ref (StringSet.of_list [])
+
 (* Event.{from,next} batching delays *)
 let make_batching name ~delay_before ~delay_between =
   let name = Printf.sprintf "%s_delay" name in
@@ -1451,6 +1453,15 @@ let other_options =
     , (fun () -> string_of_bool !Db_globs.idempotent_map)
     , "True if the add_to_<map> API calls should be idempotent"
     )
+  ; ( "event-field-filter"
+    , Arg.String
+        (fun s ->
+          event_filter := String.split_on_char ',' s |> StringSet.of_list
+        )
+    , (fun () -> !event_filter |> StringSet.elements |> String.concat ",")
+    , "Filter out events on these fields. THIS CAN BREAK API CLIENTS IF USED \
+       INCORRECTLY."
+    )
   ; ( "use-event-next"
     , Arg.Set Constants.use_event_next
     , (fun () -> string_of_bool !Constants.use_event_next)