| `unplug -> "unplug"
let cpu_feature_to_string f =
- match f with
+ match f with
`FPU -> "FPU"
| `VME -> "VME"
| `DE -> "DE"
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"
| `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 =
| "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"
| `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
"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
| `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
| `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
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
| "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 *)
(* generate a random mac that is locally administered *)
let random_mac_local () =
mac_from_int_array (Array.init 6 (fun i -> Random.int 0x100))
-
-
-
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))
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)) ();
]}
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) ();
~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)
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) ();
~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)
projects / xcp / xen-api.git / commitdiff