# HG changeset patch
# User Marcus Granado <marcus.granado@xxxxxxxxxx>
# Date 1282322886 -3600
# Node ID cf4fa3283659fb55b279c563e3a818ad8ddf7181
# Parent  80f7b258edfb52f34e2caa0bfb00e32ea208bc99
CP-1800: CLI support for PR-1031 (VM protection policy)

Signed-off-by: Marcus Granado <marcus.granado@xxxxxxxxxxxxx>

diff -r 80f7b258edfb -r cf4fa3283659 ocaml/client_records/record_util.ml
--- a/ocaml/client_records/record_util.ml
+++ b/ocaml/client_records/record_util.ml
@@ -302,6 +302,12 @@
   | "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)
diff -r 80f7b258edfb -r cf4fa3283659 ocaml/client_records/records.ml
--- a/ocaml/client_records/records.ml
+++ b/ocaml/client_records/records.ml
@@ -497,6 +497,108 @@
   (*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
@@ -787,7 +889,12 @@
 				~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) ();
 		]
 	}
 
diff -r 80f7b258edfb -r cf4fa3283659 ocaml/idl/ocaml_backend/event_helper.ml
--- a/ocaml/idl/ocaml_backend/event_helper.ml
+++ b/ocaml/idl/ocaml_backend/event_helper.ml
@@ -40,6 +40,7 @@
      | 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
@@ -70,5 +71,5 @@
      | "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)
   
-  
diff -r 80f7b258edfb -r cf4fa3283659 ocaml/xapi/cli_frontend.ml
--- a/ocaml/xapi/cli_frontend.ml
+++ b/ocaml/xapi/cli_frontend.ml
@@ -2209,6 +2209,22 @@
 			; 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=[];
+    };
     
   ]
 
diff -r 80f7b258edfb -r cf4fa3283659 ocaml/xapi/cli_operations.ml
--- a/ocaml/xapi/cli_operations.ml
+++ b/ocaml/xapi/cli_operations.ml
@@ -687,7 +687,7 @@
 	(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) @
 
@@ -702,6 +702,7 @@
 	(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) @
 *)
@@ -1505,6 +1506,7 @@
 				| "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")
@@ -1544,7 +1546,8 @@
  								  | 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
@@ -3897,3 +3900,44 @@
 
 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