CP-10203: XenAPI: api call for RDP on/off request

Signed-off-by: Hui Zhang <[email protected]>

Author: huizh

ocaml/idl/api_errors.ml

@@ -174,6 +174,7 @@ let vm_old_pv_drivers = "VM_OLD_PV_DRIVERS"
 let vm_lacks_feature_shutdown = "VM_LACKS_FEATURE_SHUTDOWN"
 let vm_lacks_feature_suspend = "VM_LACKS_FEATURE_SUSPEND"
 let vm_lacks_feature_vcpu_hotplug = "VM_LACKS_FEATURE_VCPU_HOTPLUG"
+let vm_lacks_feature_ts = "VM_LACKS_FEATURE_TS"
 let vm_cannot_delete_default_template = "VM_CANNOT_DELETE_DEFAULT_TEMPLATE"
 let vm_memory_size_too_low = "VM_MEMORY_SIZE_TOO_LOW"
 let vm_memory_target_wait_timeout = "VM_MEMORY_TARGET_WAIT_TIMEOUT"

ocaml/idl/datamodel.ml

@@ -623,6 +623,8 @@ let _ =
 	  ~doc:"You attempted an operation which needs the VM hotplug-vcpu feature on a VM which lacks it." ();
   error Api_errors.vm_lacks_feature_suspend [ "vm" ]
 	  ~doc:"You attempted an operation which needs the VM cooperative suspend feature on a VM which lacks it." ();
+  error Api_errors.vm_lacks_feature_ts [ "vm" ]
+	  ~doc:"You attempted to ask a VM to enable or disable Remote Desktop Protocol but the VM lacks this control feature." ();
   error Api_errors.vm_is_template ["vm"]
     ~doc:"The operation attempted is not valid for a template VM" ();
   error Api_errors.other_operation_in_progress ["class"; "object"]
@@ -2090,6 +2092,30 @@ let vm_pool_migrate_complete = call
   ~allowed_roles:_R_VM_POWER_ADMIN
   ()
 
+let vm_beg_rdp_on = call
+  ~name:"beg_rdp_on"
+  ~lifecycle:[
+    Published, rel_augusta, "Ask the VM to enable Remote Desktop Protocol. Error if the VM is halted or does not advertise this control feature. The VM may or may not cooperate."
+  ]
+  ~in_oss_since:None
+  ~doc:"Ask the VM to enable Remote Desktop Protocol. Error if the VM is halted or does not advertise this control feature. The VM may or may not cooperate."
+  ~params:[Ref _vm, "vm", "The VM to ask to enable Remote Desktop Protocol"]
+  ~errs:[Api_errors.vm_bad_power_state; Api_errors.vm_lacks_feature_ts]
+  ~allowed_roles:_R_VM_OP
+  ()
+
+let vm_beg_rdp_off = call
+  ~name:"beg_rdp_off"
+  ~lifecycle:[
+    Published, rel_augusta, "Ask the VM to disable Remote Desktop Protocol. Error if the VM is halted or does not advertise this control feature. The VM may or may not cooperate."
+  ]
+  ~in_oss_since:None
+  ~doc:"Ask the VM to disable Remote Desktop Protocol. Error if the VM is halted or does not advertise this control feature. The VM may or may not cooperate."
+  ~params:[Ref _vm, "vm", "The VM to ask to disable Remote Desktop Protocol"]
+  ~errs:[Api_errors.vm_bad_power_state; Api_errors.vm_lacks_feature_ts]
+  ~allowed_roles:_R_VM_OP
+  ()
+
 let host_migrate_receive = call
   ~in_oss_since:None
   ~in_product_since:rel_tampa
@@ -6742,6 +6768,7 @@ let vm_operations =
         vm_migrate_send;
 	    vm_get_boot_record; vm_send_sysrq; vm_send_trigger;
 		vm_query_services;vm_shutdown;
+		vm_beg_rdp_on;vm_beg_rdp_off;
 	  ]
 	@ [ "changing_memory_live", "Changing the memory settings";
 	    "awaiting_memory_live", "Waiting for the memory settings to change";
@@ -6825,6 +6852,8 @@ let vm =
 		vm_import_convert;
 		vm_set_appliance;
 		vm_query_services;
+		vm_beg_rdp_on;
+		vm_beg_rdp_off;
 		]
       ~contents:
       ([ uid _vm;

ocaml/xapi/cli_frontend.ml

@@ -1335,6 +1335,24 @@ there are two or more empty CD devices, please use the command 'vbd-insert' and
       flags=[Vm_selectors];
     };
 
+    "vm-beg-rdp-on",
+    {
+      reqd=[];
+      optn=[];
+      help="Ask the VM to enable Remote Desktop Protocol. This relies on support from the guest agent in the VM. The guest may or may not cooperate.";
+      implementation=No_fd Cli_operations.vm_beg_rdp_on;
+      flags=[Vm_selectors];
+    };
+
+    "vm-beg-rdp-off",
+    {
+      reqd=[];
+      optn=[];
+      help="Ask the VM to disable Remote Desktop Protocol. This relies on support from the guest agent in the VM. The guest may or may not cooperate.";
+      implementation=No_fd Cli_operations.vm_beg_rdp_off;
+      flags=[Vm_selectors];
+    };
+
    "snapshot-export-to-template",
     {
       reqd=["filename"; "snapshot-uuid"];

ocaml/xapi/cli_operations.ml

@@ -1963,6 +1963,12 @@ let vm_memory_target_wait printer rpc session_id params =
 			let vm=vm.getref () in
 			Client.VM.wait_memory_target_live rpc session_id vm) params [])
 
