xapi: Add new message-destroy-all API call

We've seen issues where a client will try to dismiss all their alerts
and fail due to the message-destroy call hitting the maximum XAPI
request size at ~5000 messages.

A new message-destroy-all API avoids this issue while saving the
bandwidth required to send a ref for each message. Users of the new
API call can choose to dismiss messages that arrived before or after
a certain date, or only those with a given priority.

Signed-off-by: Christian Pardillo Laursen <[email protected]>

Author: cplaursen

ocaml/idl/datamodel.ml

@@ -8915,6 +8915,40 @@ module Message = struct
       ~params:[(Set (Ref _message), "messages", "Messages to destroy")]
       ~allowed_roles:_R_POOL_OP ()
 
+  let destroy_all =
+    call ~name:"destroy_all" ~lifecycle:[]
+      ~versioned_params:
+        [
+          {
+            param_type= DateTime
+          ; param_name= "before"
+          ; param_doc=
+              "Cutoff time for destroyed messages - only destroy messages with \
+               an earlier timestamp. When no timezone is specified UTC is \
+               assumed."
+          ; param_release= numbered_release "25.39.0-next"
+          ; param_default= Some (VDateTime (Date.of_ptime Ptime.max))
+          }
+        ; {
+            param_type= DateTime
+          ; param_name= "after"
+          ; param_doc=
+              "Cutoff time for destroyed messages - only destroy messages with \
+               a later timestamp. When no timezone is specified UTC is \
+               assumed."
+          ; param_release= numbered_release "25.39.0-next"
+          ; param_default= Some (VDateTime Date.epoch)
+          }
+        ; {
+            param_type= Int
+          ; param_name= "priority"
+          ; param_doc= "Priority of messages to be destroyed"
+          ; param_release= numbered_release "25.39.0-next"
+          ; param_default= Some (VInt (-1L))
+          }
+        ]
+      ~allowed_roles:_R_POOL_OP ()
+
   let get_all =
     call ~name:"get_all"
       ~lifecycle:[(Published, rel_orlando, "")]
@@ -9002,6 +9036,7 @@ module Message = struct
           create
         ; destroy
         ; destroy_many
+        ; destroy_all
         ; get
         ; get_all
         ; get_since

ocaml/idl/datamodel_lifecycle.ml

@@ -223,6 +223,8 @@ let prototyped_of_message = function
       Some "24.14.0"
   | "PCI", "disable_dom0_access" ->
       Some "24.14.0"
+  | "message", "destroy_all" ->
+      Some "25.39.0-next"
   | "message", "destroy_many" ->
       Some "22.19.0"
   | "VTPM", "set_contents" ->

ocaml/xapi-cli-server/cli_frontend.ml

@@ -128,6 +128,15 @@ let rec cmdtable_data : (string * cmd_spec) list =
       ; flags= []
       }
     )
+  ; ( "message-destroy-all"
+    , {
+        reqd= []
+      ; optn= ["before"; "after"; "priority"]
+      ; help= "Destroy all existing messages matching the given conditions."
+      ; implementation= No_fd Cli_operations.message_destroy_all
+      ; flags= []
+      }
+    )
   ; ( "pool-enable-binary-storage"
     , {
         reqd= []

ocaml/xapi-cli-server/cli_operations.ml

@@ -1424,6 +1424,28 @@ let message_destroy (_ : printer) rpc session_id params =
   in
   Client.Message.destroy_many ~rpc ~session_id ~messages
 
+let message_destroy_all (_ : printer) rpc session_id params =
+  let fail msg = raise (Cli_util.Cli_failure msg) in
+  let before_str = List.assoc_opt "before" params in
+  let after_str = List.assoc_opt "after" params in
+  let priority_str = List.assoc_opt "priority" params in
+  let before =
+    try
+      Option.map Date.of_iso8601 before_str
+      |> Option.value ~default:(Date.of_ptime Ptime.max)
+      (* Default value is Ptime.max - everything is before it *)
+    with _ -> fail "invalid timestamp format for 'before' (expected RFC3339)"
+  in
+  let after =
+    try Option.map Date.of_iso8601 after_str |> Option.value ~default:Date.epoch
+    with _ -> fail "Invalid timestamp format for 'after' (expected RFC3339)"
+  in
+  let priority =
+    try Option.map Int64.of_string priority_str |> Option.value ~default:(-1L)
+    with _ -> fail "Invalid priority format (expected integer)"
+  in
+  Client.Message.destroy_all ~rpc ~session_id ~before ~after ~priority
+
 (* Pool operations *)
 
 let get_pool_with_default rpc session_id params key =

ocaml/xapi/xapi_message.ml

@@ -730,6 +730,24 @@ let get_record ~__context ~self =
 
 let get_all_records ~__context = get_real message_dir (fun _ -> true) 0.0
 
+let destroy_all ~__context ~before ~after ~priority =
+  let filter_timestamp ts =
+    Date.is_earlier ts ~than:before && Date.is_later ts ~than:after
+  in
+  let priority_filter =
+    (* Default priority is -1, which stands for any priority *)
+    if priority = -1L then fun _ -> true else fun p -> p = priority
+  in
+  let message_filter msg =
+    filter_timestamp msg.API.message_timestamp
+    && priority_filter msg.API.message_priority
+  in
+  let messages =
+    get_real_inner message_dir message_filter (fun _ -> true)
+    |> List.map (fun (_, msg, _) -> msg)
+  in
+  destroy_many ~__context ~messages
+
 let get_all_records_where ~__context ~expr =
   let open Xapi_database in
   let expr = Db_filter.expr_of_string expr in