Merge pull request #2332 from thomassa/xenprep-start

CP-13301 full implementation of xenprep_start

Author: robhoes

ocaml/idl/api_errors.ml

@@ -138,6 +138,7 @@ let vbd_not_empty = "VBD_NOT_EMPTY"
 let vbd_is_empty = "VBD_IS_EMPTY"
 let vbd_tray_locked = "VBD_TRAY_LOCKED"
 let vbd_missing = "VBD_MISSING"
+let vm_no_empty_cd_vbd = "VM_NO_EMPTY_CD_VBD"
 let vm_snapshot_failed = "VM_SNAPSHOT_FAILED"
 let vm_snapshot_with_quiesce_failed = "VM_SNAPSHOT_WITH_QUIESCE_FAILED"
 let vm_snapshot_with_quiesce_timeout = "VM_SNAPSHOT_WITH_QUIESCE_TIMEOUT"

ocaml/idl/datamodel.ml

@@ -652,6 +652,8 @@ let _ =
   (* CA-83260 *)
   error Api_errors.disk_vbd_must_be_readwrite_for_hvm ["vbd"]
     ~doc:"All VBDs of type 'disk' must be read/write for HVM guests" ();
+  error Api_errors.vm_no_empty_cd_vbd ["vm"]
+    ~doc:"The VM has no empty CD drive (VBD)." ();
   error Api_errors.vm_hvm_required ["vm"]
     ~doc:"HVM is required for this operation" ();
   error Api_errors.vm_no_vcpus ["vm"]

ocaml/xapi/cli_operations.ml

