# HG changeset patch # User Rob Hoes CA-36381: Suppress grace-license alerts when automatically retrying (each hour) Signed-off-by: Rob Hoes diff -r 5b9ab15de098 ocaml/license/grace_retry.ml --- a/ocaml/license/grace_retry.ml Wed Jan 13 11:36:10 2010 +0000 +++ b/ocaml/license/grace_retry.ml Wed Jan 13 11:37:36 2010 +0000 @@ -13,6 +13,8 @@ *) (** Helper to keep trying to get a "real" license after a "grace" license was checked out. * @group Licensing *) + +open Client (** Schedule a timer to call [Host.apply_edition] again after an hour. Call this * after getting a "grace" license in order to check whether the license server @@ -27,11 +29,22 @@ 3600. (* 5min *) in let schedule = Xapi_periodic_scheduler.OneShot in - let retry_fn () = Server_helpers.exec_with_new_task "grace_retry" - (fun __context -> - Helpers.call_api_functions ~__context - (fun rpc session_id -> Client.Client.Host.apply_edition rpc session_id host edition) - ) + let retry_fn () = + let now = (Unix.gettimeofday ()) in + Server_helpers.exec_with_new_task "grace_retry" + (fun __context -> + Helpers.call_api_functions ~__context (fun rpc session_id -> + Client.Host.apply_edition rpc session_id host edition; + (* Remove any newly generated grace alerts *) + let alerts = Client.Message.get_since rpc session_id (Date.of_float now) in + let check_and_maybe_remove (ref, msg) = + if msg.API.message_name = "GRACE_LICENSE" then + Helpers.call_api_functions ~__context + (fun rpc session_id -> Client.Message.destroy rpc session_id ref) + in + List.iter check_and_maybe_remove alerts + ) + ) in Xapi_periodic_scheduler.add_to_queue "retry after obtaining grace license" schedule period retry_fn diff -r 5b9ab15de098 ocaml/xapi/cli_operations.ml --- a/ocaml/xapi/cli_operations.ml Wed Jan 13 11:36:10 2010 +0000 +++ b/ocaml/xapi/cli_operations.ml Wed Jan 13 11:37:36 2010 +0000 @@ -2544,11 +2544,11 @@ Client.Host.add_to_license_server rpc session_id host "port" port end end; + let now = (Unix.gettimeofday ()) in try Client.Host.apply_edition rpc session_id host edition with | Api_errors.Server_error (name, args) when name = Api_errors.license_checkout_error -> - let now = (Unix.gettimeofday ()) in let alerts = Client.Message.get_since rpc session_id (Date.of_float now) in let print_if_checkout_error (ref, msg) = if msg.API.message_name = "LICENSE_NOT_AVAILABLE" || msg.API.message_name = "LICENSE_SERVER_UNREACHABLE" then