[xenvm] Add new snapshot mode 'scripted'

diff --git a/xenvm/vmact.ml b/xenvm/vmact.ml
index 9e27d1321545ece458be1aa86b94785eecbc2a23..36cc657c840b317ab7c36e5f3977c42a53401f20 100644 (file)
--- 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 12652a1030ae8551dace19f3f6dd39c0285cf8b1..0cf50b4c60300b01c31c2c5fa2d358b270b16c8f 100644 (file)
--- 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 =