Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

CA-283754: ppxified interfaces, do not discard internal errors #204

Merged
merged 8 commits into from
Feb 22, 2018
20 changes: 12 additions & 8 deletions gpumon/gpumon_interface.ml
Original file line number Diff line number Diff line change
Expand Up @@ -64,6 +64,8 @@ type gpu_errors =
(** Exception raised when gpumon is unable to load the nvml nvidia library *)
| NvmlFailure of string
(** Exception raised by the c bindings to the nvml nvidia library*)
| Internal_error of string
(** Exception raised if an unexpected error is triggered by the library *)
| Gpumon_failure
(** Default exception raised upon daemon failure *)
[@@default Gpumon_failure]
Expand All @@ -72,11 +74,13 @@ type gpu_errors =
exception Gpumon_error of gpu_errors

(** Error handler *)
module GpuErrors = Error.Make(struct
type t = gpu_errors
let t = gpu_errors
end)
let gpu_err = GpuErrors.error
let gpu_err = Error.{
def = gpu_errors;
raiser = (fun e -> raise (Gpumon_error e));
matcher = (function
| Gpumon_error e -> Some e
| e -> Some (Internal_error (Printexc.to_string e)))
}

(** Functor to autogenerate API calls *)
module RPC_API(R : RPC) = struct
Expand Down Expand Up @@ -151,9 +155,9 @@ module RPC_API(R : RPC) = struct
declare "get_vgpu_metadata"
[ "Obtains metadata for all vGPUs running in a domain." ]
( debug_info_p
@-> domid_p
@-> pgpu_address_p
@-> returning nvidia_vgpu_metadata_list_p gpu_err
@-> domid_p
@-> pgpu_address_p
@-> returning nvidia_vgpu_metadata_list_p gpu_err
)

let get_pgpu_vgpu_compatibility =
Expand Down
203 changes: 105 additions & 98 deletions memory/memory_interface.ml
Original file line number Diff line number Diff line change
Expand Up @@ -13,7 +13,7 @@
*)
(**
* @group Memory
*)
*)
open Rpc
open Idl

Expand All @@ -24,57 +24,64 @@ let xml_path = "/var/xapi/memory"

type reservation_id =
string [@@doc [
"The reservation_id is an opaque identifier associated with a block of ";
"memory. It is used to reserve memory for a domain before the domain has ";
"been created.";
]]
[@@deriving rpcty]
"The reservation_id is an opaque identifier associated with a block of ";
"memory. It is used to reserve memory for a domain before the domain has ";
"been created.";
]]
[@@deriving rpcty]

type domain_zero_policy =
| Fixed_size of int64 [@doc ["Never balloon, use the specified fixed size"]]
| Auto_balloon of int64 * int64 [@doc ["Balloon between the two sizes specified"]]
[@@doc ["Domain zero can have a different policy to that used by guest domains."]]
[@@deriving rpcty]
| Fixed_size of int64 [@doc ["Never balloon, use the specified fixed size"]]
| Auto_balloon of int64 * int64 [@doc ["Balloon between the two sizes specified"]]
[@@doc ["Domain zero can have a different policy to that used by guest domains."]]
[@@deriving rpcty]

type errors =
| Cannot_free_this_much_memory of (int64 * int64)
[@doc [
"[Cannot_free_this_much_memory (required, free)] is reported if it is not ";
"possible to free [required] kib. [free] is the amount of memory currently free"]]
| Domains_refused_to_cooperate of (int list)
[@doc [
"[Domains_refused_to_cooperate (domid list)] is reported if a set of domains do ";
"not respond in a timely manner to the request to balloon. The uncooperative ";
"domain ids are returned."]]
| Unknown_reservation of (reservation_id)
[@doc [
"[Unknown_reservation (id)] is reported if a the specified reservation_id is ";
"unknown."
]]
| No_reservation
[@doc [
"[No_reservation] is reported by [query_reservation_of_domain] if the domain ";
"does not have a reservation."
]]
| Invalid_memory_value of (int64)
[@doc [
"[Invalid_memory_value (value)] is reported if a memory value passed is not ";
"valid, e.g. negative."
]]
| Unknown_error
[@doc [
"The default variant for forward compatibility."
]]
| Cannot_free_this_much_memory of (int64 * int64)
[@doc [
"[Cannot_free_this_much_memory (required, free)] is reported if it is not ";
"possible to free [required] kib. [free] is the amount of memory currently free"]]
| Domains_refused_to_cooperate of (int list)
[@doc [
"[Domains_refused_to_cooperate (domid list)] is reported if a set of domains do ";
"not respond in a timely manner to the request to balloon. The uncooperative ";
"domain ids are returned."]]
| Unknown_reservation of (reservation_id)
[@doc [
"[Unknown_reservation (id)] is reported if a the specified reservation_id is ";
"unknown."
]]
| No_reservation
[@doc [
"[No_reservation] is reported by [query_reservation_of_domain] if the domain ";
"does not have a reservation."
]]
| Invalid_memory_value of (int64)
[@doc [
"[Invalid_memory_value (value)] is reported if a memory value passed is not ";
"valid, e.g. negative."
]]
| Internal_error of (string)
[@doc [
"[Internal_error (value)] is reported if an unexpected error is triggered ";
"by the library."
]]
| Unknown_error
[@doc [
"The default variant for forward compatibility."
]]
[@@default Unknown_error]
[@@deriving rpcty]

