| "static" -> `Static
| s -> raise (Record_failure ("Expected 'dhcp','none' or 'static', got "^s))
+let bool_of_string s =
+ match String.lowercase s with
+ |"true"|"yes"->true
+ |"false"|"no"->false
+ |_-> raise (Record_failure ("Expected 'true','yes','false','no', got "^s))
+
(* string_to_string_map_to_string *)
let s2sm_to_string sep x =
String.concat sep (List.map (fun (a,b) -> a^": "^b) x)
(*make_field ~name:"is_basic" ~get:(fun () -> string_of_bool (x ()).API.role_is_basic) ();*)
]}
+let vmpp_record rpc session_id vmpp =
+ let _ref = ref vmpp in
+ let empty_record = ToGet (fun () -> Client.VMPP.get_record rpc session_id !_ref) in
+ let record = ref empty_record in
+ let x () = lzy_get record in
+ { setref=(fun r -> _ref := r; record := empty_record );
+ setrefrec=(fun (a,b) -> _ref := a; record := Got b);
+ record=x;
+ getref=(fun () -> !_ref);
+ fields =
+[
+ make_field ~name:"uuid"
+ ~get:(fun () -> (x ()).API.vMPP_uuid)
+ ();
+ make_field ~name:"name-label"
+ ~get:(fun () -> (x ()).API.vMPP_name_label)
+ ~set:(fun x -> Client.VMPP.set_name_label rpc session_id vmpp x)
+ ();
+ make_field ~name:"name-description"
+ ~get:(fun () -> (x ()).API.vMPP_name_description)
+ ~set:(fun x -> Client.VMPP.set_name_description rpc session_id vmpp x)
+ ();
+ make_field ~name:"is-policy-enabled"
+ ~get:(fun () -> string_of_bool (x ()).API.vMPP_is_policy_enabled)
+ ~set:(fun x -> Client.VMPP.set_is_policy_enabled rpc session_id vmpp (safe_bool_of_string "is-policy-enabled" x))
+ ();
+ make_field ~name:"backup-type"
+ ~get:(fun () -> XMLRPC.From.string (API.To.vmpp_backup_type (x ()).API.vMPP_backup_type))
+ ~set:(fun x -> Client.VMPP.set_backup_type rpc session_id vmpp (API.From.vmpp_backup_type "backup-type" (XMLRPC.To.string x)))
+ ();
+ make_field ~name:"backup-retention-value"
+ ~get:(fun () -> string_of_int (Int64.to_int (x ()).API.vMPP_backup_retention_value))
+ ~set:(fun x -> Client.VMPP.set_backup_retention_value rpc session_id vmpp (safe_i64_of_string "backup-retention-value" x))
+ ();
+ make_field ~name:"backup-frequency"
+ ~get:(fun () -> XMLRPC.From.string (API.To.vmpp_backup_frequency (x ()).API.vMPP_backup_frequency))
+ ~set:(fun x -> Client.VMPP.set_backup_frequency rpc session_id vmpp (API.From.vmpp_backup_frequency "backup-frequency" (XMLRPC.To.string x)))
+ ();
+ make_field ~name:"backup-schedule"
+ ~get:(fun () -> Record_util.s2sm_to_string "; " (x ()).API.vMPP_backup_schedule)
+ ~get_map:(fun () -> (x ()).API.vMPP_backup_schedule)
+ ~add_to_map:(fun k v -> Client.VMPP.add_to_backup_schedule rpc session_id vmpp k v)
+ ~remove_from_map:(fun k -> Client.VMPP.remove_from_backup_schedule rpc session_id vmpp k)
+ ();
+ make_field ~name:"is-backup-running"
+ ~get:(fun () -> string_of_bool (x ()).API.vMPP_is_backup_running)
+ ();
+ make_field ~name:"backup-last-run-time"
+ ~get:(fun () -> Date.to_string (x ()).API.vMPP_backup_last_run_time)
+ ();
+ make_field ~name:"archive-target-type"
+ ~get:(fun () -> XMLRPC.From.string (API.To.vmpp_archive_target_type (x ()).API.vMPP_archive_target_type))
+ ~set:(fun x -> Client.VMPP.set_archive_target_type rpc session_id vmpp (API.From.vmpp_archive_target_type "archive-target-type" (XMLRPC.To.string x)))
+ ();
+ make_field ~name:"archive-target-config"
+ ~get:(fun () -> Record_util.s2sm_to_string "; " (x ()).API.vMPP_archive_target_config)
+ ~get_map:(fun () -> (x ()).API.vMPP_archive_target_config)
+ ~add_to_map:(fun k v -> Client.VMPP.add_to_archive_target_config rpc session_id vmpp k v)
+ ~remove_from_map:(fun k ->
+ Client.VMPP.remove_from_archive_target_config rpc session_id vmpp k)
+ ();
+ make_field ~name:"archive-frequency"
+ ~get:(fun () -> XMLRPC.From.string (API.To.vmpp_archive_frequency (x ()).API.vMPP_archive_frequency))
+ ~set:(fun x -> Client.VMPP.set_archive_frequency rpc session_id vmpp (API.From.vmpp_archive_frequency "archive-frequency" (XMLRPC.To.string x)))
+ ();
+ make_field ~name:"archive-schedule" ~get:(fun () -> Record_util.s2sm_to_string "; " (x ()).API.vMPP_archive_schedule)
+ ~get_map:(fun () -> (x ()).API.vMPP_archive_schedule)
+ ~add_to_map:(fun k v -> Client.VMPP.add_to_archive_schedule rpc session_id vmpp k v)
+ ~remove_from_map:(fun k ->
+ Client.VMPP.remove_from_archive_schedule rpc session_id vmpp k)
+ ();
+ make_field ~name:"is-archive-running"
+ ~get:(fun () -> string_of_bool (x ()).API.vMPP_is_archive_running)
+ ();
+ make_field ~name:"archive-last-run-time" ~get:(fun () -> Date.to_string (x ()).API.vMPP_archive_last_run_time)
+ ();
+ make_field ~name:"is-alarm-enabled"
+ ~get:(fun () -> string_of_bool (x ()).API.vMPP_is_alarm_enabled)
+ ~set:(fun x -> Client.VMPP.set_is_alarm_enabled rpc session_id vmpp (safe_bool_of_string "is-alarm-enabled" x))
+ ();
+ make_field ~name:"alarm-config" ~get:(fun () -> Record_util.s2sm_to_string "; " (x ()).API.vMPP_alarm_config)
+ ~get_map:(fun () -> (x ()).API.vMPP_alarm_config)
+ ~add_to_map:(fun k v -> Client.VMPP.add_to_alarm_config rpc session_id vmpp k v)
+ ~remove_from_map:(fun k ->
+ Client.VMPP.remove_from_alarm_config rpc session_id vmpp k)
+ ();
+ make_field ~name:"VMs"
+ ~get:(fun () -> String.concat "; "
+ (try
+ List.map
+ (fun self -> try Client.VM.get_uuid rpc session_id self with _ -> nid)
+ (Client.VMPP.get_VMs rpc session_id vmpp)
+ with _ -> []
+ )
+ )
+ ~expensive:false
+ ~get_set:(fun () -> try List.map
+ (fun self -> try Client.VM.get_uuid rpc session_id self with _ -> nid)
+ (Client.VMPP.get_VMs rpc session_id vmpp) with _ -> [])
+ ();
+]}
+
(*
let alert_record rpc session_id pool =
let _ref = ref pool in
~get:(fun () -> default nid (may (fun m -> Date.to_string m.API.vM_guest_metrics_last_updated) (xgm ()) )) ();
make_field ~name:"cooperative"
(* NB this can receive VM_IS_SNAPSHOT *)
- ~get:(fun () -> string_of_bool (try Client.VM.get_cooperative rpc session_id vm with _ -> true)) ~expensive:true ()
+ ~get:(fun () -> string_of_bool (try Client.VM.get_cooperative rpc session_id vm with _ -> true)) ~expensive:true ();
+ make_field ~name:"protection-policy"
+ ~get:(fun () -> get_uuid_from_ref (x ()).API.vM_protection_policy)
+ ~set:(fun x -> if x="" then Client.VM.set_protection_policy rpc session_id vm Ref.null else Client.VM.set_protection_policy rpc session_id vm (Client.VMPP.get_by_uuid rpc session_id x)) ();
+ make_field ~name:"is-snapshot-from-vmpp"
+ ~get:(fun () -> string_of_bool (x ()).API.vM_is_snapshot_from_vmpp) ();
]
}
| Pool of [`pool] Ref.t * API.pool_t
| Message of [`message] Ref.t * API.message_t
| Secret of [`secret] Ref.t * API.secret_t
+ | VMPP of [`VMPP] Ref.t * API.vMPP_t
let record_of_event ev =
let xmlrpc = match ev.Event_types.snapshot with Some x -> x | None -> failwith "no record in event" in
| "pool" -> Pool (Ref.of_string ev.Event_types.reference,API.From.pool_t "" xmlrpc)
| "message" -> Message (Ref.of_string ev.Event_types.reference,API.From.message_t "" xmlrpc)
| "secret" -> Secret (Ref.of_string ev.Event_types.reference,API.From.secret_t "" xmlrpc)
-
+ | "vmpp" -> VMPP (Ref.of_string ev.Event_types.reference,API.From.vMPP_t "" xmlrpc)
; implementation = No_fd Cli_operations.secret_destroy
; flags = []
};
+ "vmpp-create",
+ {
+ reqd=["name-label";"backup-type";"backup-frequency"];
+ optn=["name-description";"is-policy-enabled";"backup-schedule:";"backup-retention-value";"archive-target-type";"archive-target-config:";"archive-frequency";"archive-schedule:";"is-alarm-enabled";"alarm-config:"];
+ help="Create a new VM protection policy.";
+ implementation=No_fd Cli_operations.vmpp_create;
+ flags=[];
+ };
+ "vmpp-destroy",
+ {
+ reqd=["uuid"];
+ optn=[];
+ help="Destroy a VM protection policy.";
+ implementation=No_fd Cli_operations.vmpp_destroy;
+ flags=[];
+ };
]
(make_param_funs (Client.Console.get_all) (Client.Console.get_all_records_where) (Client.Console.get_by_uuid) (console_record) "console" [] ["uuid";"vm-uuid";"vm-name-label";"protocol";"location"] rpc session_id) @
(make_param_funs (Client.VM.get_all) (Client.VM.get_all_records_where) (Client.VM.get_by_uuid) (vm_record) "vm" [("is-a-template","false")] ["name-label";"uuid";"power-state"] rpc session_id) @
(make_param_funs (Client.VM.get_all) (Client.VM.get_all_records_where) (Client.VM.get_by_uuid) (vm_record) "template" [("is-a-template","true");("is-a-snapshot","false")] ["name-label";"name-description";"uuid"] rpc session_id) @
- (make_param_funs (Client.VM.get_all) (Client.VM.get_all_records_where) (Client.VM.get_by_uuid) (vm_record) "snapshot" [("is-a-snapshot","true")] ["name-label";"name-description";"uuid";"snapshot_of"; "snapshot_time"] rpc session_id) @
+ (make_param_funs (Client.VM.get_all) (Client.VM.get_all_records_where) (Client.VM.get_by_uuid) (vm_record) "snapshot" [("is-a-snapshot","true")] ["name-label";"name-description";"uuid";"snapshot_of"; "snapshot_time"; "is-snapshot-from-vmpp"] rpc session_id) @
(make_param_funs (Client.Host.get_all) (Client.Host.get_all_records_where) (Client.Host.get_by_uuid) (host_record) "host" [] ["uuid";"name-label";"name-description"] rpc session_id) @
(make_param_funs (Client.Host_cpu.get_all) (Client.Host_cpu.get_all_records_where) (Client.Host_cpu.get_by_uuid) (host_cpu_record) "host-cpu" [] ["uuid";"number";"vendor";"speed";"utilisation"] rpc session_id) @
(make_param_funs (Client.Subject.get_all) (Client.Subject.get_all_records_where) (Client.Subject.get_by_uuid) (subject_record) "subject" [] ["uuid";"subject-identifier";"other-config";"roles"] rpc session_id) @
(make_param_funs (Client.Role.get_all) (fun ~rpc ~session_id ~expr -> Client.Role.get_all_records_where ~rpc ~session_id ~expr:Xapi_role.expr_no_permissions)
(Client.Role.get_by_uuid) (role_record) "role" [] ["uuid";"name";"description";"subroles"] rpc session_id) @
+ (make_param_funs (Client.VMPP.get_all) (Client.VMPP.get_all_records_where) (Client.VMPP.get_by_uuid) (vmpp_record) "vmpp" [] ["uuid";"name-label";"name-description";"is-policy-enabled";"backup-type";"backup-retention-value";"backup-frequency";"backup-schedule";"is-backup-running";"backup-last-run-time";"archive-target-type";"archive-target-config";"archive-frequency";"archive-schedule";"is-archive-running";"archive-last-run-time";"is-alarm-enabled";"alarm-config";"VMs"] rpc session_id) @
(*
(make_param_funs (Client.Blob.get_all) (Client.Blob.get_all_records_where) (Client.Blob.get_by_uuid) (blob_record) "blob" [] ["uuid";"mime-type"] rpc session_id) @
*)
| "task" -> List.map (fun x -> (task_record rpc session_id x).fields) (Client.Task.get_all rpc session_id)
| "subject" -> List.map (fun x -> (subject_record rpc session_id x).fields) (Client.Subject.get_all rpc session_id)
| "role" -> List.map (fun x -> (role_record rpc session_id x).fields) (Client.Role.get_all rpc session_id)
+ | "vmpp" -> List.map (fun x -> (vmpp_record rpc session_id x).fields) (Client.VMPP.get_all rpc session_id)
| "secret" -> List.map (fun x -> (secret_record rpc session_id x).fields) (Client.Secret.get_all rpc session_id)
(* | "alert" -> List.map (fun x -> (alert_record rpc session_id x).fields) (Client.Alert.get_all rpc session_id) *)
| _ -> failwith ("Cli listening for class '"^classname^"' not currently implemented")
| Event_helper.PBD (r,x) -> let record = pbd_record rpc session_id r in record.setrefrec (r,x); record.fields
| Event_helper.Pool (r,x) -> let record = pool_record rpc session_id r in record.setrefrec (r,x); record.fields
| Event_helper.Task (r,x) -> let record = task_record rpc session_id r in record.setrefrec (r,x); record.fields
- | Event_helper.Secret (r,x) -> let record = secret_record rpc session_id r in record.setrefrec (r,x); record.fields
+ | Event_helper.VMPP (r,x) -> let record = vmpp_record rpc session_id r in record.setrefrec (r,x); record.fields
+ | Event_helper.Secret (r,x) -> let record = secret_record rpc session_id r in record.setrefrec (r,x); record.fields
| _ -> failwith ("Cli listening for class '"^classname^"' not currently implemented")
in
let record = List.map (fun r -> (r.name,fun () -> safe_get_field r)) tbl in
let regenerate_built_in_templates printer rpc session_id params =
Create_templates.create_all_templates rpc session_id
+
+let vmpp_create printer rpc session_id params =
+ let get ?default param_name =
+ if List.mem_assoc param_name params
+ then List.assoc param_name params
+ else match default with
+ | Some default_value -> default_value
+ | None -> failwith ("No default value for parameter "^param_name)
+ in
+ let map param_name ?default xmlrpc_to_type api_from_type =
+ api_from_type param_name (xmlrpc_to_type (get ?default param_name))
+ in
+ let name_label = List.assoc "name-label" params in
+ let backup_type = map "backup-type" XMLRPC.To.string API.From.vmpp_backup_type in
+ let backup_frequency = map "backup-frequency" XMLRPC.To.string API.From.vmpp_backup_frequency in
+ let backup_schedule = read_map_params "backup-schedule" params in
+ (* optional parameters with default values *)
+ let name_description = get "name-description" ~default:"" in
+ let is_policy_enabled = Record_util.bool_of_string(get "is-policy-enabled" ~default:"true") in
+ let backup_retention_value = map "backup-retention-value" ~default:"1" XMLRPC.To.string API.From.int64 in
+ let backup_last_run_time = Date.of_string (get "backup-last-run-time" ~default:(Date.to_string (Date.of_float 0.))) in
+ let archive_frequency = map "archive-frequency" ~default:"never" XMLRPC.To.string API.From.vmpp_archive_frequency in
+ let archive_target_type = map "archive-target-type" ~default:"none" XMLRPC.To.string API.From.vmpp_archive_target_type in
+ let archive_target_config = read_map_params "archive-target-config" params in
+ let archive_schedule = read_map_params "archive-schedule" params in
+ let archive_last_run_time = Date.of_string (get "archive-last-run-time" ~default:(Date.to_string (Date.of_float 0.))) in
+ let is_alarm_enabled = Record_util.bool_of_string(get "is-alarm-enabled" ~default:"false") in
+ let alarm_config = read_map_params "alarm-config" params in
+ let ref = Client.VMPP.create ~rpc ~session_id ~name_label ~name_description
+ ~is_policy_enabled ~backup_type ~backup_retention_value ~backup_frequency
+ ~backup_schedule ~backup_last_run_time ~archive_target_type
+ ~archive_target_config ~archive_frequency ~archive_schedule
+ ~archive_last_run_time ~is_alarm_enabled ~alarm_config
+ in
+ let uuid = Client.VMPP.get_uuid ~rpc ~session_id ~self:ref in
+ printer (Cli_printer.PList [uuid])
+
+let vmpp_destroy printer rpc session_id params =
+ let uuid = List.assoc "uuid" params in
+ let ref = Client.VMPP.get_by_uuid ~rpc ~session_id ~uuid in
+ Client.VMPP.destroy ~rpc ~session_id ~self:ref
projects / xcp / xen-api.git / commitdiff