@@ -2820,7 +2820,7 @@ let vm_cd_insert printer rpc session_id params =
 		let vm_record = vm.record () in
 		let vbds = vm_record.API.vM_VBDs in
 		let cdvbds = List.filter (fun vbd -> (Client.VBD.get_type rpc session_id vbd = `CD) && (Client.VBD.get_empty rpc session_id vbd)) vbds in
-		if List.length cdvbds = 0 then (failwith "No empty CD devices found");
+		if List.length cdvbds = 0 then raise (Api_errors.Server_error(Api_errors.vm_no_empty_cd_vbd, [ Ref.string_of (vm.getref ()) ]));
 		if List.length cdvbds > 1 then (failwith "Two or more empty CD devices found. Please use vbd-insert");
 		let cd = List.hd cdvbds in
 		Client.VBD.insert rpc session_id cd (List.hd vdis)

ocaml/xapi/helpers.ml

@@ -822,32 +822,66 @@ let cancel_tasks ~__context ~ops ~all_tasks_in_db (* all tasks in database *) ~t
 let is_removable ~__context ~vbd = Db.VBD.get_type ~__context ~self:vbd = `CD
 
 let is_tools_sr_cache = ref []
+let tools_sr_memoised = ref None
 let is_tools_sr_cache_m = Mutex.create ()
 
 let clear_tools_sr_cache () =
 	Mutex.execute is_tools_sr_cache_m 
-		(fun () -> is_tools_sr_cache := [])
+		(fun () -> is_tools_sr_cache := []; tools_sr_memoised := None)
 
 (** Returns true if this SR is the XenSource Tools SR *)
 let is_tools_sr ~__context ~sr =
 	try
 		Mutex.execute is_tools_sr_cache_m
-			(fun () -> List.assoc sr !is_tools_sr_cache)
+			(fun () ->
+				match !tools_sr_memoised with
+					| Some s when s = sr -> true
+					| Some _ (* We could return false except for nervousness about adding an assumption of only one Tools SR *)
+					| None -> List.assoc sr !is_tools_sr_cache
+			)
 	with Not_found ->
 		let other_config = Db.SR.get_other_config ~__context ~self:sr in
 		(* Miami GA *)
-		let result =
+		let result = (
 			List.mem_assoc Xapi_globs.tools_sr_tag other_config
 			(* Miami beta2 and earlier: *)
 			|| (List.mem_assoc Xapi_globs.xensource_internal other_config)
-		in
+		) && (
+			"iso" = Db.SR.get_content_type ~__context ~self:sr
+		) in
 		Mutex.execute is_tools_sr_cache_m
 			(fun () ->
 				let cache = !is_tools_sr_cache in
 				if not (List.mem_assoc sr cache) then
 					is_tools_sr_cache := (sr, result) :: !is_tools_sr_cache);
 		result
 
+let get_tools_sr ~__context =
+	let seek_tools_sr () =
+		let candidates = Db.SR.get_refs_where ~__context ~expr:(
+			And (
+				Or (
+					Eq (Field "name__label", Literal Xapi_globs.miami_tools_sr_name),
+					Eq (Field "name__label", Literal Xapi_globs.rio_tools_sr_name) (* In case of ancient hosts that have been upgraded repeatedly? *)
+				),
+				Eq (Field "content_type", Literal "iso")
+			)
+		) in
+		let srs = List.filter (fun sr ->
+			is_tools_sr ~__context ~sr
+		) candidates in
+		if List.length srs <> 1 then failwith
+			("Expected exactly one Tools SR; found " ^ string_of_int (List.length srs));
+		List.hd srs
+	in
+	match Mutex.execute is_tools_sr_cache_m (fun () -> !tools_sr_memoised)
+	with
+		| Some sr -> sr
+		| None ->
+			let sr = seek_tools_sr () in
+			Mutex.execute is_tools_sr_cache_m (fun () -> tools_sr_memoised := Some sr);
+			sr
+
 (** Return true if the MAC is in the right format XX:XX:XX:XX:XX:XX *)
 let is_valid_MAC mac =
     let l = String.split ':' mac in

ocaml/xapi/xapi_globs.ml

@@ -205,6 +205,9 @@ let miami_tools_sr_name = "XenServer Tools"
 
 let tools_sr_dir = ref "/opt/xensource/packages/iso"
 
+(* let xenprep_iso_name_label = "xenprep.iso" *) (* TODO use this once the xenprep ISO is available *)
+let xenprep_iso_name_label = "xs-tools.iso" (* Temporary stopgap value for dev-testing *)
+
 let default_template_key = "default_template"
 let linux_template_key = "linux_template"
 let base_template_name_key = "base_template_name"

ocaml/xapi/xapi_vm.ml

@@ -36,6 +36,13 @@ exception InvalidOperation of string
 
 let assert_operation_valid = Xapi_vm_lifecycle.assert_operation_valid
 
+(* Convenience function currently not exposed in .mli but could be. *)
+(* Not thread-safe. *)
+let db_set_in_other_config ~__context ~self ~key ~value =
+	if List.mem_assoc key (Db.VM.get_other_config ~__context ~self) then
+		Db.VM.remove_from_other_config ~__context ~self ~key;
+	Db.VM.add_to_other_config ~__context ~self ~key ~value
+
 let update_allowed_operations ~__context ~self =
 	Helpers.log_exn_continue "updating allowed operations of VBDs/VIFs/VDIs in VM.update_allowed_operations"
 		(fun () ->
@@ -1019,6 +1026,55 @@ let set_auto_update_drivers ~__context ~self ~value=
 	assert_can_set_auto_update_drivers ~__context ~self ~value;
 	Db.VM.set_auto_update_drivers ~__context ~self ~value
 
+let xenprep_mutex = Mutex.create ()
+
 let xenprep_start ~__context ~self =
-	info "Xapi_vm.xenprep_start: VM=%s" (Db.VM.get_uuid ~__context ~self);
-	Db.VM.add_to_other_config ~__context ~self ~key:"xenprep_progress" ~value:"dummyvalue_should_be_cd_inserted"
+	let key = "xenprep_progress" in
+	let vm_uuid = Db.VM.get_uuid ~__context ~self in (* Just for log-msgs *)
+	info "Xapi_vm.xenprep_start: VM=%s" vm_uuid;
+	let started_already = Mutex.execute xenprep_mutex (fun () ->
+		if List.mem_assoc key (Db.VM.get_other_config ~__context ~self) then true
+		else (Db.VM.add_to_other_config ~__context ~self ~key ~value:"about_to_insert_iso";
+		false)
+	) in
+	if started_already then (
+		info "Xapi_vm.xenprep_start: VM is in xenprep already: VM=%s" vm_uuid
+	) else (
+		( try
+			let cd_name = Xapi_globs.xenprep_iso_name_label in
+			let sr = Helpers.get_tools_sr ~__context in
+			let vdis =
+				let open Db_filter_types in
+				Db.VDI.get_refs_where ~__context ~expr:(
+					And (
+						Eq (Field "SR", Literal (Ref.string_of sr)),
+						Eq (Field "name__label", Literal cd_name)
+					)
+				) in
+			if List.length vdis <> 1 then failwith
+				("xenprep_start failed: found "^(string_of_int (List.length vdis))^" ISOs with name_label="^cd_name^" in tools SR");
+			let vdi = List.hd vdis in
+			(* Find any empty CD-drive VBD for the VM. *)
+			(* We don't care if currently_attached is false: VBD.insert will take care of things. *)
+			let vbds = Db.VM.get_VBDs ~__context ~self in
+			let empty_cd_vbds = List.filter (fun vbd -> (Db.VBD.get_type ~__context ~self:vbd = `CD) && (Db.VBD.get_empty ~__context ~self:vbd)) vbds in
+			if [] = empty_cd_vbds then raise (Api_errors.Server_error(Api_errors.vm_no_empty_cd_vbd, [ Ref.string_of self ]));
+			let cd_vbd = List.hd empty_cd_vbds in
+			(* We found a suitable drive, so insert the CD. *)
+			(* We use the API to be on the safe side, because calling
+			 * Xapi_vbd.insert directly would bypass the "operations"
+			 * handling in Message_forwarding *)
+			Helpers.call_api_functions ~__context
+				(fun rpc session_id ->
+					Client.VBD.insert ~rpc ~session_id ~vbd:cd_vbd ~vdi
+				)
+		with e ->
+			Mutex.execute xenprep_mutex (fun () ->
+				Db.VM.remove_from_other_config ~__context ~self ~key
+			);
+			raise e
+		);
+		Mutex.execute xenprep_mutex (fun () ->
+			db_set_in_other_config ~__context ~self ~key ~value:"ISO_inserted"
+		)
+	)