From 22a5967282dccfdea40f1418648b80bb7039cf1a Mon Sep 17 00:00:00 2001
From: Tomasz Wroblewski <tomasz.wroblewski@citrix.com>
Date: Tue, 19 Jan 2010 10:41:27 +0000
Subject: [PATCH] [xenvm] Add new snapshot mode 'scripted'

---
 xenvm/vmact.ml    | 51 +++++++++++++++++++++++++++++++++++------------
 xenvm/vmconfig.ml |  2 ++
 2 files changed, 40 insertions(+), 13 deletions(-)

diff --git a/xenvm/vmact.ml b/xenvm/vmact.ml
index 9e27d13..36cc657 100644
--- a/xenvm/vmact.ml
+++ b/xenvm/vmact.ml
@@ -247,25 +247,50 @@ let rm_snapshots disks =
 	let vhd_snap_path path = path ^ ".snap" in
 	let vhd_tmp_path path  = path ^ ".snap.tmp" in
 	List.iter (fun disk ->
-	        match disk.disk_physty with
-	        | Device.Vbd.Vhd ->
-		        let snappath = vhd_snap_path disk.disk_physpath in
-		        let tmppath = vhd_tmp_path disk.disk_physpath in
-		        if Sys.file_exists snappath then
-				debug "removing snapshot file %s" snappath;
-				Unixext.unlink_safe snappath;
-			if Sys.file_exists tmppath then
-				debug "removing snapshot file %s" tmppath;
-				Unixext.unlink_safe tmppath
-		| _ -> ()
+		(* snapshots managed with scripts are not removed here *)
+		if disk.disk_snapshot_mode <> Snapshot_scripted then (
+			match disk.disk_physty with
+			| Device.Vbd.Vhd ->
+				  let snappath = vhd_snap_path disk.disk_physpath in
+				  let tmppath = vhd_tmp_path disk.disk_physpath in
+				  if Sys.file_exists snappath then
+					  debug "removing snapshot file %s" snappath;
+				  Unixext.unlink_safe snappath;
+				  if Sys.file_exists tmppath then
+					  debug "removing snapshot file %s" tmppath;
+				  Unixext.unlink_safe tmppath
+			| _ -> ()
+	        )
         ) disks
 
-let make_snapshots disks =
+exception Snapshot_failure of string * string
+
+let make_snapshots uuid disks =
 	let vhd_snap_path path = path ^ ".snap" in
 	let vhd_tmp_path path  = path ^ ".snap.tmp" in
 	List.map (fun disk ->
 		match disk.disk_snapshot_mode with
 		| NoSnapshot -> disk
+		| Snapshot_scripted ->
+			  (* snapshots managed by external script *)
+			  let physpath = disk.disk_physpath in
+			  let tmppath = vhd_tmp_path physpath in
+			  let opts = [
+				  "-i"; physpath;
+				  "-s"; tmppath;
+				  "-u"; uuid
+				] in
+			  (try 
+				  let _ = Forkhelpers.execute_command_get_output
+					  ~withpath:true
+					  "/usr/sbin/prepare-system-snapshot"
+					  opts
+				  in
+				  { disk with disk_physpath = tmppath }
+			  with
+				  Forkhelpers.Spawn_internal_error (log, output, status) ->
+					  let s = sprintf "output=%S status=%s" output (string_of_unix_process status) in
+					  raise (Snapshot_failure (uuid, s)))
 		| Snapshot_temporary ->
 			  (match disk.disk_physty with
 			  | Device.Vbd.Vhd ->
@@ -302,7 +327,7 @@ let add_devices xc xs domid state restore =
 	let nics = get_nics cfg in
 
 	(* create disk snapshots *)
-	let snap_disks = make_snapshots cfg.disks in
+	let snap_disks = make_snapshots state.vm_uuid cfg.disks in
 	(* add disks and nics *)
 	finally (fun () ->
 		debug "add_devices: adding disks";
diff --git a/xenvm/vmconfig.ml b/xenvm/vmconfig.ml
index 12652a1..0cf50b4 100644
--- a/xenvm/vmconfig.ml
+++ b/xenvm/vmconfig.ml
@@ -44,11 +44,13 @@ type snapshot_mode =
 	| NoSnapshot
 	| Snapshot_temporary
 	| Snapshot_coalesce
+	| Snapshot_scripted
 let snapshot_mode_of_string s =
 	match s with
 	| "" | "none" -> NoSnapshot
 	| "temporary" -> Snapshot_temporary
 	| "coalesce"  -> Snapshot_coalesce
+	| "scripted"  -> Snapshot_scripted
 	| _           -> failwith "unknown snapshot mode"
 
 type display =
-- 
2.39.5