Signed-off-by: Rok Strnisa <[email protected]>
ocaml/client_records/record_util.ml | 62 +++++++++++++++++++++++------------- ocaml/client_records/records.ml | 20 +++++----- 2 files changed, 49 insertions(+), 33 deletions(-)
# HG changeset patch # User Rok Strnisa <[email protected]> # Date 1282906490 -3600 # Node ID 965373f306cce3d131d46fa18107f37f87d5e510 # Parent 4050049374d594a5bad8cd1c864460b338114a26 Improper internal error on setting wrong values for VBD parameters --- FIXED. Signed-off-by: Rok Strnisa <[email protected]> diff --git a/ocaml/client_records/record_util.ml b/ocaml/client_records/record_util.ml --- a/ocaml/client_records/record_util.ml +++ b/ocaml/client_records/record_util.ml @@ -135,7 +135,7 @@ let vif_operation_to_string = function | `unplug -> "unplug" let cpu_feature_to_string f = - match f with + match f with `FPU -> "FPU" | `VME -> "VME" | `DE -> "DE" @@ -218,9 +218,9 @@ let cpu_feature_list_to_string list = String.concat "," (List.map (fun x -> cpu_feature_to_string x) list) let task_allowed_operations_to_string s = - match s with + match s with `cancel -> "Cancel" - + let alert_level_to_string s = match s with | `Info -> "info" @@ -228,8 +228,8 @@ let alert_level_to_string s = | `Error -> "error" let on_normal_exit_to_string x = - match x with - `destroy -> "Destroy" + match x with + `destroy -> "Destroy" | `restart -> "Restart" let string_to_on_normal_exit s = @@ -238,8 +238,8 @@ let string_to_on_normal_exit s = | "restart" -> `restart | _ -> raise (Record_failure ("Expected 'destroy' or 'restart', got "^s)) -let on_crash_behaviour_to_string x= - match x with +let on_crash_behaviour_to_string x= + match x with `destroy -> "Destroy" | `coredump_and_destroy -> "Core dump and destroy" | `restart -> "Restart" @@ -248,14 +248,15 @@ let on_crash_behaviour_to_string x= | `rename_restart -> "Rename restart" let string_to_on_crash_behaviour s= - match String.lowercase s with - "destroy" -> `destroy - | "coredump_and_destroy" -> `coredump_and_destroy - | "restart" -> `restart - | "coredump_and_restart" -> `coredump_and_restart - | "preserve" -> `preserve - | "rename_restart" -> `rename_restart - | _ -> raise (Record_failure ("Expected 'on_crash_behaviour' type, got "^s)) + match String.lowercase s with + | "destroy" -> `destroy + | "coredump_and_destroy" -> `coredump_and_destroy + | "restart" -> `restart + | "coredump_and_restart" -> `coredump_and_restart + | "preserve" -> `preserve + | "rename_restart" -> `rename_restart + | _ -> raise (Record_failure ("Expected 'destroy', 'coredump_and_destroy'," ^ + "'restart', 'coredump_and_restart', 'preserve' or 'rename_restart', got "^s)) let boot_type_to_string x = match x with @@ -268,7 +269,25 @@ let string_to_boot_type s = "bios" -> `bios | "grub" -> `grub | "kernelexternal" -> `kernelexternal - | _ -> raise (Record_failure ("Expected 'bios','grub' or 'kernelexternal', got "^s)) + | _ -> raise (Record_failure ("Expected 'bios', 'grub' or 'kernelexternal', got "^s)) + +let string_to_vdi_onboot s = + match String.lowercase s with + | "persist" -> `persist + | "reset" -> `reset + | _ -> raise (Record_failure ("Expected 'persist' or 'reset', got "^s)) + +let string_to_vbd_mode s = + match String.lowercase s with + | "ro" -> `RO + | "rw" -> `RW + | _ -> raise (Record_failure ("Expected 'RO' or 'RW', got "^s)) + +let string_to_vbd_type s = + match String.lowercase s with + | "cd" -> `CD + | "disk" -> `Disk + | _ -> raise (Record_failure ("Expected 'CD' or 'Disk', got "^s)) let power_to_string h = match h with @@ -295,7 +314,7 @@ let ip_configuration_mode_to_string = fu | `DHCP -> "DHCP" | `Static -> "Static" -let ip_configuration_mode_of_string m = +let ip_configuration_mode_of_string m = match String.lowercase m with | "dhcp" -> `DHCP | "none" -> `None @@ -330,7 +349,7 @@ let on_boot_to_string onboot = | `persist -> "persist" (** Parse a string which might have a units suffix on the end *) -let bytes_of_string field x = +let bytes_of_string field x = let isdigit c = c >= '0' && c <= '9' in let ( ** ) a b = Int64.mul a b in let max_size_TiB = Int64.div Int64.max_int (1024L ** 1024L ** 1024L ** 1024L) in @@ -349,7 +368,7 @@ let bytes_of_string field x = raise (Record_failure (Printf.sprintf "Failed to parse field '%s': expecting an integer (possibly with suffix)" field)); in match (String.split_f (fun c -> String.isspace c || (isdigit c)) x) with - | [] -> + | [] -> (* no suffix on the end *) int64_of_string x | [ suffix ] -> begin @@ -360,7 +379,7 @@ let bytes_of_string field x = | "bytes" -> 1L | "KiB" -> 1024L | "MiB" -> 1024L ** 1024L - | "GiB" -> 1024L ** 1024L ** 1024L + | "GiB" -> 1024L ** 1024L ** 1024L | "TiB" -> 1024L ** 1024L ** 1024L ** 1024L | x -> raise (Record_failure (Printf.sprintf "Failed to parse field '%s': Unknown suffix: '%s' (try KiB, MiB, GiB or TiB)" field x)) in (* FIXME: detect overflow *) @@ -384,6 +403,3 @@ let mac_from_int_array macs = (* generate a random mac that is locally administered *) let random_mac_local () = mac_from_int_array (Array.init 6 (fun i -> Random.int 0x100)) - - - diff --git a/ocaml/client_records/records.ml b/ocaml/client_records/records.ml --- a/ocaml/client_records/records.ml +++ b/ocaml/client_records/records.ml @@ -1086,9 +1086,9 @@ let vdi_record rpc session_id vdi = make_field ~name:"current-operations" ~get:(fun () -> String.concat "; " (List.map (fun (a,b) -> Record_util.vdi_operation_to_string b) (x ()).API.vDI_current_operations)) ~get_set:(fun () -> List.map (fun (a,b) -> Record_util.vdi_operation_to_string b) (x ()).API.vDI_current_operations) (); - make_field ~name:"sr-uuid" + make_field ~name:"sr-uuid" ~get:(fun () -> get_uuid_from_ref (x ()).API.vDI_SR) (); - make_field ~name:"sr-name-label" + make_field ~name:"sr-name-label" ~get:(fun () -> get_name_from_ref (x ()).API.vDI_SR) (); make_field ~name:"vbd-uuids" ~get:(fun () -> String.concat "; " (List.map get_uuid_from_ref (x ()).API.vDI_VBDs)) @@ -1115,7 +1115,7 @@ let vdi_record rpc session_id vdi = make_field ~name:"sm-config" ~get:(fun () -> Record_util.s2sm_to_string "; " (x ()).API.vDI_sm_config) ~get_map:(fun () -> (x ()).API.vDI_sm_config) (); make_field ~name:"on-boot" ~get:(fun () -> Record_util.on_boot_to_string (x ()).API.vDI_on_boot) - ~set:(fun onboot -> Client.VDI.set_on_boot rpc session_id vdi (match onboot with "persist" -> `persist | "reset" -> `reset)) (); + ~set:(fun onboot -> Client.VDI.set_on_boot rpc session_id vdi (Record_util.string_to_vdi_onboot onboot)) (); make_field ~name:"allow-caching" ~get:(fun () -> string_of_bool (x ()).API.vDI_allow_caching) ~set:(fun b -> Client.VDI.set_allow_caching rpc session_id vdi (bool_of_string b)) (); ]} @@ -1131,10 +1131,10 @@ let vbd_record rpc session_id vbd = setrefrec=(fun (a,b) -> _ref := a; record := Got b); record=x; getref=(fun () -> !_ref); - fields = + fields = [ make_field ~name:"uuid" ~get:(fun () -> (x ()).API.vBD_uuid) (); - make_field ~name:"vm-uuid" + make_field ~name:"vm-uuid" ~get:(fun () -> get_uuid_from_ref (x ()).API.vBD_VM) (); make_field ~name:"vm-name-label" ~get:(fun () -> get_name_from_ref (x ()).API.vBD_VM) (); @@ -1145,7 +1145,7 @@ let vbd_record rpc session_id vbd = ~get_set:(fun () -> List.map Record_util.vbd_operation_to_string (x ()).API.vBD_allowed_operations) (); make_field ~name:"current-operations" ~get:(fun () -> String.concat "; " (List.map (fun (a,b) -> Record_util.vbd_operation_to_string b) (x ()).API.vBD_current_operations)) - ~get_set:(fun () -> List.map (fun (a,b) -> Record_util.vbd_operation_to_string b) (x ()).API.vBD_current_operations) (); + ~get_set:(fun () -> List.map (fun (a,b) -> Record_util.vbd_operation_to_string b) (x ()).API.vBD_current_operations) (); make_field ~name:"empty" ~get:(fun () -> string_of_bool (x ()).API.vBD_empty) (); make_field ~name:"device" ~get:(fun () -> (x ()).API.vBD_device) (); make_field ~name:"userdevice" ~get:(fun () -> (x ()).API.vBD_userdevice) @@ -1153,9 +1153,9 @@ let vbd_record rpc session_id vbd = make_field ~name:"bootable" ~get:(fun () -> string_of_bool (x ()).API.vBD_bootable) ~set:(fun boot -> Client.VBD.set_bootable rpc session_id vbd (safe_bool_of_string "bootable" boot)) (); make_field ~name:"mode" ~get:(fun () -> match (x ()).API.vBD_mode with `RO -> "RO" | `RW -> "RW") - ~set:(fun mode -> Client.VBD.set_mode rpc session_id vbd (match mode with "RO" -> `RO | "RW" -> `RW)) (); + ~set:(fun mode -> Client.VBD.set_mode rpc session_id vbd (Record_util.string_to_vbd_mode mode)) (); make_field ~name:"type" ~get:(fun () -> match (x ()).API.vBD_type with `CD -> "CD" | `Disk -> "Disk") - ~set:(fun ty -> Client.VBD.set_type rpc session_id vbd (match ty with "CD" -> `CD | "Disk" -> `Disk)) (); + ~set:(fun ty -> Client.VBD.set_type rpc session_id vbd (Record_util.string_to_vbd_type ty)) (); make_field ~name:"unpluggable" ~get:(fun () -> string_of_bool (x ()).API.vBD_unpluggable) ~set:(fun unpluggable -> Client.VBD.set_unpluggable rpc session_id vbd (safe_bool_of_string "unpluggable" unpluggable)) (); make_field ~name:"currently-attached" ~get:(fun () -> string_of_bool (x ()).API.vBD_currently_attached) (); @@ -1175,12 +1175,12 @@ let vbd_record rpc session_id vbd = ~add_to_map:(fun k v -> Client.VBD.add_to_other_config rpc session_id vbd k v) ~remove_from_map:(fun k -> Client.VBD.remove_from_other_config rpc session_id vbd k) ~get_map:(fun () -> (x ()).API.vBD_other_config) (); - make_field ~name:"io_read_kbs" ~get:(fun () -> + make_field ~name:"io_read_kbs" ~get:(fun () -> try let name = Printf.sprintf "vbd_%s_read" (x ()).API.vBD_device in string_of_float ((Client.VM.query_data_source rpc session_id (x ()).API.vBD_VM name) /. 1024.0) with _ -> "<unknown>") ~expensive:true (); - make_field ~name:"io_write_kbs" ~get:(fun () -> + make_field ~name:"io_write_kbs" ~get:(fun () -> try let name = Printf.sprintf "vbd_%s_write" (x ()).API.vBD_device in string_of_float ((Client.VM.query_data_source rpc session_id (x ()).API.vBD_VM name) /. 1024.0)
_______________________________________________ xen-api mailing list [email protected] http://lists.xensource.com/mailman/listinfo/xen-api
