diff --git a/ocaml/idl/datamodel.ml b/ocaml/idl/datamodel.ml index bfe326e435..9e79d35070 100644 --- a/ocaml/idl/datamodel.ml +++ b/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 @@ -9067,21 +9102,21 @@ module Secret = struct param_type= String ; param_name= "uuid" ; param_doc= "" - ; param_release= midnight_ride_release + ; param_release= numbered_release "25.39.0" ; param_default= None } ; { param_type= String ; param_name= "value" ; param_doc= "" - ; param_release= midnight_ride_release + ; param_release= numbered_release "25.39.0" ; param_default= None } ; { param_type= Map (String, String) ; param_name= "other_config" ; param_doc= "" - ; param_release= boston_release + ; param_release= numbered_release "25.39.0" ; param_default= Some (VMap []) } ] diff --git a/ocaml/idl/datamodel_lifecycle.ml b/ocaml/idl/datamodel_lifecycle.ml index ef14813ad9..2eddc3710c 100644 --- a/ocaml/idl/datamodel_lifecycle.ml +++ b/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" -> diff --git a/ocaml/xapi-cli-server/cli_frontend.ml b/ocaml/xapi-cli-server/cli_frontend.ml index 39e0c8ce51..04528f5e93 100644 --- a/ocaml/xapi-cli-server/cli_frontend.ml +++ b/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= [] diff --git a/ocaml/xapi-cli-server/cli_operations.ml b/ocaml/xapi-cli-server/cli_operations.ml index 738f1a0af3..5a2dabc527 100644 --- a/ocaml/xapi-cli-server/cli_operations.ml +++ b/ocaml/xapi-cli-server/cli_operations.ml @@ -550,20 +550,18 @@ let make_param_funs getallrecs getbyuuid record class_name def_filters ) all in - (* Filter on everything on the cmd line except params=... *) let filter_params = - List.filter - (fun (p, _) -> not (List.mem p ("params" :: stdparams))) - params - in - (* Filter out all params beginning with "database:" *) - let filter_params = - List.filter - (fun (p, _) -> not (Astring.String.is_prefix ~affix:"database:" p)) - filter_params + (* Add in the default filters *) + def_filters + @ List.filter + (fun (p, _) -> + (* Filter on everything on the cmd line except params=... *) + (not (List.mem p ("params" :: stdparams))) + (* Filter out all params beginning with "database:" *) + && not (Astring.String.is_prefix ~affix:"database:" p) + ) + params in - (* Add in the default filters *) - let filter_params = def_filters @ filter_params in (* Filter all the records *) let records = List.fold_left filter_records_on_fields all_recs filter_params @@ -573,22 +571,16 @@ let make_param_funs getallrecs getbyuuid record class_name def_filters select_fields params (if print_all then all_recs else records) def_list_params - in - let print_params = - List.map - (fun fields -> List.filter (fun field -> not field.hidden) fields) - print_params - in - let print_params = - List.map - (fun fields -> - List.map - (fun field -> - if field.expensive then makeexpensivefield field else field - ) - fields - ) - print_params + |> List.map (fun fields -> + fields + |> List.filter (fun field -> not field.hidden) + |> List.map (fun field -> + if field.expensive then + makeexpensivefield field + else + field + ) + ) in printer (Cli_printer.PTable (List.map (List.map print_field) print_params)) @@ -1428,6 +1420,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 = diff --git a/ocaml/xapi/xapi_message.ml b/ocaml/xapi/xapi_message.ml index 5eb5b09764..69bbacb28e 100644 --- a/ocaml/xapi/xapi_message.ml +++ b/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