Skip to content

Commit

Permalink
CA-283754: ppxified interfaces, do not discard internal errors (#204)
Browse files Browse the repository at this point in the history 
* CA-283754: memory_interface, do not discard internal errors

Signed-off-by: Marcello Seri <marcello.seri@citrix.com>

* memory_interface: run ocp-indent

Signed-off-by: Marcello Seri <marcello.seri@citrix.com>

* CA-283754: gpumon_interface, do not discard internal errors

Signed-off-by: Marcello Seri <marcello.seri@citrix.com>

* gpumon_interface: run ocp-indent

Signed-off-by: Marcello Seri <marcello.seri@citrix.com>

* CA-283754: v6_interface, do not discard internal errors

Signed-off-by: Marcello Seri <marcello.seri@citrix.com>
  • Loading branch information
@mseri
mseri authored and Jon Ludlam committed Feb 22, 2018
1 parent 9b44fc9 commit ed14734
Show file tree
Hide file tree
Showing 3 changed files with 122 additions and 110 deletions.
20 changes: 12 additions & 8 deletions gpumon/gpumon_interface.ml
View file
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
View file
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
View file
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

0 comments on commit ed14734

Please sign in to comment.