exception MemoryError of errors

let err = Error.{
def = errors;
raiser = (function | e -> raise (MemoryError e));
matcher = function | MemoryError e -> Some e | _ -> None
}
def = errors;
raiser = (fun e -> raise (MemoryError e));
matcher = (function
| MemoryError e -> Some e
| e -> Some (Internal_error (Printexc.to_string e)))
}

type debug_info = string
[@@doc ["An uninterpreted string associated with the operation."]]
Expand Down Expand Up @@ -108,118 +115,118 @@ module API(R : RPC) = struct
(* General parameters, used by more than one API call *)

let debug_info_p = Param.mk ~description:[
"An uninterpreted string to associate with the operation."
"An uninterpreted string to associate with the operation."
] Types.string

let diagnostics_result_p = Param.mk ~description:[
"A string containing diagnostic information from the server."
"A string containing diagnostic information from the server."
] Types.string

let service_name_p = Param.mk ~description:[
"The name of the service attempting to interact with the squeeze daemon."
"The name of the service attempting to interact with the squeeze daemon."
] Types.string

let session_id_p = Param.mk ~description:[
"An identifier to associate requests with a client. This is ";
"obtained by a call to [login]."]
Types.string
"An identifier to associate requests with a client. This is ";
"obtained by a call to [login]."]
Types.string

let domid_p = Param.mk ~description:[
"Domain id of a VM."
"Domain id of a VM."
] Types.int

let reservation_id_p = Param.mk ~description:[
"The reservation_id is the token used to identify a memory allocation."
"The reservation_id is the token used to identify a memory allocation."
] reservation_id

let size_p = Param.mk ~description:[
"The size in bytes to reserve"]
Types.int64
"The size in bytes to reserve"]
Types.int64

let unit_p = Param.mk Types.unit

(* Individual API calls *)

let get_diagnostics = declare
"get_diagnostics"
["Gets diagnostic information from the server"]
(debug_info_p @-> returning diagnostics_result_p err)
"get_diagnostics"
["Gets diagnostic information from the server"]
(debug_info_p @-> returning diagnostics_result_p err)

let login = declare
"login"
["Logs into the squeeze daemon. Any reservations previously made with the ";
"specified service name not yet associated with a domain will be removed."]
(debug_info_p @-> service_name_p @-> returning session_id_p err)
"login"
["Logs into the squeeze daemon. Any reservations previously made with the ";
"specified service name not yet associated with a domain will be removed."]
(debug_info_p @-> service_name_p @-> returning session_id_p err)


let reserve_memory = declare
"reserve_memory"
["[reserve_memory dbg session size] reserves memory for a domain. If necessary, ";
"other domains will be ballooned down to ensure [size] is available. The call ";
"returns a reservation_id that can later be transferred to a domain."]
(debug_info_p @-> session_id_p @-> size_p @-> returning reservation_id_p err)
"reserve_memory"
["[reserve_memory dbg session size] reserves memory for a domain. If necessary, ";
"other domains will be ballooned down to ensure [size] is available. The call ";
"returns a reservation_id that can later be transferred to a domain."]
(debug_info_p @-> session_id_p @-> size_p @-> returning reservation_id_p err)

