Add APIs, CLIs, Unit Tests and functions for VM Schedule Snapshot

ocaml/client_records/record_util.ml

@@ -156,6 +156,28 @@ let string_to_vif_locking_mode = function
 	| "disabled" -> `disabled
 	| s -> raise (Record_failure ("Expected 'network_default', 'locked', 'unlocked', 'disabled', got "^s))
 
+let vmss_type_to_string = function
+	| `snapshot -> "snapshot"
+	| `checkpoint -> "checkpoint"
+	| `snapshot_with_quiesce -> "snapshot_with_quiesce"
+
+let string_to_vmss_type = function
+	| "snapshot" -> `snapshot
+	| "checkpoint" -> `checkpoint
+	| "snapshot_with_quiesce" -> `snapshot_with_quiesce
+	| s -> raise (Record_failure ("Expected 'snapshot', 'checkpoint', 'snapshot_with_quiesce', got "^s))
+
+let vmss_frequency_to_string = function
+	| `hourly -> "hourly"
+	| `daily -> "daily"
+	| `weekly -> "weekly"
+
+let string_to_vmss_frequency = function
+	| "hourly" -> `hourly
+	| "daily" -> `daily
+	| "weekly" -> `weekly
+	| s -> raise (Record_failure ("Expected 'hourly', 'daily', 'weekly', got "^s))
+
 let network_default_locking_mode_to_string = function
 	| `unlocked -> "unlocked"
 	| `disabled -> "disabled"

ocaml/client_records/records.ml

@@ -215,7 +215,7 @@ let message_record rpc session_id message =
 	make_field ~name:"uuid"         ~get:(fun () -> (x ()).API.message_uuid) ();
 	make_field ~name:"name"         ~get:(fun () -> (x ()).API.message_name) ();
 	make_field ~name:"priority"     ~get:(fun () -> Int64.to_string (x ()).API.message_priority) ();
-	make_field ~name:"class"        ~get:(fun () -> match (x ()).API.message_cls with `VM -> "VM" | `Host -> "Host" | `SR -> "SR" | `Pool -> "Pool" | `VMPP -> "VMPP") ();
+	make_field ~name:"class"        ~get:(fun () -> match (x ()).API.message_cls with `VM -> "VM" | `Host -> "Host" | `SR -> "SR" | `Pool -> "Pool" | `VMPP -> "VMPP" | `VMSS -> "VMSS") ();
 	make_field ~name:"obj-uuid"     ~get:(fun () -> (x ()).API.message_obj_uuid) ();
 	make_field ~name:"timestamp"    ~get:(fun () -> Date.to_string (x ()).API.message_timestamp) ();
 	make_field ~name:"body"         ~get:(fun () -> (x ()).API.message_body) ();
@@ -537,6 +537,68 @@ let pool_record rpc session_id pool =
 			make_field ~name:"policy-no-vendor-device" ~get:(fun () -> string_of_bool (x ()).API.pool_policy_no_vendor_device) ~set:(fun s -> Client.Pool.set_policy_no_vendor_device rpc session_id pool (safe_bool_of_string "policy-no-vendor-device" s)) ();
 		]}
 
+let vmss_record rpc session_id vmss =
+	let _ref = ref vmss in
+	let empty_record = ToGet (fun () -> Client.VMSS.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.vMSS_uuid)
+					();
+				make_field ~name:"name-label"
+					~get:(fun () -> (x ()).API.vMSS_name_label)
+					~set:(fun x -> Client.VMSS.set_name_label rpc session_id vmss x)
+					();
+				make_field ~name:"name-description"
+					~get:(fun () -> (x ()).API.vMSS_name_description)
+					~set:(fun x -> Client.VMSS.set_name_description rpc session_id vmss x)
+					();
+				make_field ~name:"enabled"
+					~get:(fun () -> string_of_bool (x ()).API.vMSS_enabled)
+					~set:(fun x -> Client.VMSS.set_enabled rpc session_id vmss (safe_bool_of_string "enabled" x))
+					();
+				make_field ~name:"type"
+					~get:(fun () -> (Record_util.vmss_type_to_string (x ()).API.vMSS_type))
+					~set:(fun x -> Client.VMSS.set_type rpc session_id vmss (Record_util.string_to_vmss_type x))
+					();
+				make_field ~name:"retained-snapshots"
+					~get:(fun () -> string_of_int (Int64.to_int (x ()).API.vMSS_retained_snapshots))
+					~set:(fun x -> Client.VMSS.set_retained_snapshots rpc session_id vmss (safe_i64_of_string "retained-snapshots" x))
+					();
+				make_field ~name:"frequency"
+					~get:(fun () -> (Record_util.vmss_frequency_to_string (x ()).API.vMSS_frequency))
+					~set:(fun x -> Client.VMSS.set_frequency rpc session_id vmss (Record_util.string_to_vmss_frequency x))
+					();
+				make_field ~name:"schedule"
+					~get:(fun () -> Record_util.s2sm_to_string "; " (x ()).API.vMSS_schedule)
+					~get_map:(fun () -> (x ()).API.vMSS_schedule)
+					~add_to_map:(fun k v -> Client.VMSS.add_to_schedule rpc session_id vmss k v)
+					~remove_from_map:(fun k -> Client.VMSS.remove_from_schedule rpc session_id vmss k)
+					();
+				make_field ~name:"last-run-time"
+					~get:(fun () -> Date.to_string (x ()).API.vMSS_last_run_time)
+					();
+				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.VMSS.get_VMs rpc session_id vmss) with _ -> []
+						)
+					)
+					~expensive:false
+					~get_set:(fun () -> try List.map
+						(fun self -> try Client.VM.get_uuid rpc session_id self with _ -> nid)
+						(Client.VMSS.get_VMs rpc session_id vmss) with _ -> [])
+					();
+		]}
+
 let subject_record rpc session_id subject = 
   let _ref = ref subject in
   let empty_record = ToGet (fun () -> Client.Subject.get_record rpc session_id !_ref) in
