diff --git a/ocaml/xapi-idl/rrd/rrd_interface.ml b/ocaml/xapi-idl/rrd/rrd_interface.ml index 646d7eae9e5..4c3ebd4aebe 100644 --- a/ocaml/xapi-idl/rrd/rrd_interface.ml +++ b/ocaml/xapi-idl/rrd/rrd_interface.ml @@ -90,6 +90,8 @@ type rrd_errors = | Invalid_protocol of string (** Thrown by protocol_of_string if string does not match plugin protocol *) | Rrdd_internal_error of string (** Internal Rrdd error *) + | Datasource_missing of string + (** The requested datasource is not present in the host *) [@@deriving rpcty] exception Rrdd_error of rrd_errors diff --git a/ocaml/xcp-rrdd/bin/rrdd/rrdd_server.ml b/ocaml/xcp-rrdd/bin/rrdd/rrdd_server.ml index 8d76fa24bb5..2bd4c2a2772 100644 --- a/ocaml/xcp-rrdd/bin/rrdd/rrdd_server.ml +++ b/ocaml/xcp-rrdd/bin/rrdd/rrdd_server.ml @@ -12,9 +12,6 @@ * GNU Lesser General Public License for more details. *) -(* The framework requires type 'context' to be defined. *) -type context = unit - let with_lock = Xapi_stdext_threads.Threadext.Mutex.execute open Rrdd_shared @@ -342,33 +339,46 @@ let send_host_rrd_to_master master_address = | None -> () +let fail_missing name = raise (Rrdd_error (Datasource_missing name)) + (** {add_ds rrdi ds_name} creates a new time series (rrd) in {rrdi} with the name {ds_name}. The operation fails if rrdi does not contain any live datasource with the name {ds_name} *) let add_ds ~rrdi ~ds_name = - let open Ds in - let ds = List.find (fun ds -> ds.ds_name = ds_name) rrdi.dss in + match List.find_opt (fun ds -> ds.Ds.ds_name = ds_name) rrdi.dss with + | None -> + fail_missing ds_name + | Some ds -> + let now = Unix.gettimeofday () in + Rrd.rrd_add_ds rrdi.rrd now + (Rrd.ds_create ds.ds_name ds.ds_type ~mrhb:300.0 Rrd.VT_Unknown) + +let add rrds uuid domid ds_name rrdi = + let rrd = add_ds ~rrdi ~ds_name in + Hashtbl.replace rrds uuid {rrd; dss= rrdi.dss; domid} + +let forget rrds ~uuid ~ds_name rrdi = + Hashtbl.replace rrds uuid {rrdi with rrd= Rrd.rrd_remove_ds rrdi.rrd ds_name} + +let query ds_name rrdi = let now = Unix.gettimeofday () in - Rrd.rrd_add_ds rrdi.rrd now - (Rrd.ds_create ds.ds_name ds.ds_type ~mrhb:300.0 Rrd.VT_Unknown) + Rrd.query_named_ds rrdi.rrd now ds_name Rrd.CF_Average let add_host_ds (ds_name : string) : unit = with_lock mutex (fun () -> - match !host_rrd with - | None -> - () - | Some rrdi -> - let rrd = add_ds ~rrdi ~ds_name in - host_rrd := Some {rrdi with rrd} + let add rrdi = + let rrd = add_ds ~rrdi ~ds_name in + host_rrd := Some {rrdi with rrd} + in + Option.iter add !host_rrd ) let forget_host_ds (ds_name : string) : unit = with_lock mutex (fun () -> - match !host_rrd with - | None -> - () - | Some rrdi -> - host_rrd := Some {rrdi with rrd= Rrd.rrd_remove_ds rrdi.rrd ds_name} + let forget rrdi = + host_rrd := Some {rrdi with rrd= Rrd.rrd_remove_ds rrdi.rrd ds_name} + in + Option.iter forget !host_rrd ) let query_possible_dss rrdi = @@ -434,17 +444,16 @@ let query_possible_dss rrdi = let query_possible_host_dss () : Data_source.t list = with_lock mutex (fun () -> - match !host_rrd with None -> [] | Some rrdi -> query_possible_dss rrdi + Option.fold ~some:query_possible_dss ~none:[] !host_rrd ) let query_host_ds (ds_name : string) : float = - let now = Unix.gettimeofday () in with_lock mutex (fun () -> match !host_rrd with | None -> - failwith "No data source!" + fail_missing "No host datasource!" | Some rrdi -> - Rrd.query_named_ds rrdi.rrd now ds_name Rrd.CF_Average + query ds_name rrdi ) (** {add_vm_ds vm_uuid domid ds_name} enables collection of the data produced by @@ -454,30 +463,32 @@ let query_host_ds (ds_name : string) : float = {ds_name}. *) let add_vm_ds (vm_uuid : string) (domid : int) (ds_name : string) : unit = with_lock mutex (fun () -> - let rrdi = Hashtbl.find vm_rrds vm_uuid in - let rrd = add_ds ~rrdi ~ds_name in - Hashtbl.replace vm_rrds vm_uuid {rrd; dss= rrdi.dss; domid} + match Hashtbl.find_opt vm_rrds vm_uuid with + | None -> + fail_missing (Printf.sprintf "VM: %s" vm_uuid) + | Some rrdi -> + add vm_rrds vm_uuid domid ds_name rrdi ) let forget_vm_ds (vm_uuid : string) (ds_name : string) : unit = with_lock mutex (fun () -> - let rrdi = Hashtbl.find vm_rrds vm_uuid in - let rrd = rrdi.rrd in - Hashtbl.replace vm_rrds vm_uuid - {rrdi with rrd= Rrd.rrd_remove_ds rrd ds_name} + Hashtbl.find_opt vm_rrds vm_uuid + |> Option.iter (forget vm_rrds ~uuid:vm_uuid ~ds_name) ) let query_possible_vm_dss (vm_uuid : string) : Data_source.t list = with_lock mutex (fun () -> - let rrdi = Hashtbl.find vm_rrds vm_uuid in - query_possible_dss rrdi + Hashtbl.find_opt vm_rrds vm_uuid + |> Option.fold ~some:query_possible_dss ~none:[] ) let query_vm_ds (vm_uuid : string) (ds_name : string) : float = - let now = Unix.gettimeofday () in with_lock mutex (fun () -> - let rrdi = Hashtbl.find vm_rrds vm_uuid in - Rrd.query_named_ds rrdi.rrd now ds_name Rrd.CF_Average + match Hashtbl.find_opt vm_rrds vm_uuid with + | None -> + fail_missing (Printf.sprintf "VM: %s" vm_uuid) + | Some rrdi -> + query ds_name rrdi ) (** {add_sr_ds sr_uuid domid ds_name} enables collection of the data produced by @@ -487,32 +498,32 @@ let query_vm_ds (vm_uuid : string) (ds_name : string) : float = {ds_name}. *) let add_sr_ds (sr_uuid : string) (ds_name : string) : unit = with_lock mutex (fun () -> - let rrdi = Hashtbl.find sr_rrds sr_uuid in - let rrd = add_ds ~rrdi ~ds_name in - Hashtbl.replace sr_rrds sr_uuid {rrd; dss= rrdi.dss; domid= 0} + match Hashtbl.find_opt sr_rrds sr_uuid with + | None -> + fail_missing (Printf.sprintf "SR: %s" sr_uuid) + | Some rrdi -> + add sr_rrds sr_uuid 0 ds_name rrdi ) let forget_sr_ds (sr_uuid : string) (ds_name : string) : unit = with_lock mutex (fun () -> - let rrdi = Hashtbl.find sr_rrds sr_uuid in - let rrd = rrdi.rrd in - Hashtbl.replace sr_rrds sr_uuid - {rrdi with rrd= Rrd.rrd_remove_ds rrd ds_name} + Hashtbl.find_opt sr_rrds sr_uuid + |> Option.iter (forget sr_rrds ~uuid:sr_uuid ~ds_name) ) let query_possible_sr_dss (sr_uuid : string) : Data_source.t list = with_lock mutex (fun () -> - try - let rrdi = Hashtbl.find sr_rrds sr_uuid in - query_possible_dss rrdi - with Not_found -> [] + Hashtbl.find_opt sr_rrds sr_uuid + |> Option.fold ~some:query_possible_dss ~none:[] ) let query_sr_ds (sr_uuid : string) (ds_name : string) : float = - let now = Unix.gettimeofday () in with_lock mutex (fun () -> - let rrdi = Hashtbl.find sr_rrds sr_uuid in - Rrd.query_named_ds rrdi.rrd now ds_name Rrd.CF_Average + match Hashtbl.find_opt sr_rrds sr_uuid with + | None -> + fail_missing (Printf.sprintf "SR: %s" sr_uuid) + | Some rrdi -> + query ds_name rrdi ) let update_use_min_max (value : bool) : unit = diff --git a/ocaml/xcp-rrdd/bin/rrdd/rrdd_server.mli b/ocaml/xcp-rrdd/bin/rrdd/rrdd_server.mli new file mode 100644 index 00000000000..14313d2fe6c --- /dev/null +++ b/ocaml/xcp-rrdd/bin/rrdd/rrdd_server.mli @@ -0,0 +1,99 @@ +val has_vm_rrd : string -> bool + +val push_rrd_local : string -> int -> unit + +val push_rrd_remote : string -> string -> unit + +val remove_rrd : string -> unit + +val migrate_rrd : string option -> string -> string -> string -> unit + +val send_host_rrd_to_master : string -> unit + +val backup_rrds : string option -> unit -> unit + +val archive_rrd : string -> string option -> unit + +val archive_sr_rrd : string -> string + +val push_sr_rrd : string -> string -> unit + +val add_host_ds : string -> unit + +val forget_host_ds : string -> unit + +val query_possible_host_dss : unit -> Data_source.t list + +val query_host_ds : string -> float + +val add_vm_ds : string -> int -> string -> unit + +val forget_vm_ds : string -> string -> unit + +val query_possible_vm_dss : string -> Data_source.t list + +val query_vm_ds : string -> string -> float + +val add_sr_ds : string -> string -> unit + +val forget_sr_ds : string -> string -> unit + +val query_possible_sr_dss : string -> Data_source.t list + +val query_sr_ds : string -> string -> float + +val update_use_min_max : bool -> unit + +val update_vm_memory_target : int -> int64 -> unit + +val set_cache_sr : string -> unit + +val unset_cache_sr : unit -> unit + +module Plugin : sig + val base_path : string + + val get_header : unit -> string + + val get_path : string -> string + + val register : string -> Rrd.sampling_frequency -> float + + val deregister : string -> unit + + val next_reading : string -> float + + val read_stats : unit -> (Rrd.ds_owner * Ds.ds) list + + module Local : sig + val register : + string -> Rrd.sampling_frequency -> Rrd_interface.plugin_protocol -> float + + val deregister : string -> unit + + val next_reading : string -> float + end + + module Interdomain : sig + val register : + Rrd_interface.interdomain_uid + -> Rrd_interface.interdomain_info + -> Rrd_interface.plugin_protocol + -> float + + val deregister : Rrd_interface.interdomain_uid -> unit + + val next_reading : Rrd_interface.interdomain_uid -> float + end +end + +module HA : sig + val enable_and_update : + Rrd_interface.statefile_latency list -> float -> float -> unit + + val disable : unit -> unit +end + +module Deprecated : sig + val load_rrd : string -> int -> string option -> unit +end diff --git a/quality-gate.sh b/quality-gate.sh index 0e4377eaf3a..1fcb1d2e88d 100755 --- a/quality-gate.sh +++ b/quality-gate.sh @@ -25,7 +25,7 @@ verify-cert () { } mli-files () { - N=512 + N=511 # do not count ml files from the tests in ocaml/{tests/perftest/quicktest} MLIS=$(git ls-files -- '**/*.mli' | grep -vE "ocaml/tests|ocaml/perftest|ocaml/quicktest" | xargs -I {} sh -c "echo {} | cut -f 1 -d '.'" \;) MLS=$(git ls-files -- '**/*.ml' | grep -vE "ocaml/tests|ocaml/perftest|ocaml/quicktest" | xargs -I {} sh -c "echo {} | cut -f 1 -d '.'" \;)