+let vm_beg_rdp_on printer rpc session_id params =
+	ignore(do_vm_op printer rpc session_id (fun vm -> Client.VM.beg_rdp_on rpc session_id (vm.getref ())) params [])
+
+let vm_beg_rdp_off printer rpc session_id params =
+	ignore(do_vm_op printer rpc session_id (fun vm -> Client.VM.beg_rdp_off rpc session_id (vm.getref ())) params [])
+
 let data_source_to_kvs ds =
 	["name_label",ds.API.data_source_name_label;
 	"name_description",ds.API.data_source_name_description;

ocaml/xapi/message_forwarding.ml

@@ -1306,6 +1306,20 @@ module Forward = functor(Local: Custom_actions.CUSTOM_ACTIONS) -> struct
 			update_vbd_operations ~__context ~vm;
 			update_vif_operations ~__context ~vm
 
+		let beg_rdp_on ~__context ~vm =
+			info "VM.beg_rdp_on: VM = '%s'" (vm_uuid ~__context vm);
+			let local_fn = Local.VM.beg_rdp_on ~vm in
+			with_vm_operation ~__context ~self:vm ~doc:"VM.beg_rdp_on" ~op:`beg_rdp_on
+				(fun () ->
+					forward_vm_op ~local_fn ~__context ~vm (fun session_id rpc -> Client.VM.beg_rdp_on rpc session_id vm))
+
+		let beg_rdp_off ~__context ~vm =
+			info "VM.beg_rdp_off: VM = '%s'" (vm_uuid ~__context vm);
+			let local_fn = Local.VM.beg_rdp_off ~vm in
+			with_vm_operation ~__context ~self:vm ~doc:"VM.beg_rdp_off" ~op:`beg_rdp_off
+				(fun () ->
+					forward_vm_op ~local_fn ~__context ~vm (fun session_id rpc -> Client.VM.beg_rdp_off rpc session_id vm))
+
 		let set_xenstore_data ~__context ~self ~value =
 			info "VM.set_xenstore_data: VM = '%s'" (vm_uuid ~__context self);
 			Db.VM.set_xenstore_data ~__context ~self ~value;

ocaml/xapi/xapi_vm.ml

@@ -700,6 +700,33 @@ let set_memory_dynamic_range ~__context ~self ~min ~max =
 	if power_state = `Running
 	then Xapi_xenops.set_memory_dynamic_range ~__context ~self min max
 
+(* xenstore paths *)
+let control_path ~xs ~domid x =
+	xs.Xenstore.Xs.getdomainpath domid ^ "/control/" ^ x
+
+let is_feature_ts_on ~xs ~domid ~vm =
+	try
+		xs.Xenstore.Xs.read (control_path ~xs ~domid "feature-ts") = "1"
+	with e ->
+		debug "Exception while reading feature-ts of VM %s (domain %i): %s"
+		(Ref.string_of vm) domid (Printexc.to_string e);
+		false
+
+let beg_rdp ~__context ~vm ~enabled =
+	let domid = Int64.to_int (Db.VM.get_domid ~__context ~self:vm) in
+	Xenstore.with_xs (fun xs ->
+		if is_feature_ts_on ~xs ~domid ~vm
+		then
+			let control_ts = if enabled then "1" else "0" in
+			xs.Xenstore.Xs.write (control_path ~xs ~domid "ts") control_ts
+		else raise (Api_errors.Server_error (Api_errors.vm_lacks_feature_ts, [ Ref.string_of vm ])))
+
+let beg_rdp_on ~__context ~vm =
+	beg_rdp ~__context ~vm ~enabled:true
+
+let beg_rdp_off ~__context ~vm =
+	beg_rdp ~__context ~vm ~enabled:false
+
 let send_sysrq ~__context ~vm ~key =
 	raise (Api_errors.Server_error (Api_errors.not_implemented, [ "send_sysrq" ]))
 

ocaml/xapi/xapi_vm.mli

@@ -244,3 +244,6 @@ val import_convert : __context:Context.t -> _type:string -> username:string -> p
 (** [query_services __context self] returns a Map of service type -> name label provided
 	by the specific VM. *)
 val query_services : __context:Context.t -> self:API.ref_VM -> (string * string) list
+
+val beg_rdp_on : __context:Context.t -> vm:API.ref_VM -> unit
+val beg_rdp_off: __context:Context.t -> vm:API.ref_VM -> unit

ocaml/xapi/xapi_vm_lifecycle.ml

@@ -80,6 +80,8 @@ let allowed_power_states ~__context ~vmr ~(op:API.vm_operations) =
 	| `get_boot_record
 	| `shutdown
 	| `hard_shutdown
+	| `beg_rdp_on
+	| `beg_rdp_off
 	                                -> [`Paused; `Suspended; `Running]
 	| `assert_operation_valid
 	| `metadata_export