let reserve_memory_range =
let result = Param.mk
~description:[
"A tuple containing the reservation_id and the amount of memory actually reserved."
]
reserve_memory_range_result
~description:[
"A tuple containing the reservation_id and the amount of memory actually reserved."
]
reserve_memory_range_result
in
declare
"reserve_memory_range"
["[reserve_memory_range dbg session min max] reserves memory for a domain. If necessary, ";
"other domains will be ballooned down to ensure enough memory is available. The amount ";
"of memory will be between [min] and [max] according to the policy in operation. The call ";
"returns a reservation_id and the actual memory amount that can later be transferred to a domain."]
(debug_info_p @-> session_id_p @-> size_p @-> size_p @-> returning result err)
["[reserve_memory_range dbg session min max] reserves memory for a domain. If necessary, ";
"other domains will be ballooned down to ensure enough memory is available. The amount ";
"of memory will be between [min] and [max] according to the policy in operation. The call ";
"returns a reservation_id and the actual memory amount that can later be transferred to a domain."]
(debug_info_p @-> session_id_p @-> size_p @-> size_p @-> returning result err)


let delete_reservation =
declare
"delete_reservation"
["Deletes a reservation. Note that memory rebalancing is not done synchronously after the ";
"operation has completed."]
(debug_info_p @-> session_id_p @-> reservation_id_p @-> returning unit_p err)
"delete_reservation"
["Deletes a reservation. Note that memory rebalancing is not done synchronously after the ";
"operation has completed."]
(debug_info_p @-> session_id_p @-> reservation_id_p @-> returning unit_p err)

let transfer_reservation_to_domain =
declare
"transfer_reservation_to_domain"
["Transfers a reservation to a domain. This is called when the domain has been created for ";
"the VM for which the reservation was initially made."]
(debug_info_p @-> session_id_p @-> reservation_id_p @-> domid_p @-> returning unit_p err)
"transfer_reservation_to_domain"
["Transfers a reservation to a domain. This is called when the domain has been created for ";
"the VM for which the reservation was initially made."]
(debug_info_p @-> session_id_p @-> reservation_id_p @-> domid_p @-> returning unit_p err)

let query_reservation_of_domain =
declare
"query_reservation_of_domain"
["Queries the reservation_id associated with a domain"]
(debug_info_p @-> session_id_p @-> domid_p @-> returning reservation_id_p err)
"query_reservation_of_domain"
["Queries the reservation_id associated with a domain"]
(debug_info_p @-> session_id_p @-> domid_p @-> returning reservation_id_p err)

let balance_memory =
declare
"balance_memory"
["Forces a rebalance of the hosts memory. Blocks until the system is in a stable ";
"state."]
(debug_info_p @-> returning unit_p err)
"balance_memory"
["Forces a rebalance of the hosts memory. Blocks until the system is in a stable ";
"state."]
(debug_info_p @-> returning unit_p err)

let get_host_reserved_memory =
declare
"get_host_reserved_memory"
["Gets the amount of reserved memory in a host. This is the lower limit of memory that ";
"squeezed will ensure remains unused by any domain or reservation."]
(debug_info_p @-> returning size_p err)
"get_host_reserved_memory"
["Gets the amount of reserved memory in a host. This is the lower limit of memory that ";
"squeezed will ensure remains unused by any domain or reservation."]
(debug_info_p @-> returning size_p err)

let get_host_initial_free_memory =
declare
"get_host_initial_free_memory"
["Gets the amount of initial free memory in a host"]
(debug_info_p @-> returning size_p err)
"get_host_initial_free_memory"
["Gets the amount of initial free memory in a host"]
(debug_info_p @-> returning size_p err)

let get_domain_zero_policy =
let result_p = Param.mk ~description:["The policy associated with domain 0"] domain_zero_policy in
declare
"get_domain_zero_policy"
["Gets the ballooning policy for domain zero."]
(debug_info_p @-> returning result_p err)
"get_domain_zero_policy"
["Gets the ballooning policy for domain zero."]
(debug_info_p @-> returning result_p err)

end
9 changes: 5 additions & 4 deletions v6/v6_interface.ml
Original file line number Diff line number Diff line change
Expand Up @@ -82,6 +82,8 @@ type errors =
(** Thrown if connection port or address parameter not supplied to check_license *)
| V6d_failure
(** Daemon failed to enable features *)
| Internal_error of string
(** Exception raised if an unexpected error is triggered by the library *)
[@@default V6d_failure]
[@@deriving rpcty]

Expand All @@ -92,11 +94,10 @@ exception V6_error of errors
(** handle exception generation and raising *)
let err = Error.{
def = errors;
raiser = (function
| e -> raise (V6_error e));
raiser = (fun e -> raise (V6_error e));
matcher = (function
| V6_error e -> Some e
| _ -> None)
| V6_error e -> Some e
| e -> Some (Internal_error (Printexc.to_string e)))
}


Expand Down