From a1473c08e3e7329ddee7e498bcbea7156c5bcdbe Mon Sep 17 00:00:00 2001 From: Marcus Granado Date: Mon, 23 Aug 2010 15:54:36 +0100 Subject: [PATCH] CP-1739: create XAPI datamodel stubs for PR-1031 (VM protection policy) Signed-off-by: Marcus Granado --- ocaml/idl/datamodel.ml | 136 ++++++- ocaml/xapi/OMakefile | 1 + ocaml/xapi/api_server.ml | 1 + ocaml/xapi/cli_operations.ml | 2 +- ocaml/xapi/create_misc.ml | 4 +- ocaml/xapi/create_templates.ml | 2 + ocaml/xapi/import_xva.ml | 1 + ocaml/xapi/message_forwarding.ml | 11 +- ocaml/xapi/xapi_host.ml | 14 + ocaml/xapi/xapi_host.mli | 1 + ocaml/xapi/xapi_pool.ml | 2 + ocaml/xapi/xapi_pool.mli | 2 + ocaml/xapi/xapi_vm.ml | 4 + ocaml/xapi/xapi_vm.mli | 5 +- ocaml/xapi/xapi_vm_clone.ml | 5 +- ocaml/xapi/xapi_vm_helpers.ml | 8 +- ocaml/xapi/xapi_vmpp.ml | 647 ++----------------------------- 17 files changed, 227 insertions(+), 619 deletions(-) diff --git a/ocaml/idl/datamodel.ml b/ocaml/idl/datamodel.ml index adee5c3e..8a612abb 100644 --- a/ocaml/idl/datamodel.ml +++ b/ocaml/idl/datamodel.ml @@ -60,6 +60,7 @@ let _sm = "SM" let _vm = "VM" let _vm_metrics = "VM_metrics" let _vm_guest_metrics = "VM_guest_metrics" +let _vmpp = "VMPP" let _network = "network" let _vif = "VIF" let _vif_metrics = "VIF_metrics" @@ -149,6 +150,12 @@ let get_product_releases in_product_since = | x::xs -> if x=in_product_since then "closed"::x::xs else go_through_release_order xs in go_through_release_order release_order +let cowley_release = + { internal=get_product_releases rel_cowley + ; opensource=get_oss_releases None + ; internal_deprecated_since=None + } + let midnight_ride_release = { internal=get_product_releases "midnight-ride" ; opensource=get_oss_releases None @@ -3410,6 +3417,16 @@ let host_get_servertime = call ~flags:[`Session] ~allowed_roles:_R_READ_ONLY () +let host_get_server_localtime = call ~flags:[`Session] + ~name:"get_server_localtime" + ~in_oss_since:None + ~in_product_since:rel_cowley + ~params:[Ref _host, "host", "The host whose clock should be queried"] + ~doc:"This call queries the host's clock for the current time in the host's local timezone" + ~result:(DateTime, "The current local time") + ~allowed_roles:_R_READ_ONLY + () + let host_emergency_ha_disable = call ~flags:[`Session] ~name:"emergency_ha_disable" ~in_oss_since:None @@ -3666,6 +3683,7 @@ let host = host_create_new_blob; host_call_plugin; host_get_servertime; + host_get_server_localtime; host_enable_binary_storage; host_disable_binary_storage; host_enable_external_auth; @@ -5246,6 +5264,17 @@ let pool_set_vswitch_controller = call ~allowed_roles:_R_POOL_OP () +let pool_test_archive_target = call ~flags:[`Session] + ~name:"test_archive_target" + ~in_oss_since:None + ~in_product_since:rel_cowley + ~params:[Ref _pool, "self", "Reference to the pool"; + Map(String,String), "config", "Location config settings to test"; + ] + ~doc:"This call tests if a location is valid" + ~allowed_roles:_R_POOL_OP + () + (** A pool class *) let pool = create_obj @@ -5307,6 +5336,7 @@ let pool = ; pool_disable_redo_log ; pool_audit_log_append ; pool_set_vswitch_controller + ; pool_test_archive_target ] ~contents: [uid ~in_oss_since:None _pool @@ -5759,6 +5789,8 @@ let vm = field ~writer_roles:_R_VM_POWER_ADMIN ~qualifier:DynamicRO ~in_product_since:rel_midnight_ride ~ty:(Set (Ref _vm)) "children" "List pointing to all the children of this 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:RW ~in_product_since:rel_cowley ~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 ~in_product_since:rel_cowley ~default_value:(Some (VBool false)) ~ty:Bool "is_snapshot_from_vmpp" "true if this snapshot was created by the protection policy"; ]) () @@ -5818,6 +5850,105 @@ let vm_guest_metrics = ] () +(* VM protection policy *) +let vmpp_protect_now = call ~flags:[`Session] + ~name:"protect_now" + ~in_oss_since:None + ~in_product_since:rel_cowley + ~params:[Ref _vmpp, "vmpp", "The protection policy to execute";] + ~doc:"This call executes the protection policy immediately" + ~allowed_roles:_R_POOL_OP + () +let vmpp_archive_now = call ~flags:[`Session] + ~name:"archive_now" + ~in_oss_since:None + ~in_product_since:rel_cowley + ~params:[Ref _vm, "snapshot", "The snapshot to archive";] + ~doc:"This call archives the snapshot provided as a parameter" + ~allowed_roles:_R_VM_POWER_ADMIN + () +let vmpp_backup_type = Enum ("vmpp_backup_type", + [ + "snapshot", "The backup is a snapshot"; + "checkpoint", "The backup is a checkpoint"; + ]) +let vmpp_backup_frequency = Enum ("vmpp_backup_frequency", + [ + "hourly", "Hourly backups"; + "daily", "Daily backups"; + "weekly", "Weekly backups"; + ]) +let vmpp_archive_frequency = Enum ("vmpp_archive_frequency", + [ + "never", "Never archive"; + "always_after_backup", "Archive after backup"; + "daily", "Daily archives"; + "weekly", "Weekly backups"; + ]) +let vmpp_archive_target_type = Enum ("vmpp_archive_target_type", + [ + "none", "No target config"; + "cifs", "CIFS target config"; + "nfs", "NFS target config"; + ]) +let vmpp_set_is_backup_running = call ~flags:[`Session] + ~name:"set_is_backup_running" + ~in_oss_since:None + ~in_product_since:rel_cowley + ~params:[ + Ref _vmpp, "self", "The protection policy"; + Bool, "value", "true to mark this protection policy's backup is running" + ] + ~doc:"This call marks that a protection policy's backup is running" + ~allowed_roles:_R_LOCAL_ROOT_ONLY + ~hide_from_docs:true + () +let vmpp_set_is_archive_running = call ~flags:[`Session] + ~name:"set_is_archive_running" + ~in_oss_since:None + ~in_product_since:rel_cowley + ~params:[ + Ref _vmpp, "self", "The protection policy"; + Bool, "value", "true to mark this protection policy's archive is running" + ] + ~doc:"This call marks that a protection policy's archive is running" + ~allowed_roles:_R_LOCAL_ROOT_ONLY + ~hide_from_docs:true + () +let vmpp = + create_obj ~in_db:true ~in_product_since:rel_cowley ~in_oss_since:None ~internal_deprecated_since:None ~persist:PersistEverything ~gen_constructor_destructor:true ~name:_vmpp ~descr:"VM Protection Policy" + ~gen_events:true + ~doccomments:[] + ~messages_default_allowed_roles:_R_POOL_OP + ~messages:[ + vmpp_protect_now; + vmpp_archive_now; + vmpp_set_is_backup_running; + vmpp_set_is_archive_running; + ] + ~contents:[ + uid _vmpp; + namespace ~name:"name" ~contents:(names None RW) (); + field ~qualifier:RW ~ty:Bool "is_policy_enabled" "enable or disable this policy" ~default_value:(Some (VBool true)); + field ~qualifier:RW ~ty:vmpp_backup_type "backup_type" "type of the backup sub-policy"; + field ~qualifier:RW ~ty:Int "backup_retention_value" "maximum number of backups that should be stored at any time" ~default_value:(Some (VInt 1L)); + field ~qualifier:RW ~ty:vmpp_backup_frequency "backup_frequency" "frequency of the backup schedule"; + field ~qualifier:RW ~ty:(Map (String,String)) "backup_schedule" "schedule of the backup containing 'frequency', 'hour', 'min', 'days'. Date/time-related information is in XenServer Local Timezone"; + field ~qualifier:DynamicRO ~ty:Bool "is_backup_running" "true if this protection policy's backup is running"; + field ~qualifier:RW ~ty:DateTime "backup_last_run_time" "time of the last backup" ~default_value:(Some(VDateTime(Date.of_float 0.))); + field ~qualifier:RW ~ty:vmpp_archive_target_type "archive_target_type" "type of the archive target config" ~default_value:(Some (VEnum "none")); + field ~qualifier:RW ~ty:(Map (String,String)) "archive_target_config" "configuration for the archive, including its 'type' in {'cifs','nfs'}" ~default_value:(Some (VMap [])); + field ~qualifier:RW ~ty:vmpp_archive_frequency "archive_frequency" "frequency of the archive schedule" ~default_value:(Some (VEnum "never")); + field ~qualifier:RW ~ty:(Map (String,String)) "archive_schedule" "schedule of the archive containing 'frequency', 'hour', 'min', 'days'. Date/time-related information is in XenServer Local Timezone" ~default_value:(Some (VMap [])); + field ~qualifier:DynamicRO ~ty:Bool "is_archive_running" "true if this protection policy's archive is running"; + field ~qualifier:RW ~ty:DateTime "archive_last_run_time" "time of the last archive" ~default_value:(Some(VDateTime(Date.of_float 0.))); + field ~qualifier:DynamicRO ~ty:(Set (Ref _vm)) "VMs" "all VMs attached to this protection policy"; + field ~qualifier:RW ~ty:Bool "is_alarm_enabled" "true if alarm is enabled for this policy" ~default_value:(Some (VBool false)); + field ~qualifier:RW ~ty:(Map (String,String)) "alarm_config" "configuration for the alarm" ~default_value:(Some (VMap [])); + field ~qualifier:DynamicRO ~ty:(Set (String)) "recent_alerts" "recent alerts" ~default_value:(Some (VSet [])); + ] + () + (** events handling: *) let event_operation = Enum ("event_operation", @@ -6089,6 +6220,7 @@ let all_system = vm; vm_metrics; vm_guest_metrics; + vmpp; host; host_crashdump; host_patch; @@ -6175,6 +6307,8 @@ let all_relations = (_subject, "roles"), (_subject, "roles"); (*(_subject, "roles"), (_role, "subjects");*) (_role, "subroles"), (_role, "subroles"); + + (_vm, "protection_policy"), (_vmpp, "VMs"); ] (** the full api specified here *) @@ -6218,7 +6352,7 @@ let no_async_messages_for = [ _session; _event; (* _alert; *) _task; _data_sourc or SR *) let expose_get_all_messages_for = [ _task; (* _alert; *) _host; _host_metrics; _hostcpu; _sr; _vm; _vm_metrics; _vm_guest_metrics; _network; _vif; _vif_metrics; _pif; _pif_metrics; _pbd; _vdi; _vbd; _vbd_metrics; _console; - _crashdump; _host_crashdump; _host_patch; _pool; _sm; _pool_patch; _bond; _vlan; _blob; _subject; _role; _secret; _tunnel ] + _crashdump; _host_crashdump; _host_patch; _pool; _sm; _pool_patch; _bond; _vlan; _blob; _subject; _role; _secret; _tunnel; _vmpp; ] let no_task_id_for = [ _task; (* _alert; *) _event ] diff --git a/ocaml/xapi/OMakefile b/ocaml/xapi/OMakefile index 6cfcb367..78cc5d25 100644 --- a/ocaml/xapi/OMakefile +++ b/ocaml/xapi/OMakefile @@ -110,6 +110,7 @@ XAPI_MODULES = $(COMMON) \ xapi_subject \ xapi_role \ audit_log \ + xapi_vmpp \ xapi_vm_lifecycle \ xapi_vm_clone \ xapi_vm_snapshot \ diff --git a/ocaml/xapi/api_server.ml b/ocaml/xapi/api_server.ml index ce8427ff..9c728a40 100644 --- a/ocaml/xapi/api_server.ml +++ b/ocaml/xapi/api_server.ml @@ -34,6 +34,7 @@ module Actions = struct end module VM_metrics = struct end module VM_guest_metrics = struct end + module VMPP = Xapi_vmpp module Host = Xapi_host module Host_crashdump = Xapi_host_crashdump diff --git a/ocaml/xapi/cli_operations.ml b/ocaml/xapi/cli_operations.ml index 67575c36..58749e26 100644 --- a/ocaml/xapi/cli_operations.ml +++ b/ocaml/xapi/cli_operations.ml @@ -1434,7 +1434,7 @@ let vm_create printer rpc session_id params = ~actions_after_shutdown:`destroy ~actions_after_reboot:`restart ~actions_after_crash:`destroy ~pV_bootloader:"" ~pV_kernel:"" ~pV_ramdisk:"" ~pV_args:"" ~pV_bootloader_args:"" ~pV_legacy_args:"" ~hVM_boot_policy:"" ~hVM_boot_params:[] ~hVM_shadow_multiplier:1. ~platform:[] ~pCI_bus:"" ~other_config:[] ~xenstore_data:[] ~recommendations:"" ~ha_always_run:false ~ha_restart_priority:"" - ~tags:[] in + ~tags:[] ~protection_policy:Ref.null ~is_snapshot_from_vmpp:false in let uuid=Client.VM.get_uuid rpc session_id vm in printer (Cli_printer.PList [uuid]) diff --git a/ocaml/xapi/create_misc.ml b/ocaml/xapi/create_misc.ml index 4bc8c525..25d5ee73 100644 --- a/ocaml/xapi/create_misc.ml +++ b/ocaml/xapi/create_misc.ml @@ -174,7 +174,9 @@ and create_domain_zero_record ~__context ~domain_zero_ref = ~ha_restart_priority:"" ~ha_always_run:false ~recommendations:"" ~last_boot_CPU_flags:[] ~last_booted_record:"" ~guest_metrics:Ref.null ~metrics - ~bios_strings:[]; + ~bios_strings:[] ~protection_policy:Ref.null + ~is_snapshot_from_vmpp:false + ; Xapi_vm_helpers.update_memory_overhead ~__context ~vm:domain_zero_ref and create_domain_zero_console_record ~__context ~domain_zero_ref = diff --git a/ocaml/xapi/create_templates.ml b/ocaml/xapi/create_templates.ml index 5997736f..5c3d0a3f 100644 --- a/ocaml/xapi/create_templates.ml +++ b/ocaml/xapi/create_templates.ml @@ -208,6 +208,8 @@ let blank_template memory = { vM_tags = []; vM_bios_strings = []; + vM_protection_policy = Ref.null; + vM_is_snapshot_from_vmpp = false; } let other_install_media_template memory = diff --git a/ocaml/xapi/import_xva.ml b/ocaml/xapi/import_xva.ml index 5824afa5..5bcb567f 100644 --- a/ocaml/xapi/import_xva.ml +++ b/ocaml/xapi/import_xva.ml @@ -82,6 +82,7 @@ let make __context rpc session_id srid (vms, vdis) = ~pV_args:"" ~pCI_bus:"" ~other_config:[] ~xenstore_data:[] ~recommendations:"" ~ha_always_run:false ~ha_restart_priority:"" ~tags:[] + ~protection_policy:Ref.null ~is_snapshot_from_vmpp:false in TaskHelper.operate_on_db_task ~__context diff --git a/ocaml/xapi/message_forwarding.ml b/ocaml/xapi/message_forwarding.ml index 3f801fef..441a813d 100644 --- a/ocaml/xapi/message_forwarding.ml +++ b/ocaml/xapi/message_forwarding.ml @@ -505,6 +505,7 @@ module Forward = functor(Local: Custom_actions.CUSTOM_ACTIONS) -> struct module Role = Local.Role module Task = Local.Task module Event = Local.Event + module VMPP = Local.VMPP (* module Alert = Local.Alert *) module Pool = struct @@ -850,9 +851,9 @@ module Forward = functor(Local: Custom_actions.CUSTOM_ACTIONS) -> struct (* -------------------------------------------------------------------------- *) (* don't forward create. this just makes a db record *) - let create ~__context ~name_label ~name_description ~user_version ~is_a_template ~affinity ~memory_target ~memory_static_max ~memory_dynamic_max ~memory_dynamic_min ~memory_static_min ~vCPUs_params ~vCPUs_max ~vCPUs_at_startup ~actions_after_shutdown ~actions_after_reboot ~actions_after_crash ~pV_bootloader ~pV_kernel ~pV_ramdisk ~pV_args ~pV_bootloader_args ~pV_legacy_args ~hVM_boot_policy ~hVM_boot_params ~hVM_shadow_multiplier ~platform ~pCI_bus ~other_config ~recommendations ~xenstore_data ~ha_always_run ~ha_restart_priority ~tags ~blocked_operations = + let create ~__context ~name_label ~name_description ~user_version ~is_a_template ~affinity ~memory_target ~memory_static_max ~memory_dynamic_max ~memory_dynamic_min ~memory_static_min ~vCPUs_params ~vCPUs_max ~vCPUs_at_startup ~actions_after_shutdown ~actions_after_reboot ~actions_after_crash ~pV_bootloader ~pV_kernel ~pV_ramdisk ~pV_args ~pV_bootloader_args ~pV_legacy_args ~hVM_boot_policy ~hVM_boot_params ~hVM_shadow_multiplier ~platform ~pCI_bus ~other_config ~recommendations ~xenstore_data ~ha_always_run ~ha_restart_priority ~tags ~blocked_operations ~protection_policy = info "VM.create: name_label = '%s' name_description = '%s'" name_label name_description; - Local.VM.create ~__context ~name_label ~name_description ~user_version ~is_a_template ~affinity ~memory_target ~memory_static_max ~memory_dynamic_max ~memory_dynamic_min ~memory_static_min ~vCPUs_params ~vCPUs_max ~vCPUs_at_startup ~actions_after_shutdown ~actions_after_reboot ~actions_after_crash ~pV_bootloader ~pV_kernel ~pV_ramdisk ~pV_args ~pV_bootloader_args ~pV_legacy_args ~hVM_boot_policy ~hVM_boot_params ~hVM_shadow_multiplier ~platform ~pCI_bus ~other_config ~recommendations ~xenstore_data ~ha_always_run ~ha_restart_priority ~tags ~blocked_operations + Local.VM.create ~__context ~name_label ~name_description ~user_version ~is_a_template ~affinity ~memory_target ~memory_static_max ~memory_dynamic_max ~memory_dynamic_min ~memory_static_min ~vCPUs_params ~vCPUs_max ~vCPUs_at_startup ~actions_after_shutdown ~actions_after_reboot ~actions_after_crash ~pV_bootloader ~pV_kernel ~pV_ramdisk ~pV_args ~pV_bootloader_args ~pV_legacy_args ~hVM_boot_policy ~hVM_boot_params ~hVM_shadow_multiplier ~platform ~pCI_bus ~other_config ~recommendations ~xenstore_data ~ha_always_run ~ha_restart_priority ~tags ~blocked_operations ~protection_policy (* don't forward destroy. this just deletes db record *) let destroy ~__context ~self = @@ -2068,6 +2069,12 @@ module Forward = functor(Local: Custom_actions.CUSTOM_ACTIONS) -> struct do_op_on ~local_fn ~__context ~host (fun session_id rpc -> Client.Host.get_servertime rpc session_id host) + let get_server_localtime ~__context ~host = + (* info "Host.get_servertime"; *) (* suppressed because the GUI calls this frequently and it isn't interesting for debugging *) + let local_fn = Local.Host.get_server_localtime ~host in + do_op_on ~local_fn ~__context ~host + (fun session_id rpc -> Client.Host.get_server_localtime rpc session_id host) + let enable_binary_storage ~__context ~host = info "Host.enable_binary_storage: host = '%s'" (host_uuid ~__context host); let local_fn = Local.Host.enable_binary_storage ~host in diff --git a/ocaml/xapi/xapi_host.ml b/ocaml/xapi/xapi_host.ml index 49455141..3b3a1b9f 100644 --- a/ocaml/xapi/xapi_host.ml +++ b/ocaml/xapi/xapi_host.ml @@ -928,6 +928,20 @@ let backup_rrds ~__context ~host ~delay = let get_servertime ~__context ~host = Date.of_float (Unix.gettimeofday ()) +let get_server_localtime ~__context ~host = + let gmt_time= Unix.gettimeofday () in + let local_time = Unix.localtime gmt_time in + Date.of_string + ( + Printf.sprintf "%04d%02d%02dT%02d:%02d:%02d" + (local_time.Unix.tm_year+1900) + (local_time.Unix.tm_mon+1) + local_time.Unix.tm_mday + local_time.Unix.tm_hour + local_time.Unix.tm_min + local_time.Unix.tm_sec + ) + let enable_binary_storage ~__context ~host = Unixext.mkdir_safe Xapi_globs.xapi_blob_location 0o700; Db.Host.remove_from_other_config ~__context ~self:host ~key:Xapi_globs.host_no_local_storage diff --git a/ocaml/xapi/xapi_host.mli b/ocaml/xapi/xapi_host.mli index 59727a5d..cf1f2ae3 100644 --- a/ocaml/xapi/xapi_host.mli +++ b/ocaml/xapi/xapi_host.mli @@ -168,6 +168,7 @@ val call_plugin : val sync_data : __context:Context.t -> host:API.ref_host -> unit val backup_rrds : __context:'a -> host:'b -> delay:float -> unit val get_servertime : __context:'a -> host:'b -> Date.iso8601 +val get_server_localtime : __context:'a -> host:'b -> Date.iso8601 val enable_binary_storage : __context:Context.t -> host:[ `host ] Ref.t -> unit val disable_binary_storage : diff --git a/ocaml/xapi/xapi_pool.ml b/ocaml/xapi/xapi_pool.ml index 52099d01..872dee99 100644 --- a/ocaml/xapi/xapi_pool.ml +++ b/ocaml/xapi/xapi_pool.ml @@ -1456,3 +1456,5 @@ let audit_log_append ~__context ~line = (* copy audit record from slave exactly as it is, without any new prefixes *) Rbac_audit.append_line ~raw:true "%s" line; () + +let test_archive_target ~__context ~self ~config = () diff --git a/ocaml/xapi/xapi_pool.mli b/ocaml/xapi/xapi_pool.mli index 672d2566..eafd422b 100644 --- a/ocaml/xapi/xapi_pool.mli +++ b/ocaml/xapi/xapi_pool.mli @@ -192,3 +192,5 @@ val disable_redo_log : __context:Context.t -> unit (** VSwitch Controller *) val set_vswitch_controller : __context:Context.t -> address:string -> unit val audit_log_append : __context:Context.t -> line:string -> unit + +val test_archive_target : __context:Context.t -> self:API.ref_pool -> config:API.string_to_string_map -> unit diff --git a/ocaml/xapi/xapi_vm.ml b/ocaml/xapi/xapi_vm.ml index 029517dc..12b62454 100644 --- a/ocaml/xapi/xapi_vm.ml +++ b/ocaml/xapi/xapi_vm.ml @@ -822,6 +822,8 @@ let create ~__context ~ha_restart_priority ~tags ~blocked_operations + ~protection_policy + ~is_snapshot_from_vmpp : API.ref_VM = let gen_mac_seed () = Uuid.to_string (Uuid.make_uuid ()) in (* Add random mac_seed if there isn't one specified already *) @@ -864,6 +866,8 @@ let create ~__context ~ha_restart_priority ~tags ~blocked_operations + ~protection_policy + ~is_snapshot_from_vmpp let destroy ~__context ~self = let parent = Db.VM.get_parent ~__context ~self in diff --git a/ocaml/xapi/xapi_vm.mli b/ocaml/xapi/xapi_vm.mli index 0b3e9698..243e691c 100644 --- a/ocaml/xapi/xapi_vm.mli +++ b/ocaml/xapi/xapi_vm.mli @@ -181,7 +181,10 @@ val create : xenstore_data:(string * string) list -> ha_always_run:bool -> ha_restart_priority:string -> - tags:string list -> blocked_operations:'a -> API.ref_VM + tags:string list -> blocked_operations:'a -> + protection_policy:[ `VMPP ] Ref.t -> + is_snapshot_from_vmpp:bool +-> API.ref_VM val destroy : __context:Context.t -> self:[ `VM ] Ref.t -> unit val clone : __context:Context.t -> vm:API.ref_VM -> new_name:string -> [ `VM ] Ref.t diff --git a/ocaml/xapi/xapi_vm_clone.ml b/ocaml/xapi/xapi_vm_clone.ml index ddf93835..53279b40 100644 --- a/ocaml/xapi/xapi_vm_clone.ml +++ b/ocaml/xapi/xapi_vm_clone.ml @@ -307,7 +307,10 @@ let copy_vm_record ~__context ~vm ~disk_op ~new_name ~new_power_state = ~ha_restart_priority:all.Db_actions.vM_ha_restart_priority ~ha_always_run:false ~tags:all.Db_actions.vM_tags - ~bios_strings:all.Db_actions.vM_bios_strings; + ~bios_strings:all.Db_actions.vM_bios_strings + ~protection_policy:Ref.null + ~is_snapshot_from_vmpp:false(*from_protection_policy*) + ; ref, uuid diff --git a/ocaml/xapi/xapi_vm_helpers.ml b/ocaml/xapi/xapi_vm_helpers.ml index b34d6b8e..993bd918 100644 --- a/ocaml/xapi/xapi_vm_helpers.ml +++ b/ocaml/xapi/xapi_vm_helpers.ml @@ -115,7 +115,8 @@ let create ~__context ~name_label ~name_description ~platform ~pCI_bus ~other_config ~xenstore_data ~recommendations ~ha_always_run ~ha_restart_priority ~tags - ~blocked_operations + ~blocked_operations ~protection_policy + ~is_snapshot_from_vmpp : API.ref_VM = (* NB parameter validation is delayed until VM.start *) @@ -175,7 +176,10 @@ let create ~__context ~name_label ~name_description ~blobs:[] ~ha_restart_priority ~ha_always_run ~tags - ~bios_strings:[]; + ~bios_strings:[] + ~protection_policy:Ref.null + ~is_snapshot_from_vmpp:false + ; Db.VM.set_power_state ~__context ~self:vm_ref ~value:`Halted; Xapi_vm_lifecycle.update_allowed_operations ~__context ~self:vm_ref; update_memory_overhead ~__context ~vm:vm_ref; diff --git a/ocaml/xapi/xapi_vmpp.ml b/ocaml/xapi/xapi_vmpp.ml index facb44f5..d4bfd5e0 100644 --- a/ocaml/xapi/xapi_vmpp.ml +++ b/ocaml/xapi/xapi_vmpp.ml @@ -14,629 +14,56 @@ module D = Debug.Debugger(struct let name="xapi" end) open D -let vmpr_plugin = "vmpr" -let vmpr_username = "__dom0__vmpr" - -let assert_licensed ~__context = - if (not (Features.is_enabled ~__context Features.VMPR)) - then - raise (Api_errors.Server_error(Api_errors.license_restriction, [])) - -let protect_now ~__context ~vmpp = - assert_licensed ~__context; - let vmpp_uuid = Db.VMPP.get_uuid ~__context ~self:vmpp in - let args = [ "vmpp_uuid", vmpp_uuid ] in - Xapi_plugins.call_plugin - (Context.get_session_id __context) - vmpr_plugin - "protect_now" - args - -let archive_now ~__context ~snapshot = - assert_licensed ~__context; - let snapshot_uuid = Db.VM.get_uuid ~__context ~self:snapshot in - let args = [ "snapshot_uuid", snapshot_uuid ] in - Xapi_plugins.call_plugin - (Context.get_session_id __context) - vmpr_plugin - "archive_now" - args - -let add_to_recent_alerts ~__context ~vmpp ~value = - assert_licensed ~__context; - let recent_alerts = value :: - (Db.VMPP.get_recent_alerts ~__context ~self:vmpp) - in - (* keep up to 10 elements in the set *) - let rec trunc i alerts = - if i<1 then [] - else match alerts with [] -> []|x::xs -> x::(trunc (i-1) xs) - in - Db.VMPP.set_recent_alerts ~__context ~self:vmpp - ~value:(trunc 10 recent_alerts) - -let create_alert ~__context ~vmpp ~name ~priority ~body ~data = - assert_licensed ~__context; - let value = - (*""^body^""^data^""*) - data - in - let successful = priority < 5L in - if successful - then ( (* alert indicates a vmpp success *) - add_to_recent_alerts ~__context ~vmpp ~value; - ) - else ( (* alert indicates a vmpp failure *) - add_to_recent_alerts ~__context ~vmpp ~value; - let cls = `VMPP in - let obj_uuid = Db.VMPP.get_uuid ~__context ~self:vmpp in - Xapi_message.create ~__context ~name ~priority ~cls ~obj_uuid ~body; - () - ) - -let unzip b64zdata = (* todo: remove i/o, make this more efficient *) - try - let zdata = Base64.decode b64zdata in - let tmp_path = Filename.temp_file "unzip-" ".dat" in - let data = ref "" in - Pervasiveext.finally - (fun ()-> - let fd = Unix.openfile tmp_path [ Unix.O_RDWR] 0o600 in - Pervasiveext.finally - (fun ()->Unix.write fd zdata 0 (String.length zdata);) - (fun ()->Unix.close fd;) - ; - Unixext.with_file tmp_path [ Unix.O_RDONLY ] 0o0 - (fun gz_fd_in -> - Gzip.decompress_passive gz_fd_in - (fun fd_in -> (*fd_in is closed by gzip module*) - let cin = Unix.in_channel_of_descr fd_in in - try - while true do - let line = input_line cin in - data := !data ^ line - done - with End_of_file -> () (* ok, expected *) - ) - ) - ) - (fun ()->Sys.remove tmp_path) - ; - (Some !data) - with e-> - debug "error %s unzipping zdata: %s" (ExnHelper.string_of_exn e) b64zdata; - None - -let get_alerts ~__context ~vmpp ~hours_from_now = - let vmpp_uuid = Db.VMPP.get_uuid ~__context ~self:vmpp in - let filter=["unix-RPC|VMPP.create_alert";vmpr_username;vmpp_uuid] in - let tmp_filename = Filename.temp_file "vmpp-alerts-" ".dat" in - let fd = Unix.openfile tmp_filename [Unix.O_RDWR] 0o600 in - let now = (Unix.time ()) in - let since = Date.to_string (Date.of_float (now -. ( (Int64.to_float hours_from_now) *. 3600.0))) in - let messages=Audit_log.transfer_all_audit_files fd ~filter since in - let cout = Unix.out_channel_of_descr fd in - flush cout; - let cin = Unix.in_channel_of_descr fd in - seek_in cin 0; - let lines = ref [] in - let i = ref 0 in (* hard limit on maximum number of lines to parse *) - (try while !i<1000 do let line = input_line cin in lines:=line::!lines; i:=!i+1 done with End_of_file->()); - let lines = !lines in - Unix.close fd; - Sys.remove tmp_filename; - let alerts = List.map (fun line-> - let sexpr_init = try (String.index line ']')+1 with Not_found -> -1 in - if sexpr_init>=0 && sexpr_init<(String.length line) then ( - let sexpr_str = Stringext.String.sub_to_end line sexpr_init in - let (sroot:SExpr.t) = - (try SExpr_TS.of_string sexpr_str - with e-> - debug "error %s parsing sexpr: %s" - (ExnHelper.string_of_exn e) sexpr_str - ; - (SExpr.Node []) - ) - in - match sroot with - |SExpr.Node (SExpr.String _::SExpr.String _::SExpr.String _::SExpr.String _::SExpr.String _::SExpr.String _::SExpr.String _::SExpr.Node params::[])->( - let kvs = List.fold_right (fun (sexpr:SExpr.t) acc -> - match sexpr with - |SExpr.Node (SExpr.String name::SExpr.String value::SExpr.String _::SExpr.String _::[]) when name="data"-> - (name,value)::acc - |_->acc - ) params [] - in - if kvs=[] then None else Some kvs - ) - |_->None - ) - else None - ) lines - in - let alerts = List.fold_right (fun a acc->match a with None->acc|Some a->a::acc) alerts [] in - let alerts = List.fold_right (fun a acc->if List.mem_assoc "data" a then (let data=(unzip(List.assoc "data" a)) in match data with None->acc|Some data->data::acc) else acc) alerts [] in - alerts - -let set_is_backup_running ~__context ~self ~value = - assert_licensed ~__context; - Db.VMPP.set_is_backup_running ~__context ~self ~value - -let set_is_archive_running ~__context ~self ~value = - assert_licensed ~__context; - Db.VMPP.set_is_archive_running ~__context ~self ~value - -(* mini datamodel for type and key value restrictions in the vmpp map fields *) -type key_type = Enum of string list | EnumSet of string list | IntRange of int*int | String | ReqValue of string | Secret -let schedule_days_enum = ["Monday";"Tuesday";"Wednesday";"Thursday";"Friday";"Saturday";"Sunday"] -let schedule_frequency_hourly = "hourly" -let schedule_frequency_daily = "daily" -let schedule_frequency_weekly = "weekly" -let frequency_order = [schedule_frequency_hourly;schedule_frequency_daily;schedule_frequency_weekly] -let schedule_min_enum = ["0";"15";"30";"45"] -let backup_schedule_field = "backup-schedule" -let archive_target_config_field = "archive-target-config" -let archive_schedule_field = "archive-schedule" -let alarm_config_field = "alarm-config" -let archive_target_type_cifs = "cifs" -let archive_target_type_nfs = "nfs" -let is_alarm_enabled_true = "true" -let is_alarm_enabled_false = "false" -let btype b = if b then is_alarm_enabled_true else is_alarm_enabled_false -let schedule_min_default = List.hd schedule_min_enum -let schedule_hour_default = "0" -let schedule_days_default = List.hd schedule_days_enum - -let more_frequent_than ~a ~b = (* is a more frequent than b? *) - if a=b then false - else - if (List.mem a frequency_order) && (List.mem b frequency_order) - then (let rec tst xs = match xs with - |[]->false - |x::xs->if a=x then true else if b=x then false else tst xs - in tst frequency_order - ) - else false (*incomparable*) - -(* relations between map types and map keys *) -let archive_schedule_frequency_enum = [schedule_frequency_daily;schedule_frequency_weekly] -let backup_schedule_frequency_enum = schedule_frequency_hourly :: archive_schedule_frequency_enum -let backup_schedule_frequency_hourly_keys = backup_schedule_field,[schedule_frequency_hourly,[Datamodel.vmpp_schedule_min, ((Enum schedule_min_enum), schedule_min_default)]] -let backup_schedule_frequency_daily_keys = backup_schedule_field,[schedule_frequency_daily,[Datamodel.vmpp_schedule_hour, ((IntRange(0,23)), schedule_hour_default);Datamodel.vmpp_schedule_min, ((Enum schedule_min_enum), schedule_min_default)]] -let backup_schedule_frequency_weekly_keys = backup_schedule_field,[schedule_frequency_weekly,[Datamodel.vmpp_schedule_hour, ((IntRange(0,23)), schedule_hour_default);Datamodel.vmpp_schedule_min, ((Enum schedule_min_enum), schedule_min_default);Datamodel.vmpp_schedule_days, ((EnumSet schedule_days_enum), schedule_days_default)]] -let archive_schedule_frequency_daily_keys = match backup_schedule_frequency_daily_keys with f,k -> archive_schedule_field,k -let archive_schedule_frequency_weekly_keys = match backup_schedule_frequency_weekly_keys with f,k -> archive_schedule_field,k -let archive_target_config_type_cifs_keys = archive_target_config_field,[archive_target_type_cifs,[Datamodel.vmpp_archive_target_config_location, ((String), "");Datamodel.vmpp_archive_target_config_username, ((String), "");Datamodel.vmpp_archive_target_config_password, ((Secret), "")]] -let archive_target_config_type_nfs_keys = archive_target_config_field,[archive_target_type_nfs,[Datamodel.vmpp_archive_target_config_location, ((String), "")]] - -(* look-up structures, contain allowed map keys in a specific map type *) -let backup_schedule_keys = backup_schedule_field,(List.map (fun (f,[k])->k) [backup_schedule_frequency_hourly_keys;backup_schedule_frequency_daily_keys;backup_schedule_frequency_weekly_keys]) -let archive_target_config_keys = archive_target_config_field,(List.map (fun (f,[k])->k) [archive_target_config_type_cifs_keys;archive_target_config_type_nfs_keys]) -let archive_schedule_keys = archive_schedule_field,(List.map (fun (f,[k])->k) [archive_schedule_frequency_daily_keys;archive_schedule_frequency_weekly_keys]) -let alarm_config_keys = alarm_config_field,[is_alarm_enabled_true,["email_address", ((String), "");"smtp_server", ((String), "");"smtp_port", ((IntRange(1,65535)), "25")]] - -(* look-up structures, contain allowed map keys in all map types *) -let backup_schedule_all_keys = backup_schedule_field,["",(List.fold_left (fun acc (sf,ks)->acc@ks) [] (let (f,kss)=backup_schedule_keys in kss))] -let archive_target_config_all_keys = archive_target_config_field,["",(List.fold_left (fun acc (sf,ks)->acc@ks) [] (let (f,kss)=archive_target_config_keys in kss))] -let archive_schedule_all_keys = archive_schedule_field,["",(List.fold_left (fun acc (sf,ks)->acc@ks) [] (let (f,kss)=archive_schedule_keys in kss))] -let alarm_config_all_keys = alarm_config_field,["",(List.fold_left (fun acc (sf,ks)->acc@ks) [] (let (f,kss)=alarm_config_keys in kss))] - -(* functions to assert the mini datamodel above *) - -let err field key value = - let msg = if key="" then field else field^":"^key in - raise (Api_errors.Server_error (Api_errors.invalid_value, [msg;value])) - -let mem value range = - try Some - (List.find - (fun r->(String.lowercase value)=(String.lowercase r)) - range - ) - with Not_found -> None - -let assert_value ~field ~key ~attr ~value = - let err v = err field key v in - let (ty,default) = attr in - match ty with - | Enum range -> (match (mem value range) with None->err value|Some v->v) - | EnumSet range -> (* enumset is a comma-separated string *) - let vs = Stringext.String.split ',' value in - List.fold_right - (fun v acc->match (mem v range) with - |None->err v - |Some v->if acc="" then v else (v^","^acc) - ) - vs - "" - | IntRange (min,max) -> - let v=try int_of_string value with _->err value in - if (vmax) then err value else value - | ReqValue required_value -> if value <> required_value then err value else value - | Secret|String -> value - -let with_ks ~kss ~fn = - let field,kss=kss in - let corrected_values = List.filter (fun cv->cv<>None) (List.map (fun ks-> fn field ks) kss) in - if List.length corrected_values < 1 - then [] - else (match List.hd corrected_values with None->[]|Some cv->cv) - -let assert_req_values ~field ~ks ~vs = - (* each required values in this ks must match the one in the vs map this key/value belongs to*) - let req_values = List.fold_right - (fun (k,attr) acc->match attr with(ReqValue rv),_->(k,rv)::acc|_->acc) ks [] - in - (if vs<>[] then - List.iter (fun (k,rv)-> - if (List.mem_assoc k vs) then (if rv<>(List.assoc k vs) then err field k rv) - ) req_values - ) - -let merge xs ys = (* uses xs elements to overwrite ys elements *) - let nys = List.map (fun (ky,vy)->if List.mem_assoc ky xs then (ky,(List.assoc ky xs)) else (ky,vy)) ys in - let nxs = List.filter (fun (kx,_)->not(List.mem_assoc kx nys)) xs in - nxs@nys - -let assert_key ~field ~ks ~key ~value = - debug "assert_key: field=%s key=[%s] value=[%s]" field key value; - (* check if the key and value conform to this ks *) - (if not (List.mem_assoc key ks) - then - err field key value - else - assert_value ~field ~key ~attr:(List.assoc key ks) ~value - ) - -let assert_keys ~ty ~ks ~value ~db = - let value = merge value db in - with_ks ~kss:ks ~fn: - (fun field (xt,ks) -> - debug "assert_keys: field=%s xt=[%s] ty=[%s]" field xt ty; - if (xt=ty) then Some - ( - assert_req_values ~field ~ks ~vs:value; - (* for this ks, each key value must be valid *) - List.map (fun (k,v)-> k,(assert_key ~field ~ks ~key:k ~value:v)) value - ) - else None - ) - -let assert_all_keys ~ty ~ks ~value ~db = - let value = merge value db in - with_ks ~kss:ks ~fn: - (fun field (xt,ks)-> - debug "assert_all_keys: field=%s xt=[%s] ty=[%s]" field xt ty; - if (xt=ty) then Some - ( - assert_req_values ~field ~ks ~vs:value; - -(* - currently disabled: too strong for api-bindings: - - api-bindings change first the type, and later the maps, - - so we cannot currently assert that all map keys are present: - - (* for this ks, all keys must be present *) - let ks_keys = Listext.List.setify (let (x,y)=List.split ks in x) in - let value_keys = Listext.List.setify (let (x,y)=List.split value in x) in - let diff = Listext.List.set_difference ks_keys value_keys in - (if diff<>[] then err field (List.hd diff) ""); -*) - - (* add missing keys with default values *) - let value = List.map (fun (k,(kt,default))->if List.mem_assoc k value then (k,(List.assoc k value)) else (k,default)) ks in - - (* remove extra unexpected keys *) - let value = List.fold_right (fun (k,v) acc->if List.mem_assoc k ks then (k,v)::acc else acc) value [] in - - (* for this ks, each key value must be valid *) - List.map (fun (k,v)-> k,(assert_key ~field ~ks ~key:k ~value:v)) value - ) - else None - ) - -let assert_non_required_key ~ks ~key ~db = - () -(* (* currently disabled: unfortunately, key presence integrity is too strict for the CLI, which needs to remove and add keys at will *) - with_ks ~kss:ks ~fn: - (fun ks-> - assert_req_values ~ks ~key ~value:"" ~db; - (* check if the key is not expected in this ks *) - if (List.mem_assoc key ks) then err key "" - ) +(* + val protect_now : __context:Context.t -> self:ref_VMPP -> unit + val archive_now : __context:Context.t -> self:ref_VM -> unit + val test_archive_settings : + __context:Context.t -> settings:API.string_to_string_map -> unit + val create : + __context:Context.t -> + name_label:string -> + name_description:string -> + is_policy_enabled:bool -> + backup_frequency:API.vmpp_backup_frequency -> + backup_retention_value:int64 -> + backup_schedule:API.string_to_string_map -> + backup_last_run_time:API.datetime -> + archive_target_config_type:API.vmpp_archive_target_config_type -> + archive_target_config:API.string_to_string_map -> + archive_frequency:API.vmpp_archive_frequency -> + archive_schedule:API.string_to_string_map -> + archive_last_run_time:API.datetime -> + is_alarm_enabled:bool -> + alarm_config:API.string_to_string_map -> API.ref_VMPP + val destroy : __context:Context.t -> self:API.ref_VMPP -> unit *) -let map_password_to_secret ~__context ~new_password ~db = - let secret_uuid = Uuid.to_string - (if List.mem_assoc Datamodel.vmpp_archive_target_config_password db - then - Uuid.of_string - (List.assoc Datamodel.vmpp_archive_target_config_password db) - else - Uuid.null - ) - in - try - let secret_ref = Db.Secret.get_by_uuid ~__context ~uuid:secret_uuid in - (* the uuid is a valid uuid in the secrets table *) - (if (new_password <> secret_uuid) - then (* new_password is not the secret uuid, then update secret *) - Db.Secret.set_value ~__context ~self:secret_ref ~value:new_password - ); - secret_uuid - with e -> ( - (* uuid doesn't exist in secrets table, create a new one *) - ignore (ExnHelper.string_of_exn e); - let new_secret_ref = Ref.make() in - let new_secret_uuid = Uuid.to_string(Uuid.make_uuid()) in - Db.Secret.create ~__context ~ref:new_secret_ref ~uuid:new_secret_uuid ~value:new_password; - new_secret_uuid - ) - -let map_any_passwords_to_secrets ~__context ~value ~db = - if List.mem_assoc Datamodel.vmpp_archive_target_config_password value - then - let secret = map_password_to_secret ~__context ~db - ~new_password:(List.assoc Datamodel.vmpp_archive_target_config_password value) - in - merge [(Datamodel.vmpp_archive_target_config_password,secret)] value - else - value - -let remove_any_secrets ~__context ~config ~key = - if List.mem_assoc key config - then - let secret_uuid = List.assoc key config in - try - let secret_ref = Db.Secret.get_by_uuid ~__context ~uuid:secret_uuid in - Db.Secret.destroy ~__context ~self:secret_ref - with _ -> (* uuid doesn't exist in secrets table, leave it alone *) - () - -let assert_set_backup_frequency ~backup_frequency ~backup_schedule= - let ty = XMLRPC.From.string (API.To.vmpp_backup_frequency backup_frequency) in - assert_all_keys ~ty ~ks:backup_schedule_keys ~value:backup_schedule ~db:backup_schedule - -let assert_archive_target_type_not_none ~archive_target_type ~archive_target_config = - let ty = XMLRPC.From.string (API.To.vmpp_archive_target_type archive_target_type) in - let archive_target_config = assert_all_keys ~ty ~ks:archive_target_config_keys ~value:archive_target_config ~db:archive_target_config in - archive_target_config - -let assert_archive_target_type ~archive_target_type ~archive_target_config ~archive_frequency ~archive_schedule = - match archive_target_type with - | `none -> (* reset archive_frequency to never *) - ([], `never, []) - | _-> - let archive_target_config = assert_archive_target_type_not_none ~archive_target_type ~archive_target_config in - (archive_target_config,archive_frequency,archive_schedule) - -let assert_set_archive_frequency ~archive_frequency ~archive_target_type ~archive_target_config ~archive_schedule = - match archive_target_type with - |`none -> ( - match archive_frequency with - |`never-> ([],[]) - |_->err "archive_target_type" "" (XMLRPC.From.string (API.To.vmpp_archive_target_type archive_target_type)) - ) - |_ -> ( - match archive_frequency with - |`never -> (archive_target_config,[]) - |`always_after_backup -> - let archive_target_config = assert_archive_target_type_not_none ~archive_target_type ~archive_target_config in - (archive_target_config,[]) - | _ -> - let archive_target_config = assert_archive_target_type_not_none ~archive_target_type ~archive_target_config in - let ty = XMLRPC.From.string (API.To.vmpp_archive_frequency archive_frequency) in - let archive_schedule = assert_all_keys ~ty ~ks:archive_schedule_keys ~value:archive_schedule ~db:archive_schedule in - (archive_target_config,archive_schedule) - ) - -let assert_set_is_alarm_enabled ~is_alarm_enabled ~alarm_config = - if is_alarm_enabled - then ( - assert_all_keys ~ty:(btype is_alarm_enabled) ~ks:alarm_config_keys ~value:alarm_config ~db:alarm_config - ) - else (* do not erase alarm_config if alarm is disabled *) - alarm_config - -let assert_frequency ~archive_frequency ~backup_frequency = - let a = XMLRPC.From.string (API.To.vmpp_archive_frequency archive_frequency) in - let b = XMLRPC.From.string (API.To.vmpp_backup_frequency backup_frequency) in - if (more_frequent_than ~a ~b) - then - raise (Api_errors.Server_error (Api_errors.vmpp_archive_more_frequent_than_backup,[])) - -let assert_backup_retention_value ~backup_retention_value = - let value = backup_retention_value in - (if (value < 1L) or (value > 10L) - then - err "backup_retention_value" "" (Printf.sprintf "%Li" value) - ) - -(* == the setters with customized key cross-integrity checks == *) - -(* 1/3: values of non-map fields can only change if their corresponding maps contain the expected keys *) - -let set_backup_frequency ~__context ~self ~value = - assert_licensed ~__context; - let archive_frequency = Db.VMPP.get_archive_frequency ~__context ~self in - assert_frequency ~archive_frequency ~backup_frequency:value; - let backup_schedule = Db.VMPP.get_backup_schedule ~__context ~self in - let new_backup_schedule = assert_set_backup_frequency ~backup_frequency:value ~backup_schedule in - Db.VMPP.set_backup_frequency ~__context ~self ~value; - (* update dependent maps *) - Db.VMPP.set_backup_schedule ~__context ~self ~value:new_backup_schedule - -let set_archive_frequency ~__context ~self ~value = - assert_licensed ~__context; - let backup_frequency = Db.VMPP.get_backup_frequency ~__context ~self in - assert_frequency ~archive_frequency:value ~backup_frequency; - let archive_schedule = (Db.VMPP.get_archive_schedule ~__context ~self) in - let archive_target_config = (Db.VMPP.get_archive_target_config ~__context ~self) in - let archive_target_type = (Db.VMPP.get_archive_target_type ~__context ~self) in - let (new_archive_target_config,new_archive_schedule) = assert_set_archive_frequency ~archive_frequency:value ~archive_target_type ~archive_target_config ~archive_schedule in - Db.VMPP.set_archive_frequency ~__context ~self ~value; - (* update dependent maps *) - Db.VMPP.set_archive_target_config ~__context ~self ~value:new_archive_target_config; - Db.VMPP.set_archive_schedule ~__context ~self ~value:new_archive_schedule - -let set_archive_target_type ~__context ~self ~value = - assert_licensed ~__context; - let archive_target_config = Db.VMPP.get_archive_target_config ~__context ~self in - let archive_frequency = Db.VMPP.get_archive_frequency ~__context ~self in - let archive_schedule = Db.VMPP.get_archive_schedule ~__context ~self in - let (new_archive_target_config,new_archive_frequency,new_archive_schedule) = assert_archive_target_type ~archive_target_type:value ~archive_target_config ~archive_frequency ~archive_schedule in - Db.VMPP.set_archive_target_type ~__context ~self ~value; - (* update dependent maps *) - Db.VMPP.set_archive_target_config ~__context ~self ~value:new_archive_target_config; - Db.VMPP.set_archive_frequency ~__context ~self ~value:new_archive_frequency; - Db.VMPP.set_archive_schedule ~__context ~self ~value:new_archive_schedule - -let set_is_alarm_enabled ~__context ~self ~value = - assert_licensed ~__context; - let alarm_config = Db.VMPP.get_alarm_config ~__context ~self in - let new_alarm_config = assert_set_is_alarm_enabled ~is_alarm_enabled:value ~alarm_config in - Db.VMPP.set_is_alarm_enabled ~__context ~self ~value; - (* update dependent maps *) - Db.VMPP.set_alarm_config ~__context ~self ~value:new_alarm_config - -(* 2/3: values of map fields can change as long as the key names and values are valid *) - -let set_backup_schedule ~__context ~self ~value = - assert_licensed ~__context; - let value = assert_keys ~ty:"" ~ks:backup_schedule_all_keys ~value ~db:(Db.VMPP.get_backup_schedule ~__context ~self) in - Db.VMPP.set_backup_schedule ~__context ~self ~value - -let add_to_backup_schedule ~__context ~self ~key ~value = - assert_licensed ~__context; - let value = List.assoc key (assert_keys ~ty:"" ~ks:backup_schedule_all_keys ~value:[(key,value)] ~db:(Db.VMPP.get_backup_schedule ~__context ~self)) in - Db.VMPP.add_to_backup_schedule ~__context ~self ~key ~value - -let set_archive_target_config ~__context ~self ~value = - assert_licensed ~__context; - let config = (Db.VMPP.get_archive_target_config ~__context ~self) in - assert_keys ~ty:"" ~ks:archive_target_config_all_keys ~value ~db:config; - let value = map_any_passwords_to_secrets ~__context ~value ~db:config in - Db.VMPP.set_archive_target_config ~__context ~self ~value - -let add_to_archive_target_config ~__context ~self ~key ~value = - assert_licensed ~__context; - let config = (Db.VMPP.get_archive_target_config ~__context ~self) in - assert_keys ~ty:"" ~ks:archive_target_config_all_keys ~value:[(key,value)] ~db:config; - let value = - if key=Datamodel.vmpp_archive_target_config_password - then (map_password_to_secret ~__context ~db:config ~new_password:value) - else value - in - Db.VMPP.add_to_archive_target_config ~__context ~self ~key ~value - -let set_archive_schedule ~__context ~self ~value = - assert_licensed ~__context; - let value = assert_keys ~ty:"" ~ks:archive_schedule_all_keys ~value ~db:(Db.VMPP.get_archive_schedule ~__context ~self) in - Db.VMPP.set_archive_schedule ~__context ~self ~value - -let add_to_archive_schedule ~__context ~self ~key ~value = - assert_licensed ~__context; - let value = List.assoc key (assert_keys ~ty:"" ~ks:archive_schedule_all_keys ~value:[(key,value)] ~db:(Db.VMPP.get_archive_schedule ~__context ~self)) in - Db.VMPP.add_to_archive_schedule ~__context ~self ~key ~value - -let set_alarm_config ~__context ~self ~value = - assert_licensed ~__context; - assert_keys ~ty:"" ~ks:alarm_config_all_keys ~value ~db:(Db.VMPP.get_alarm_config ~__context ~self); - Db.VMPP.set_alarm_config ~__context ~self ~value - -let add_to_alarm_config ~__context ~self ~key ~value = - assert_licensed ~__context; - assert_keys ~ty:"" ~ks:alarm_config_all_keys ~value:[(key,value)] ~db:(Db.VMPP.get_alarm_config ~__context ~self); - Db.VMPP.add_to_alarm_config ~__context ~self ~key ~value - -(* 3/3: the CLI requires any key in any map to be removed at will *) - -let remove_from_backup_schedule ~__context ~self ~key = - assert_licensed ~__context; - assert_non_required_key ~ks:backup_schedule_keys ~key ~db:(Db.VMPP.get_backup_schedule ~__context ~self); - Db.VMPP.remove_from_backup_schedule ~__context ~self ~key - -let remove_from_archive_target_config ~__context ~self ~key = - assert_licensed ~__context; - let db = (Db.VMPP.get_archive_target_config ~__context ~self) in - assert_non_required_key ~ks:archive_target_config_keys ~key ~db; - remove_any_secrets ~__context ~config:db ~key:Datamodel.vmpp_archive_target_config_password; - Db.VMPP.remove_from_archive_target_config ~__context ~self ~key - -let remove_from_archive_schedule ~__context ~self ~key = - assert_licensed ~__context; - assert_non_required_key ~ks:archive_schedule_keys ~key ~db:(Db.VMPP.get_archive_schedule ~__context ~self); - Db.VMPP.remove_from_archive_schedule ~__context ~self ~key - -let remove_from_alarm_config ~__context ~self ~key = - assert_licensed ~__context; - assert_non_required_key ~ks:alarm_config_keys ~key ~db:(Db.VMPP.get_alarm_config ~__context ~self); - Db.VMPP.remove_from_alarm_config ~__context ~self ~key - -let set_backup_last_run_time ~__context ~self ~value = - assert_licensed ~__context; - Db.VMPP.set_backup_last_run_time ~__context ~self ~value - -let set_archive_last_run_time ~__context ~self ~value = - assert_licensed ~__context; - Db.VMPP.set_archive_last_run_time ~__context ~self ~value - -let set_backup_retention_value ~__context ~self ~value = - assert_licensed ~__context; - assert_backup_retention_value ~backup_retention_value:value; - Db.VMPP.set_backup_retention_value ~__context ~self ~value - -(* constructors/destructors *) - let create ~__context ~name_label ~name_description ~is_policy_enabled - ~backup_type ~backup_retention_value ~backup_frequency ~backup_schedule - ~archive_target_type ~archive_target_config ~archive_frequency ~archive_schedule + ~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 : API.ref_VMPP = - - assert_licensed ~__context; - (* assert all provided field values, key names and key values are valid *) - assert_keys ~ty:(XMLRPC.From.string (API.To.vmpp_backup_frequency backup_frequency)) ~ks:backup_schedule_keys ~value:backup_schedule ~db:[]; - assert_keys ~ty:(XMLRPC.From.string (API.To.vmpp_archive_frequency archive_frequency)) ~ks:archive_schedule_keys ~value:archive_schedule ~db:[]; - assert_keys ~ty:(XMLRPC.From.string (API.To.vmpp_archive_target_type archive_target_type)) ~ks:archive_target_config_keys ~value:archive_target_config ~db:[]; - assert_keys ~ty:(btype is_alarm_enabled) ~ks:alarm_config_keys ~value:alarm_config ~db:[]; - - (* assert inter-field constraints and fix values if possible *) - let backup_schedule = assert_set_backup_frequency ~backup_frequency ~backup_schedule in - let (archive_target_config,archive_schedule) = assert_set_archive_frequency ~archive_frequency ~archive_target_type ~archive_target_config ~archive_schedule in - let alarm_config = assert_set_is_alarm_enabled ~is_alarm_enabled ~alarm_config in - let (archive_target_config,_,_) = assert_archive_target_type ~archive_target_type ~archive_target_config ~archive_frequency ~archive_schedule in - - let archive_target_config = map_any_passwords_to_secrets ~__context ~value:archive_target_config ~db:[] in - - (* assert frequency constraints *) - assert_frequency ~archive_frequency ~backup_frequency; - (* other constraints *) - assert_backup_retention_value ~backup_retention_value; - let ref=Ref.make() in let uuid=Uuid.to_string (Uuid.make_uuid()) in Db.VMPP.create ~__context ~ref ~uuid ~name_label ~name_description ~is_policy_enabled ~backup_type ~backup_retention_value - ~backup_frequency ~backup_schedule - ~backup_last_run_time:(Date.of_float 0.) + ~backup_frequency ~backup_schedule ~backup_last_run_time ~is_backup_running:false ~is_archive_running:false - ~archive_target_type ~archive_target_config - ~archive_frequency ~archive_schedule - ~archive_last_run_time:(Date.of_float 0.) + ~archive_target_config ~archive_target_type + ~archive_frequency ~archive_schedule ~archive_last_run_time ~is_alarm_enabled ~alarm_config ~recent_alerts:[]; ref let destroy ~__context ~self = - let vms = Db.VMPP.get_VMs ~__context ~self in - if List.length vms > 0 - then ( (* we can't delete a VMPP that contains VMs *) - raise (Api_errors.Server_error (Api_errors.vmpp_has_vm,[])) - ) - else ( - let archive_target_config = (Db.VMPP.get_archive_target_config ~__context ~self) in - remove_any_secrets ~__context ~config:archive_target_config ~key:Datamodel.vmpp_archive_target_config_password; - Db.VMPP.destroy ~__context ~self - ) + Db.VMPP.destroy ~__context ~self + +let protect_now ~__context ~vmpp = () +let archive_now ~__context ~snapshot = () + +let set_is_backup_running ~__context ~self ~value = + Db.VMPP.set_is_backup_running ~__context ~self ~value +let set_is_archive_running ~__context ~self ~value = + Db.VMPP.set_is_archive_running ~__context ~self ~value + -- 2.39.5