@@ -903,6 +965,11 @@ let vm_record rpc session_id vm =
 			make_field ~name:"appliance"
 				~get:(fun () -> get_uuid_from_ref (x ()).API.vM_appliance)
 				~set:(fun x -> if x="" then Client.VM.set_appliance rpc session_id vm Ref.null else Client.VM.set_appliance rpc session_id vm (Client.VM_appliance.get_by_uuid rpc session_id x)) ();
+			make_field ~name:"snapshot-schedule"
+				~get:(fun () -> get_uuid_from_ref (x ()).API.vM_snapshot_schedule)
+				~set:(fun x -> if x="" then Client.VM.set_snapshot_schedule rpc session_id vm Ref.null else Client.VM.set_snapshot_schedule rpc session_id vm (Client.VMSS.get_by_uuid rpc session_id x)) ();
+			make_field ~name:"is-vmss-snapshot"
+				~get:(fun () -> string_of_bool (x ()).API.vM_is_vmss_snapshot) ();
 			make_field ~name:"start-delay"
 				~get:(fun () -> Int64.to_string (x ()).API.vM_start_delay)
 				~set:(fun x -> Client.VM.set_start_delay rpc session_id vm (safe_i64_of_string "start-delay" x)) ();

ocaml/idl/api_errors.ml

@@ -480,6 +480,9 @@ let vmpp_has_vm = "VMPP_HAS_VM"
 let vmpp_archive_more_frequent_than_backup = "VMPP_ARCHIVE_MORE_FREQUENT_THAN_BACKUP"
 let vm_assigned_to_protection_policy = "VM_ASSIGNED_TO_PROTECTION_POLICY"
 
+let vmss_has_vm = "VMSS_HAS_VM"
+let vm_assigned_to_snapshot_schedule = "VM_ASSIGNED_TO_SNAPSHOT_SCHEDULE"
+
 let ssl_verify_error = "SSL_VERIFY_ERROR"
 
 let cannot_enable_redo_log = "CANNOT_ENABLE_REDO_LOG"

ocaml/idl/api_messages.ml

