Device.Dm.extras = cfg.extrahvm;
}
+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
+ | _ -> ()
+ ) disks
+
+let make_snapshots 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_temporary ->
+ (match disk.disk_physty with
+ | Device.Vbd.Vhd ->
+ debug "creating temporary snapshot for %s" disk.disk_physpath;
+ let tmppath = vhd_tmp_path disk.disk_physpath in
+ if Sys.file_exists tmppath then
+ Unixext.unlink_safe tmppath;
+ Misc.vhd_create_snapshot disk.disk_physpath tmppath;
+ { disk with disk_physpath = tmppath }
+ | _ -> disk)
+ | Snapshot_coalesce ->
+ (match disk.disk_physty with
+ | Device.Vbd.Vhd ->
+ debug "creating coalesce snapshot for %s" disk.disk_physpath;
+ let snappath = vhd_snap_path disk.disk_physpath in
+ let tmppath = vhd_tmp_path disk.disk_physpath in
+ begin match Sys.file_exists snappath,
+ Sys.file_exists tmppath with
+ | false, false | false, true ->
+ Misc.vhd_create_snapshot disk.disk_physpath snappath;
+ Misc.vhd_create_snapshot snappath tmppath;
+ | true, false ->
+ Misc.vhd_create_snapshot snappath tmppath;
+ | true, true ->
+ Misc.vhd_coalesce_snapshot tmppath snappath;
+ end;
+ { disk with disk_physpath = tmppath }
+ | _ -> disk)
+ ) disks
+
let add_devices xc xs domid state restore =
let cfg = state.vm_cfg in
let pcis = get_pcis cfg in
let nics = get_nics cfg in
+ (* create disk snapshots *)
+ let snap_disks = make_snapshots cfg.disks in
(* add disks and nics *)
- List.iter (fun x -> add_disk_to_vm ~xs state x) cfg.disks;
- List.iter (fun nic -> add_nic_to_vm ~xs state nic) nics;
-
- (* add vcpus *)
- for i = 0 to cfg.vcpus - 1 do Device.Vcpu.add ~xs ~devid:i domid done;
-
- (* add pcis *)
- state.vm_pcis <- [];
- List.iter (fun (devid, devs) ->
- let bind = ref false in
- let dev_msitranslate = ref None in
- let dev_power_mgmt = ref None in
- let devs = List.map (fun dev ->
- bind := !bind || dev.pci_bind;
- maybe (fun x -> dev_msitranslate := Some x) dev.pci_msitranslate;
- maybe (fun x -> dev_power_mgmt := Some x) dev.pci_power_mgmt;
- (dev.pci_domain, dev.pci_bus, dev.pci_slot, dev.pci_func)
- ) devs in
- if !bind then
- Device.PCI.bind devs;
- (* if the device has defined a msitranslate value, use it,
- otherwise use the global one. same for power_mgmt *)
- let msitranslate =
- match !dev_msitranslate with
- | None -> cfg.global_pci_msitranslate
- | Some i -> i
+ finally (fun () ->
+ debug "add_devices: adding disks";
+ List.iter (fun x -> add_disk_to_vm ~xs state x) snap_disks;
+
+ debug "add_devices: adding nics";
+ List.iter (fun nic -> add_nic_to_vm ~xs state nic) nics;
+
+ (* add vcpus *)
+ debug "add_devices: adding vcpus";
+ for i = 0 to cfg.vcpus - 1 do Device.Vcpu.add ~xs ~devid:i domid done;
+
+ (* add pcis *)
+ debug "add_devices: adding pcis";
+ state.vm_pcis <- [];
+ List.iter (fun (devid, devs) ->
+ let bind = ref false in
+ let dev_msitranslate = ref None in
+ let dev_power_mgmt = ref None in
+ let devs = List.map (fun dev ->
+ bind := !bind || dev.pci_bind;
+ maybe (fun x -> dev_msitranslate := Some x) dev.pci_msitranslate;
+ maybe (fun x -> dev_power_mgmt := Some x) dev.pci_power_mgmt;
+ (dev.pci_domain, dev.pci_bus, dev.pci_slot, dev.pci_func)
+ ) devs in
+ if !bind then
+ Device.PCI.bind devs;
+ (* if the device has defined a msitranslate value, use it,
+ otherwise use the global one. same for power_mgmt *)
+ let msitranslate =
+ match !dev_msitranslate with
+ | None -> cfg.global_pci_msitranslate
+ | Some i -> i
in
- let pci_power_mgmt =
- match !dev_power_mgmt with
- | None -> cfg.global_pci_power_mgmt
- | Some i -> i
+ let pci_power_mgmt =
+ match !dev_power_mgmt with
+ | None -> cfg.global_pci_power_mgmt
+ | Some i -> i
in
- let flrscript = cfg.global_pci_script in
- Device.PCI.add ~xc ~xs ~hvm:cfg.hvm ~msitranslate ~pci_power_mgmt ~flrscript devs domid devid;
- (* store actual parameters this is launched with with inside vm state *)
- let pcis = List.map (fun (dom,bus,slot,func) -> {
- Vmconfig.pci_bind = !bind;
- Vmconfig.pci_domain = dom;
- Vmconfig.pci_bus = bus;
- Vmconfig.pci_slot = slot;
- Vmconfig.pci_func = func;
- Vmconfig.pci_msitranslate = Some msitranslate;
- Vmconfig.pci_power_mgmt = Some pci_power_mgmt;
- } ) devs in
- List.iter (add_pci_to_vm ~xs state) pcis
- ) pcis;
-
- if (not cfg.hvm) then (
- let protocol = devproto_of_state state in
- Device.Vfb.add ~xc ~xs ~hvm:cfg.hvm ~protocol domid;
- Device.Vkb.add ~xc ~xs ~hvm:cfg.hvm ~protocol domid
- );
+ let flrscript = cfg.global_pci_script in
+ Device.PCI.add ~xc ~xs ~hvm:cfg.hvm ~msitranslate ~pci_power_mgmt ~flrscript devs domid devid;
+ (* store actual parameters this is launched with with inside vm state *)
+ let pcis = List.map (fun (dom,bus,slot,func) -> {
+ Vmconfig.pci_bind = !bind;
+ Vmconfig.pci_domain = dom;
+ Vmconfig.pci_bus = bus;
+ Vmconfig.pci_slot = slot;
+ Vmconfig.pci_func = func;
+ Vmconfig.pci_msitranslate = Some msitranslate;
+ Vmconfig.pci_power_mgmt = Some pci_power_mgmt;
+ } ) devs in
+ List.iter (add_pci_to_vm ~xs state) pcis
+ ) pcis;
+
+ if (not cfg.hvm) then (
+ let protocol = devproto_of_state state in
+ Device.Vfb.add ~xc ~xs ~hvm:cfg.hvm ~protocol domid;
+ Device.Vkb.add ~xc ~xs ~hvm:cfg.hvm ~protocol domid
+ );
- if cfg.hvm || cfg.qemu_pv then (
- (* add device model *)
- let dmpath = "/opt/xensource/libexec/qemu-dm-wrapper" in
- let dmstart = if restore then Device.Dm.restore else Device.Dm.start in
-
- let info = dm_info_of_cfg cfg in
- let vnc_port = try dmstart ~xs ~dmpath ~timeout:(15.) info domid
- with Device.Ioemu_failed s as exn ->
- if String.startswith "Timeout waiting for " s then (
- warn "you are using xen-unstable without the dm-ready patch apply the patch for not waiting 15s at boot";
- try (int_of_string (xs.Xs.read (Device.Dm.vnc_port_path domid))) with _ -> -1
- ) else
- raise exn
+ if cfg.hvm || cfg.qemu_pv then (
+ (* add device model *)
+ debug "add_devices: adding device model";
+ let dmpath = "/opt/xensource/libexec/qemu-dm-wrapper" in
+ let dmstart = if restore then Device.Dm.restore else Device.Dm.start in
+
+ let info = dm_info_of_cfg cfg in
+ let vnc_port = try dmstart ~xs ~dmpath ~timeout:(15.) info domid
+ with Device.Ioemu_failed s as exn ->
+ if String.startswith "Timeout waiting for " s then (
+ warn "you are using xen-unstable without the dm-ready patch apply the patch for not waiting 15s at boot";
+ try (int_of_string (xs.Xs.read (Device.Dm.vnc_port_path domid))) with _ -> -1
+ ) else
+ raise exn
in
- state.vm_vnc_port <- vnc_port;
- );
- ()
+ state.vm_vnc_port <- vnc_port;
+ )
+ )
+
+ (* finally -> remove the snapshots *)
+ (fun () ->
+ rm_snapshots cfg.disks)
let set_cpuid xc domid cfg =
(* do cpuid setting.
let arch = Domain.build ~xc ~xs info state.vm_domid in
state.vm_arch <- arch;
) in
+
create_vm xc xs state;
build_vm xc xs state from_scratch false;
-
+
if cfg.startup <> StartupPause then (
try
Domain.unpause ~xc state.vm_domid;
with exn ->
warn "receive exception unpausing vm: %s" (Printexc.to_string exn);
change_vmstate state VmPaused;
- ) else
- change_vmstate state VmPaused;
- ()
-
+ ) else (change_vmstate state VmPaused)
+
let restart_vm xc xs state fd =
let from_fd =
(fun state cfg ->
Vmconfig.disk_devtype = Device.Vbd.devty_of_string devtype;
Vmconfig.disk_dynadded = false;
Vmconfig.disk_crypt = None;
+ Vmconfig.disk_snapshot_mode = NoSnapshot;
} in
let cfg = get_new_config state in
let cfg = { cfg with disks = cfg.disks @ [ disk ] } in
| Snapshot_coalesce
let snapshot_mode_of_string s =
match s with
- | "" -> NoSnapshot
+ | "" | "none" -> NoSnapshot
| "temporary" -> Snapshot_temporary
| "coalesce" -> Snapshot_coalesce
| _ -> failwith "unknown snapshot mode"
disk_devtype: Device.Vbd.devty;
disk_dynadded: bool;
disk_crypt: config_disk_crypt option;
+ disk_snapshot_mode: snapshot_mode;
}
type config_nic = {
power_management: int;
oem_features: int;
timer_mode: int option;
- snapshot_mode: snapshot_mode;
hpet: int option;
vpt_align: int option;
extra_local_watches: string list;
List.map fix_mac nics
let config_disk_of_string s =
- (* physpath:phystype:virtpath:mode:devtype *)
+ (* physpath:phystype:virtpath:mode:devtype:snapshot_mode *)
let ls = String.split ':' s in
- let (physpath, phystype, virtpath, mode, devtype, kvs) =
+ let (physpath, phystype, virtpath, mode, devtype, snapshotmode, kvs) =
match ls with
- | physpath :: physty_s :: virtpath :: mode_s :: devtype_s :: left ->
+ | physpath :: physty_s :: virtpath :: mode_s :: devtype_s :: snapshotmode_s :: left ->
let kvs = List.fold_left (fun acc s ->
match String.split '=' s with
| [ k; v ] -> (k, v) :: acc
| _ -> acc
) [] left in
(physpath, Device.Vbd.physty_of_string physty_s,
- virtpath, Device.Vbd.mode_of_string mode_s,
- Device.Vbd.devty_of_string devtype_s, kvs)
+ virtpath, Device.Vbd.mode_of_string mode_s,
+ Device.Vbd.devty_of_string devtype_s,
+ snapshot_mode_of_string snapshotmode_s,
+ kvs)
| _ ->
- failwith "need at least 5 arguments for disk"
+ failwith "need at least 6 arguments for disk"
in
let crypt_cipher, crypt_key_size, crypt_key_file =
(try Some (List.assoc "cipher" kvs) with Not_found -> None),
disk_devtype = devtype;
disk_dynadded = false;
disk_crypt = dc;
+ disk_snapshot_mode = snapshotmode;
}
let config_cpuid_of_string s =
extra_vm_watches = [];
(* others *)
- snapshot_mode = NoSnapshot;
datadir = "";
notify = NotifyNone;
daemonize = false;
projects / xenclient / toolstack.git / commitdiff