CA-420987: xapi_message: Add message-destroy-all API

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.

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

Author: cplaursen

ocaml/idl/datamodel.ml

@@ -8915,6 +8915,10 @@ module Message = struct
       ~params:[(Set (Ref _message), "messages", "Messages to destroy")]
       ~allowed_roles:_R_POOL_OP ()
 
+  let destroy_all =
+    call ~name:"destroy_all" ~lifecycle:[] ~params:[] ~allowed_roles:_R_POOL_OP
+      ()
+
   let get_all =
     call ~name:"get_all"
       ~lifecycle:[(Published, rel_orlando, "")]
@@ -9002,6 +9006,7 @@ module Message = struct
           create
         ; destroy
         ; destroy_many
+        ; destroy_all
         ; get
         ; get_all
         ; get_since

ocaml/idl/datamodel_lifecycle.ml

@@ -215,6 +215,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= []
+      ; help= "Destroy all existing messages"
+      ; implementation= No_fd Cli_operations.message_destroy_all
+      ; flags= []
+      }
+    )
   ; ( "pool-enable-binary-storage"
     , {
         reqd= []

ocaml/xapi-cli-server/cli_operations.ml

@@ -1426,6 +1426,9 @@ 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 _ =
+  Client.Message.destroy_all ~rpc ~session_id
+
 (* Pool operations *)
 
 let get_pool_with_default rpc session_id params key =

ocaml/xapi/xapi_message.ml

@@ -728,6 +728,10 @@ let get_record ~__context ~self =
          (Api_errors.handle_invalid, ["message"; Ref.string_of self])
       )
 
+let destroy_all ~__context =
+  let messages = get_all ~__context in
+  destroy_many ~__context ~messages
+
 let get_all_records ~__context = get_real message_dir (fun _ -> true) 0.0
 
 let get_all_records_where ~__context ~expr =