@@ -107,6 +107,14 @@ let vmpp_snapshot_missed_event = addMessage "VMPP_SNAPSHOT_MISSED_EVENT" 3L (*'A
 let vmpp_archive_missed_event = addMessage "VMPP_ARCHIVE_MISSED_EVENT" 3L (*'A scheduled archive event was missed due to another on-going scheduled archive run. This is unexpected behaviour, please re-configure your archive sub-policy'*)
 let vmpp_snapshot_archive_already_exists = addMessage "VMPP_SNAPSHOT_ARCHIVE_ALREADY_EXISTS" 3L (*'Failed to archive the snapshot, it has already been archived on the specified target'*)
 
+(* VMSS message types *)
+let vmss_snapshot_lock_failed = addMessage "VMSS_SNAPSHOT_LOCK_FAILED" 3L (*'The snapshot is already executing for schedule snapshot. Please try again later'*)
+let vmss_snapshot_succeeded = addMessage "VMSS_SNAPSHOT_SUCCEEDED" 5L (*'Successfully performed the snapshot of the schedule snapshot'*)
+let vmss_snapshot_failed = addMessage "VMSS_SNAPSHOT_FAILED" 3L (*'The snapshot of the schedule snapshot has failed.'*)
+let vmss_license_error = addMessage "VMSS_LICENSE_ERROR" 3L (*'This operation is not allowed under your license.  Please contact your support representative'*)
+let vmss_xapi_logon_failure = addMessage "VMSS_XAPI_LOGON_FAILURE" 3L (*'Could not login to API session.'*)
+let vmss_snapshot_missed_event = addMessage "VMSS_SNAPSHOT_MISSED_EVENT" 3L (*'A scheduled snapshot event was missed due to another on-going scheduled snapshot run. This is unexpected behaviour, please re-configure your schedule snapshot',*)
+
 let bond_status_changed = addMessage "BOND_STATUS_CHANGED" 3L (* A link in a bond went down or came back up *) (* Previously missing from table *)
 
 let host_cpu_features_down = addMessage "HOST_CPU_FEATURES_DOWN" 3L

ocaml/idl/datamodel.ml

@@ -119,6 +119,7 @@ let _vm_guest_metrics = "VM_guest_metrics"
 let _vm_appliance = "VM_appliance"
 let _dr_task = "DR_task"
 let _vmpp = "VMPP"
+let _vmss = "VMSS"
 let _network = "network"
 let _vif = "VIF"
 let _vif_metrics = "VIF_metrics"
@@ -1282,6 +1283,11 @@ let _ =
     ~doc:"Archive more frequent than backup." ();
   error Api_errors.vm_assigned_to_protection_policy ["vm"; "vmpp"]
     ~doc:"This VM is assigned to a protection policy." ();
+
+  error Api_errors.vmss_has_vm []
+    ~doc:"There is at least one VM assigned to snapshot schedule." ();
+  error Api_errors.vm_assigned_to_snapshot_schedule ["vm"; "vmss"]
+    ~doc:"This VM is assigned to a snapshot schedule." ();
 
   error Api_errors.ssl_verify_error ["reason"]
     ~doc:"The remote system's SSL certificate failed to verify against our certificate library." ();
@@ -2377,6 +2383,17 @@ let vm_set_protection_policy = call
   ~allowed_roles:_R_POOL_OP
   ()
 
+let vm_set_snapshot_schedule = call
+  ~name:"set_snapshot_schedule"
+  ~in_oss_since:None
+  ~in_product_since:rel_ely
+  ~doc:"Set the value of the snapshot schedule field"
+  ~params:[Ref _vm, "self", "The VM";
+    Ref _vmss, "value", "The value"]
+  ~flags:[`Session]
+  ~allowed_roles:_R_POOL_OP
+  ()
+
 let vm_set_start_delay = call
   ~name:"set_start_delay"
   ~in_product_since:rel_boston
@@ -7287,7 +7304,8 @@ let vm =
 		vm_update_snapshot_metadata;
 		vm_retrieve_wlb_recommendations;
 		vm_copy_bios_strings;
-    vm_set_protection_policy;
+		vm_set_protection_policy;
+		vm_set_snapshot_schedule;
 		vm_set_start_delay;
 		vm_set_shutdown_delay;
 		vm_set_order;
@@ -7367,6 +7385,8 @@ let vm =
 	field ~qualifier:DynamicRO ~in_product_since:rel_midnight_ride ~default_value:(Some (VMap [])) ~ty:(Map (String,String)) "bios_strings" "BIOS strings";
 	field ~writer_roles:_R_VM_POWER_ADMIN ~qualifier:StaticRO ~lifecycle:[Published, rel_cowley, ""; Deprecated, rel_clearwater, "The VMPR feature was removed"] ~default_value:(Some (VRef (Ref.string_of Ref.null))) ~ty:(Ref _vmpp) "protection_policy" "Ref pointing to a protection policy for this VM";
 	field ~writer_roles:_R_POOL_OP ~qualifier:StaticRO ~lifecycle:[Published, rel_cowley, ""; Deprecated, rel_clearwater, "The VMPR feature was removed"] ~default_value:(Some (VBool false)) ~ty:Bool "is_snapshot_from_vmpp" "true if this snapshot was created by the protection policy";
+	field ~writer_roles:_R_VM_POWER_ADMIN ~qualifier:StaticRO ~in_product_since:rel_ely ~default_value:(Some (VRef (Ref.string_of Ref.null))) ~ty:(Ref _vmss) "snapshot_schedule" "Ref pointing to a snapshot schedule for this VM";
+	field ~writer_roles:_R_POOL_OP ~qualifier:StaticRO ~in_product_since:rel_ely ~default_value:(Some (VBool false)) ~ty:Bool "is_vmss_snapshot" "true if this snapshot was created by the snapshot schedule";
 	field ~writer_roles:_R_POOL_OP ~qualifier:StaticRO ~ty:(Ref _vm_appliance) ~default_value:(Some (VRef (Ref.string_of Ref.null))) "appliance" "the appliance to which this VM belongs";
 	field ~writer_roles:_R_POOL_OP ~qualifier:StaticRO ~in_product_since:rel_boston ~default_value:(Some (VInt 0L)) ~ty:Int "start_delay" "The delay to wait before proceeding to the next order in the startup sequence (seconds)";
 	field ~writer_roles:_R_POOL_OP ~qualifier:StaticRO ~in_product_since:rel_boston ~default_value:(Some (VInt 0L)) ~ty:Int "shutdown_delay" "The delay to wait before proceeding to the next order in the shutdown sequence (seconds)";
@@ -7797,6 +7817,143 @@ let vmpp =
     ]
     ()
 
+(* VM schedule snapshot *)
+let vmss_snapshot_now = call ~flags:[`Session]
+  ~name:"snapshot_now"
+  ~in_oss_since:None
+  ~in_product_since:rel_ely
+  ~params:[Ref _vmss, "vmss", "Snapshot Schedule to execute";]
+  ~doc:"This call executes the snapshot schedule immediately"
+  ~allowed_roles:_R_POOL_OP
+  ~result:(String, "An XMLRPC result")
+  ()
+
+let vmss_type = Enum ("vmss_type",
+  [
+    "snapshot", "The snapshot is a disk snapshot";
+    "checkpoint", "The snapshot is a checkpoint";
+    "snapshot_with_quiesce", "The snapshot is a VSS";
+  ])
+
+let vmss_frequency = Enum ("vmss_frequency",
+  [
+    "hourly", "Hourly snapshots";
+    "daily", "Daily snapshots";
+    "weekly", "Weekly snapshots";
+  ])
+
+let vmss_schedule_min = "min"
+let vmss_schedule_hour = "hour"
+let vmss_schedule_days = "days"
+
+let vmss_set_retained_snapshots = call ~flags:[`Session]
+  ~name:"set_retained_snapshots"
+  ~in_oss_since:None
+  ~in_product_since:rel_ely
+  ~allowed_roles:_R_POOL_OP
+  ~params:[
+    Ref _vmss, "self", "The schedule snapshot";
+    Int, "value", "the value to set"
+  ]
+  ()
+
+let vmss_set_frequency = call ~flags:[`Session]
+  ~name:"set_frequency"
+  ~in_oss_since:None
+  ~in_product_since:rel_ely
+  ~params:[
+    Ref _vmss, "self", "The snapshot schedule";
+    vmss_frequency, "value", "the snapshot schedule frequency"
+  ]
+  ~doc:"Set the value of the frequency field"
+  ~allowed_roles:_R_POOL_OP
+  ()
+
+let vmss_set_schedule = call ~flags:[`Session]
+  ~name:"set_schedule"
+  ~in_oss_since:None
+  ~in_product_since:rel_ely
+  ~allowed_roles:_R_POOL_OP
+  ~params:[
+    Ref _vmss, "self", "The snapshot schedule";
+    Map(String,String), "value", "the value to set"
+  ]
+  ()
+
+let vmss_set_last_run_time = call ~flags:[`Session]
+  ~name:"set_last_run_time"
+  ~in_oss_since:None
+  ~in_product_since:rel_ely
+  ~allowed_roles:_R_LOCAL_ROOT_ONLY
+  ~params:[
+    Ref _vmss, "self", "The snapshot schedule";
+    DateTime, "value", "the value to set"
+  ]
+  ()
+
+let vmss_add_to_schedule = call ~flags:[`Session]
+  ~name:"add_to_schedule"
+  ~in_oss_since:None
+  ~in_product_since:rel_ely
+  ~allowed_roles:_R_POOL_OP
+  ~params:[
+    Ref _vmss, "self", "The snapshot schedule";
+    String, "key", "the key to add";
+    String, "value", "the value to add";
+  ]
+  ()
+
+let vmss_remove_from_schedule = call ~flags:[`Session]
+  ~name:"remove_from_schedule"
+  ~in_oss_since:None
+  ~in_product_since:rel_ely
+  ~allowed_roles:_R_POOL_OP
+  ~params:[
+    Ref _vmss, "self", "The snapshot schedule";
+    String, "key", "the key to remove";
+  ]
+  ()
+
+let vmss_set_type = call ~flags:[`Session]
+  ~name:"set_type"
+  ~in_oss_since:None
+  ~in_product_since:rel_ely
+  ~allowed_roles:_R_POOL_OP
+  ~params:[
+    Ref _vmss, "self", "The snapshot schedule";
+    vmss_type, "value", "the snapshot schedule type"
+  ]
+  ()
+
+let vmss =
+  create_obj ~in_db:true ~in_oss_since:None ~internal_deprecated_since:None ~persist:PersistEverything ~gen_constructor_destructor:true ~name:_vmss ~descr:"VM Snapshot Schedule"
+    ~gen_events:true
+    ~in_product_since:rel_ely
+    ~doccomments:[]
+    ~messages_default_allowed_roles:_R_POOL_OP
+    ~messages:[
+      vmss_snapshot_now;
+      vmss_set_retained_snapshots;
+      vmss_set_frequency;
+      vmss_set_schedule;
+      vmss_add_to_schedule;
+      vmss_remove_from_schedule;
+      vmss_set_last_run_time;
+      vmss_set_type;
+    ]
+  ~contents:[
+    uid _vmss;
+    namespace ~name:"name" ~contents:(names None RW) ();
+    field ~qualifier:RW ~ty:Bool "enabled" "enable or disable this snapshot schedule" ~default_value:(Some (VBool true));
+    field ~qualifier:StaticRO ~ty:vmss_type "type" "type of the snapshot schedule";
+    field ~qualifier:StaticRO ~ty:Int "retained_snapshots" "maximum number of snapshots that should be stored at any time" ~default_value:(Some (VInt 7L));
+    field ~qualifier:StaticRO ~ty:vmss_frequency "frequency" "frequency of taking snapshot from snapshot schedule";
+    field ~qualifier:StaticRO ~ty:(Map (String,String)) "schedule" "schedule of the snapshot containing 'hour', 'min', 'days'. Date/time-related information is in Local Timezone" ~default_value:(Some (VMap []));
+    field ~qualifier:DynamicRO ~ty:DateTime "last_run_time" "time of the last snapshot" ~default_value:(Some(VDateTime(Date.of_float 0.)));
+    field ~qualifier:DynamicRO ~ty:(Set (Ref _vm)) "VMs" "all VMs attached to this snapshot schedule";
+  ]
+  ()
+
 (* VM appliance *)
 let vm_appliance_operations = Enum ("vm_appliance_operation",
 	[
@@ -8068,6 +8225,7 @@ let message =
 		   "SR", "SR";
 		   "Pool","Pool";
        "VMPP","VMPP";
+       "VMSS", "VMSS";
     ])
   in
   let create = call
@@ -8658,6 +8816,7 @@ let all_system =
 		vm_metrics;
 		vm_guest_metrics;
 		vmpp;
+		vmss;
 		vm_appliance;
 		dr_task;
 		host;
@@ -8757,6 +8916,7 @@ let all_relations =
     (_role, "subroles"), (_role, "subroles");
 
     (_vm, "protection_policy"), (_vmpp, "VMs");
+    (_vm, "snapshot_schedule"), (_vmss, "VMs");
     (_vm, "appliance"), (_vm_appliance, "VMs");
 
     (_pgpu, "GPU_group"), (_gpu_group, "PGPUs");
@@ -8850,6 +9010,7 @@ let expose_get_all_messages_for = [
 	_secret;
 	_tunnel;
 	_vmpp;
+	_vmss;
 	_vm_appliance;
 	_pci;
 	_pgpu;

ocaml/idl/ocaml_backend/event_helper.ml

@@ -41,6 +41,7 @@ type event_record =
     | Message of          [`message] Ref.t * API.message_t option
     | Secret of           [`secret] Ref.t * API.secret_t option
     | VMPP of             [`VMPP] Ref.t * API.vMPP_t option
+    | VMSS of             [`VMSS] Ref.t * API.vMSS_t option
 
 let maybe f x =
     match x with 
@@ -77,5 +78,6 @@ let record_of_event ev =
 		| "message" ->          Message (Ref.of_string ev.Event_types.reference, maybe (API.message_t_of_rpc) rpc)
 		| "secret" ->           Secret (Ref.of_string ev.Event_types.reference, maybe (API.secret_t_of_rpc) rpc)
 		| "vmpp" ->             VMPP (Ref.of_string ev.Event_types.reference, maybe (API.vMPP_t_of_rpc) rpc)
+		| "vmss" ->             VMSS (Ref.of_string ev.Event_types.reference, maybe (API.vMSS_t_of_rpc) rpc)
 		| _ -> failwith "unknown event type"