# HG changeset patch
# User David Scott <dave.scott@xxxxxxxxxxxxx>
# Date 1278584072 -3600
# Node ID 0c034eadb88871b92ffd1e6a1412229d6a5050f2
# Parent  bdfe7edd4af86ff1a1a7adae1a7a22e3b246272a
CA-41230: In VM.{snapshot,clone}, keep track of whether a new VDI has actually been created and therefore, whether that VDI should be deleted on failure. In particular CDs are shared not duplicated and so the cleanup code shouldn't try to delete them.

Unfortunately the 'writable ISO SR' support changes the default NFS ISO SR mount options to read/write from read/only, exposing this bug.

Signed-off-by: David Scott <dave.scott@xxxxxxxxxxxxx>

diff -r bdfe7edd4af8 -r 0c034eadb888 ocaml/xapi/xapi_vm_clone.ml
--- a/ocaml/xapi/xapi_vm_clone.ml	Thu Jul 08 11:13:36 2010 +0100
+++ b/ocaml/xapi/xapi_vm_clone.ml	Thu Jul 08 11:14:32 2010 +0100
@@ -21,7 +21,11 @@
 open D
 
 let delete_disks rpc session_id disks =
-	List.iter (fun (vbd,vdi) -> try Client.VDI.destroy rpc session_id vdi with _ -> ()) disks
+	List.iter (fun (vbd,vdi,on_error_delete) -> 
+				   if on_error_delete
+				   then try Client.VDI.destroy rpc session_id vdi with _ -> ()
+				   else debug "Not destroying CD VDI: %s" (Ref.string_of vdi)
+			  ) disks
 
 let wait_for_clone ?progress_minmax ~__context task =
 	Helpers.call_api_functions ~__context (fun rpc session ->
@@ -134,14 +138,14 @@
 			(* If the VBD is empty there is no VDI to copy. *)
 			(* If the VBD is a CD then eject it (we cannot make copies of ISOs: they're identified *)
 			(* by their filename unlike other VDIs) *)
-			let newvdi = 
+			let newvdi, on_error_delete = 
 				if vbd_r.API.vBD_empty
-				then Ref.null
+				then Ref.null, false
 				else if vbd_r.API.vBD_type = `CD
-				then vbd_r.API.vBD_VDI
-				else clone_single_vdi ~progress:(done_so_far, size, total) rpc session_id disk_op ~__context vbd_r.API.vBD_VDI driver_params
+				then vbd_r.API.vBD_VDI, false (* don't delete the original CD *)
+				else clone_single_vdi ~progress:(done_so_far, size, total) rpc session_id disk_op ~__context vbd_r.API.vBD_VDI driver_params, true (* do delete newly created VDI *)
 			in
-			((vbd,newvdi)::acc, (Int64.add done_so_far size))
+			((vbd,newvdi,on_error_delete)::acc, (Int64.add done_so_far size))
 		with e ->
 			debug "Error in safe_clone_disks: %s" (Printexc.to_string e);
 			delete_disks rpc session_id acc; (* Delete those cloned so far *)
@@ -348,7 +352,7 @@
 				
 				(* copy VBDs *)
 				let new_vbds : [`VBD] Ref.t list =
-					List.map (fun (vbd, newvdi) -> Xapi_vbd_helpers.copy ~__context ~vm:ref ~vdi:newvdi vbd) cloned_disks in
+					List.map (fun (vbd, newvdi, _) -> Xapi_vbd_helpers.copy ~__context ~vm:ref ~vdi:newvdi vbd) cloned_disks in
 				
 				(* copy VIFs *)
 				let new_vifs : [`VIF] Ref.t list =
diff -r bdfe7edd4af8 -r 0c034eadb888 ocaml/xapi/xapi_vm_snapshot.ml
--- a/ocaml/xapi/xapi_vm_snapshot.ml	Thu Jul 08 11:13:36 2010 +0100
+++ b/ocaml/xapi/xapi_vm_snapshot.ml	Thu Jul 08 11:14:32 2010 +0100
@@ -307,7 +307,7 @@
 		try
 			debug "Copying the VBDs";
 			let (_ : [`VBD] Ref.t list) =
-				List.map (fun (vbd, vdi) -> Xapi_vbd_helpers.copy ~__context ~vm ~vdi vbd) cloned_disks in
+				List.map (fun (vbd, vdi, _) -> Xapi_vbd_helpers.copy ~__context ~vm ~vdi vbd) cloned_disks in
 			TaskHelper.set_progress ~__context 0.8;
 
 			debug "Update the suspend_VDI";
@@ -323,7 +323,8 @@
 
 		with e ->
 			error "Error while updating the new VBD, VDI and VIF records. Cleaning up the cloned VDIs.";
-			List.iter (safe_destroy_vdi ~__context ~rpc ~session_id) (cloned_suspend_VDI :: List.map snd cloned_disks);
+			let vdis = cloned_suspend_VDI :: (List.fold_left (fun acc (_, vdi, on_error_delete) -> if on_error_delete then vdi::acc else acc) [] cloned_disks) in
+			List.iter (safe_destroy_vdi ~__context ~rpc ~session_id) vdis;
 			raise e)
 
 let update_guest_metrics ~__context ~vm ~snapshot =