Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

755 lines (690 sloc) 27.121 kB
(*
* Copyright (C) Citrix Systems Inc.
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU Lesser General Public License as published
* by the Free Software Foundation; version 2.1 only. with the special
* exception on linking described in file LICENSE.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU Lesser General Public License for more details.
*)
(**
* @group Storage
*)
open OUnit
open Listext
open Stringext
open Pervasiveext
open Fun
open Xmlrpc_client
let default_path = Filename.concat Fhs.vardir "xenopsd"
let transport = ref (Unix default_path)
open Xenops_interface
open Xenops_client
let usage_and_exit () =
Printf.fprintf stderr "Usage:\n";
Printf.fprintf stderr " %s" Sys.argv.(0);
exit 1
let dbg = "test"
let expect_exception pred f =
let exn =
try
f ();
failwith "Unexpected success"
with e ->
e
in
if pred exn then () else raise exn
let fail_running f =
expect_exception (function Bad_power_state(Running _, Halted) -> true | _ -> false) f
let fail_not_built f =
expect_exception (function Domain_not_built -> true | _ -> false) f
let fail_connected f =
expect_exception (function Device_is_connected -> true | _ -> false) f
let event_wait p =
let finished = ref false in
let event_id = ref None in
while not !finished do
let deltas, next_id = Client.UPDATES.get dbg !event_id (Some 30) in
event_id := Some next_id;
List.iter (fun d -> if p d then finished := true) deltas;
done
let wait_for_task id =
(* Printf.fprintf stderr "wait_for id = %s\n%!" id; *)
let finished = function
| Dynamic.Task id' ->
id = id' && (task_ended dbg id)
| x ->
(* Printf.fprintf stderr "ignore event on %s\n%!" (x |> Dynamic.rpc_of_id |> Jsonrpc.to_string); *)
false in
event_wait finished;
id
let verbose_timings = ref false
let wait_for_tasks id =
let module StringSet = Set.Make(struct type t = string let compare = compare end) in
let ids = ref (List.fold_left (fun set x -> StringSet.add x set) StringSet.empty id) in
let event_id = ref None in
while not(StringSet.is_empty !ids) do
let deltas, next_id = Client.UPDATES.get dbg !event_id (Some 30) in
if !verbose_timings
then (Printf.fprintf stderr "next_id = %d; deltas = %d" next_id (List.length deltas); flush stderr);
if List.length deltas = 0 then failwith (Printf.sprintf "no deltas, next_id = %d" next_id);
event_id := Some next_id;
List.iter (function
| Dynamic.Task id' -> if task_ended dbg id' then ids := StringSet.remove id' !ids
| _ -> ()
) deltas
done
let success_task id =
let t = Client.TASK.stat dbg id in
Client.TASK.destroy dbg id;
match t.Task.state with
| Task.Completed _ -> ()
| Task.Failed x -> raise (exn_of_exnty (Exception.exnty_of_rpc x))
| Task.Pending _ -> failwith "task pending"
let fail_not_built_task id =
let t = Client.TASK.stat dbg id in
Client.TASK.destroy dbg id;
match t.Task.state with
| Task.Completed _ -> failwith "task completed successfully: expected Domain_not_built"
| Task.Failed x ->
let exn = exn_of_exnty (Exception.exnty_of_rpc x) in
begin match exn with
| Domain_not_built -> ()
| _ -> raise exn
end
| Task.Pending _ -> failwith "task pending"
let fail_invalid_vcpus_task id =
let t = Client.TASK.stat dbg id in
Client.TASK.destroy dbg id;
match t.Task.state with
| Task.Completed _ -> failwith "task completed successfully: expected Invalid_vcpus"
| Task.Failed x ->
let exn = exn_of_exnty (Exception.exnty_of_rpc x) in
begin match exn with
| Invalid_vcpus _ -> ()
| _ -> raise exn
end
| Task.Pending _ -> failwith "task pending"
let test_query _ = let (_: Query.t) = Client.query dbg () in ()
let missing_vm = "missing"
let vm_test_remove_missing _ =
let exn =
try
Client.VM.remove dbg missing_vm;
Some (Failure "VDI.remove succeeded");
with
| Does_not_exist (_,_) -> None
| e -> Some e
in
Opt.iter raise exn
let example_uuid = "c0ffeec0-ffee-c0ff-eec0-ffeec0ffeec0"
let ( ** ) = Int64.mul
let create_vm id =
let open Vm in
let _ = PV {
framebuffer = false;
framebuffer_ip = Some "0.0.0.0";
vncterm = true;
vncterm_ip = None;
Vm.boot = Indirect {
bootloader = "pygrub";
extra_args = "extra";
legacy_args = "legacy";
bootloader_args = "bootloader";
devices = [ Local "0"; Local "1" ]
}
} in
let hvm = HVM {
hap = true;
shadow_multiplier = 1.;
timeoffset = "";
video_mib = 4;
video = Cirrus;
acpi = true;
serial = None;
keymap = Some "en-gb";
vnc_ip = Some "hello";
pci_emulations = [ "1" ];
pci_passthrough = false;
boot_order = "boot";
qemu_disk_cmdline = false;
qemu_stubdom = false;
} in {
id = id;
name = "Example: " ^ id;
ssidref = 1l;
xsdata = [ "xs", "data" ];
platformdata = [ "platform", "data" ];
bios_strings = [ "bios", "strings" ];
ty = hvm;
suppress_spurious_page_faults = true;
machine_address_size = None;
memory_static_max = 128L ** 1024L ** 1024L;
memory_dynamic_max = 128L ** 1024L ** 1024L;
memory_dynamic_min = 128L ** 1024L ** 1024L;
vcpu_max = 2;
vcpus = 2;
scheduler_params = { priority = None; affinity = [] };
on_crash = [ Vm.Shutdown ];
on_shutdown = [ Vm.Shutdown ];
on_reboot = [ Vm.Start ];
pci_msitranslate = true;
pci_power_mgmt = false;
}
let sl x = Printf.sprintf "[ %s ]" (String.concat "; " (List.map (fun (k, v) -> k ^ ":" ^ v) x))
let vm_assert_equal vm vm' =
let open Vm in
assert_equal ~msg:"id" ~printer:(fun x -> x) vm.id vm'.id;
assert_equal ~msg:"name" ~printer:(fun x -> x) vm.name vm'.name;
assert_equal ~msg:"ssidref" ~printer:Int32.to_string vm.ssidref vm'.ssidref;
assert_equal ~msg:"xsdata" ~printer:sl vm.xsdata vm'.xsdata;
assert_equal ~msg:"platformdata" ~printer:sl vm.platformdata vm'.platformdata;
assert_equal ~msg:"bios_strings" ~printer:sl vm.bios_strings vm'.bios_strings;
assert_equal ~msg:"suppress_spurious_page_faults" ~printer:string_of_bool vm.suppress_spurious_page_faults vm'.suppress_spurious_page_faults;
assert_equal ~msg:"machine_address_size" ~printer:(function None -> "None" | Some x -> string_of_int x) vm.machine_address_size vm'.machine_address_size;
assert_equal ~msg:"memory_static_max" ~printer:Int64.to_string vm.memory_static_max vm'.memory_static_max;
assert_equal ~msg:"memory_dynamic_max" ~printer:Int64.to_string vm.memory_dynamic_max vm'.memory_dynamic_max;
assert_equal ~msg:"memory_dynamic_min" ~printer:Int64.to_string vm.memory_dynamic_min vm'.memory_dynamic_min;
assert_equal ~msg:"vcpu_max" ~printer:string_of_int vm.vcpu_max vm'.vcpu_max;
assert_equal ~msg:"vcpus" ~printer:string_of_int vm.vcpus vm'.vcpus;
assert_equal ~msg:"on_crash" ~printer:(fun x -> String.concat ", " (List.map (fun x -> x |> Vm.rpc_of_action |> Jsonrpc.to_string) x)) vm.on_crash vm'.on_crash;
assert_equal ~msg:"on_shutdown" ~printer:(fun x -> String.concat ", " (List.map (fun x -> x |> Vm.rpc_of_action |> Jsonrpc.to_string) x)) vm.on_shutdown vm'.on_shutdown;
assert_equal ~msg:"on_reboot" ~printer:(fun x -> String.concat ", " (List.map (fun x -> x |> Vm.rpc_of_action |> Jsonrpc.to_string) x)) vm.on_reboot vm'.on_reboot;
let is_hvm vm = match vm.ty with
| HVM _ -> true | PV _ -> false in
assert_equal ~msg:"HVM-ness" ~printer:string_of_bool (is_hvm vm) (is_hvm vm');
match vm.ty, vm'.ty with
| HVM _, PV _
| PV _, HVM _ -> failwith "HVM-ness"
| HVM h, HVM h' ->
assert_equal ~msg:"HAP" ~printer:string_of_bool h.hap h'.hap;
assert_equal ~msg:"shadow_multipler" ~printer:string_of_float h.shadow_multiplier h'.shadow_multiplier;
assert_equal ~msg:"timeoffset" ~printer:(fun x -> x) h.timeoffset h'.timeoffset;
assert_equal ~msg:"video_mib" ~printer:string_of_int h.video_mib h'.video_mib;
assert_equal ~msg:"video" ~printer:(fun x -> x |> rpc_of_video_card |> Jsonrpc.to_string) h.video h'.video;
assert_equal ~msg:"acpi" ~printer:string_of_bool h.acpi h'.acpi;
assert_equal ~msg:"serial" ~printer:(Opt.default "None") h.serial h'.serial;
assert_equal ~msg:"keymap" ~printer:(Opt.default "None") h.keymap h'.keymap;
assert_equal ~msg:"vnc_ip" ~printer:(Opt.default "None") h.vnc_ip h'.vnc_ip;
assert_equal ~msg:"pci_emulations" ~printer:(String.concat ";") h.pci_emulations h'.pci_emulations;
assert_equal ~msg:"pci_passthrough" ~printer:string_of_bool h.pci_passthrough h'.pci_passthrough;
assert_equal ~msg:"boot_order" ~printer:(fun x -> x) h.boot_order h'.boot_order;
assert_equal ~msg:"qemu_disk_cmdline" ~printer:string_of_bool h.qemu_disk_cmdline h'.qemu_disk_cmdline;
| PV p, PV p' ->
assert_equal ~msg:"framebuffer" ~printer:string_of_bool p.framebuffer p'.framebuffer;
assert_equal ~msg:"vncterm" ~printer:string_of_bool p.vncterm p'.vncterm;
assert_equal ~msg:"vncterm_ip" ~printer:(Opt.default "None") p.vncterm_ip p'.vncterm_ip;
begin match p.boot, p'.boot with
| Direct _, Indirect _
| Indirect _, Direct _ -> failwith "pv-boot-ness"
| Direct x, Direct x' ->
assert_equal ~msg:"kernel" ~printer:(fun x -> x) x.kernel x'.kernel;
assert_equal ~msg:"cmdline" ~printer:(fun x -> x) x.cmdline x'.cmdline;
assert_equal ~msg:"ramdisk" ~printer:(function None -> "None" | Some x -> x) x.ramdisk x'.ramdisk
| Indirect x, Indirect x' ->
assert_equal ~msg:"bootloader" ~printer:(fun x -> x) x.bootloader x'.bootloader;
assert_equal ~msg:"extra_args" ~printer:(fun x -> x) x.extra_args x'.extra_args;
assert_equal ~msg:"legacy_args" ~printer:(fun x -> x) x.legacy_args x'.legacy_args;
assert_equal ~msg:"bootloader_args" ~printer:(fun x -> x) x.bootloader_args x'.bootloader_args;
assert_equal ~msg:"devices" ~printer:(fun x -> x |> rpc_of_disk_list |> Jsonrpc.to_string) x.devices x'.devices;
end
let with_vm id f =
let vm = create_vm id in
let (id: Vm.id) = Client.VM.add dbg vm in
finally (fun () -> f id)
(fun () ->
let _, state = Client.VM.stat dbg id in
begin match state.Vm.power_state with
| Running
| Paused ->
Printf.fprintf stderr "VM is running or paused; shutting down";
begin try
Client.VM.shutdown dbg id None |> wait_for_task |> success_task
with e ->
Printf.fprintf stderr "Caught failure during with_vm cleanup: %s" (Printexc.to_string e);
raise e
end
| _ -> ()
end;
try
Client.VM.remove dbg id
with e ->
Printf.fprintf stderr "Caught failure during with_vm cleanup: %s" (Printexc.to_string e);
raise e
)
let vm_test_add_remove _ =
with_vm example_uuid (fun _ -> ())
let vm_test_create_destroy _ =
with_vm example_uuid
(fun id ->
Client.VM.create dbg id |> wait_for_task |> success_task;
Client.VM.destroy dbg id |> wait_for_task |> success_task;
)
let vm_test_pause_unpause _ =
with_vm example_uuid
(fun id ->
Client.VM.create dbg id |> wait_for_task |> success_task;
Client.VM.unpause dbg id |> wait_for_task |> fail_not_built_task;
Client.VM.pause dbg id |> wait_for_task |> fail_not_built_task;
Client.VM.destroy dbg id |> wait_for_task |> success_task;
)
let vm_test_build_pause_unpause _ =
with_vm example_uuid
(fun id ->
Client.VM.create dbg id |> wait_for_task |> success_task;
Client.VM.build dbg id |> wait_for_task |> success_task;
Client.VM.unpause dbg id |> wait_for_task |> fail_not_built_task;
Client.VM.create_device_model dbg id false |> wait_for_task |> success_task;
Client.VM.unpause dbg id |> wait_for_task |> success_task;
Client.VM.pause dbg id |> wait_for_task |> success_task;
Client.VM.destroy dbg id |> wait_for_task |> success_task;
)
let vm_test_build_vcpus _ =
with_vm example_uuid
(fun id ->
Client.VM.create dbg id |> wait_for_task |> success_task;
Client.VM.build dbg id |> wait_for_task |> success_task;
Client.VM.set_vcpus dbg id 1 |> wait_for_task |> fail_not_built_task;
Client.VM.create_device_model dbg id false |> wait_for_task |> success_task;
Client.VM.unpause dbg id |> wait_for_task |> success_task;
Client.VM.set_vcpus dbg id 1 |> wait_for_task |> success_task;
let state = Client.VM.stat dbg id |> snd in
if state.Vm.vcpu_target <> 1
then failwith (Printf.sprintf "vcpu_target %d <> 1" state.Vm.vcpu_target);
Client.VM.set_vcpus dbg id 2 |> wait_for_task |> success_task;
let state = Client.VM.stat dbg id |> snd in
if state.Vm.vcpu_target <> 2
then failwith (Printf.sprintf "vcpu_target %d <> 2" state.Vm.vcpu_target);
Client.VM.set_vcpus dbg id 4 |> wait_for_task |> fail_invalid_vcpus_task;
Client.VM.set_vcpus dbg id 0 |> wait_for_task |> fail_invalid_vcpus_task;
Client.VM.destroy dbg id |> wait_for_task |> success_task;
)
let vm_test_add_list_remove _ =
with_vm example_uuid
(fun id ->
let vm = create_vm example_uuid in
let (vms: (Vm.t * Vm.state) list) = Client.VM.list dbg () in
let vm' = List.find (fun x -> x.Vm.id = id) (List.map fst vms) in
vm_assert_equal vm vm'
)
let vm_remove_running _ =
with_vm example_uuid
(fun id ->
Client.VM.create dbg id |> wait_for_task |> success_task;
Client.VM.build dbg id |> wait_for_task |> success_task;
Client.VM.create_device_model dbg id false |> wait_for_task |> success_task;
Client.VM.unpause dbg id |> wait_for_task |> success_task;
fail_running (fun () -> Client.VM.remove dbg id);
Client.VM.destroy dbg id |> wait_for_task |> success_task;
)
let vm_test_start_shutdown _ =
with_vm example_uuid
(fun id ->
Client.VM.start dbg id |> wait_for_task |> success_task;
fail_running (fun () -> Client.VM.remove dbg id);
Client.VM.shutdown dbg id None |> wait_for_task |> success_task;
)
let vm_test_parallel_start_shutdown _ =
let ints = Range.to_list (Range.make 0 1000) |> List.map string_of_int in
let t = Unix.gettimeofday () in
let ids = List.map
(fun x ->
let vm = create_vm x in
Client.VM.add dbg vm
) ints in
if !verbose_timings
then (Printf.fprintf stderr "VM.adds took %.1f\n" (Unix.gettimeofday () -. t); flush stderr);
let t = Unix.gettimeofday () in
let tasks = List.map (fun id -> let id = Client.VM.start dbg id in (* Printf.fprintf stderr "%s\n" id; flush stderr; *) id) ids in
wait_for_tasks tasks;
if !verbose_timings
then (Printf.fprintf stderr "Cleaning up tasks\n"; flush stderr);
List.iter success_task tasks;
if !verbose_timings
then (Printf.fprintf stderr "VM.starts took %.1f\n" (Unix.gettimeofday () -. t); flush stderr);
let t = Unix.gettimeofday () in
let tasks = List.map (fun id -> Client.VM.shutdown dbg id None) ids in
wait_for_tasks tasks;
if !verbose_timings
then (Printf.fprintf stderr "Cleaning up tasks\n"; flush stderr);
List.iter success_task tasks;
if !verbose_timings
then (Printf.fprintf stderr "VM.shutdown took %.1f\n" (Unix.gettimeofday () -. t); flush stderr);
let t = Unix.gettimeofday () in
List.iter (fun id -> Client.VM.remove dbg id) ids;
if !verbose_timings
then (Printf.fprintf stderr "VM.remove took %.1f\n" (Unix.gettimeofday () -. t); flush stderr);
()
let vm_test_consoles _ =
()
(*
with_vm example_uuid
(fun id ->
success (Client.VM.start id);
let (_: Console.t list) = success (Client.CONSOLE.list id) in
success (Client.VM.shutdown id None);
)
*)
let vm_test_reboot _ =
with_vm example_uuid
(fun id ->
Client.VM.create dbg id |> wait_for_task |> success_task;
Client.VM.build dbg id |> wait_for_task |> success_task;
Client.VM.create_device_model dbg id false |> wait_for_task |> success_task;
Client.VM.unpause dbg id |> wait_for_task |> success_task;
let state : Vm.state = Client.VM.stat dbg id |> snd in
Client.DEBUG.trigger dbg "reboot" [ id ];
(* ... need to wait for the domain id to change *)
event_wait
(function
| Dynamic.Vm id' ->
id = id' && (match try Some (Client.VM.stat dbg id) with _ -> None with
| Some (_, vm_state) ->
vm_state.Vm.domids <> state.Vm.domids
| _ -> false
)
| _ -> false);
Client.VM.shutdown dbg id None |> wait_for_task |> success_task;
)
let vm_test_halt _ =
with_vm example_uuid
(fun id ->
Client.VM.create dbg id |> wait_for_task |> success_task;
Client.VM.build dbg id |> wait_for_task |> success_task;
Client.VM.create_device_model dbg id false |> wait_for_task |> success_task;
Client.VM.unpause dbg id |> wait_for_task |> success_task;
Client.DEBUG.trigger dbg "halt" [ id ];
(* ... need to wait for the domain ids to disappear *)
event_wait
(function
| Dynamic.Vm id' ->
id = id' && (match try Some (Client.VM.stat dbg id) with _ -> None with
| Some (_, vm_state) ->
vm_state.Vm.domids = []
| _ -> false
)
| _ -> false);
)
let vm_test_suspend _ =
with_vm example_uuid
(fun id ->
Client.VM.create dbg id |> wait_for_task |> success_task;
Client.VM.build dbg id |> wait_for_task |> success_task;
Client.VM.create_device_model dbg id false |> wait_for_task |> success_task;
Client.VM.unpause dbg id |> wait_for_task |> success_task;
Client.VM.suspend dbg id (Local "/tmp/suspend-image") |> wait_for_task |> success_task;
)
let vm_test_resume _ =
with_vm example_uuid
(fun id ->
Client.VM.resume dbg id (Local "/tmp/suspend-image") |> wait_for_task |> success_task;
Client.VM.unpause dbg id |> wait_for_task |> success_task;
Client.VM.shutdown dbg id None |> wait_for_task |> success_task;
Client.VM.destroy dbg id |> wait_for_task |> success_task;
)
module type DEVICE = sig
type t
type state
val assert_equal: t -> t -> unit
type position
val positions: position list
type id
val ids: id list
val create: id -> position -> t
val add: t -> id
val remove: id -> unit
val plug: id -> Task.id
val unplug: id -> Task.id
val list: Vm.id -> (t * state) list
val find: id -> (t * state) list -> t
end
module DeviceTests = functor(D: DEVICE) -> struct
open D
let add_remove _ =
with_vm example_uuid
(fun id ->
let dev = create (List.hd ids) (List.hd positions) in
let (dev_id: id) = add dev in
remove dev_id
)
let with_added_vm id f =
with_vm id
(fun id ->
Client.VM.create dbg id |> wait_for_task |> success_task;
finally
(fun () -> f id)
(fun () ->
Client.VM.destroy dbg id |> wait_for_task |> success_task
)
)
let add_plug_unplug_remove _ =
with_added_vm example_uuid
(fun id ->
let dev = create (List.hd ids) (List.hd positions) in
let (dev_id: id) = add dev in
plug dev_id |> wait_for_task |> success_task;
unplug dev_id |> wait_for_task |> success_task;
remove dev_id;
)
let add_plug_unplug_many_remove _ =
with_added_vm example_uuid
(fun id ->
let ids =
List.map
(fun (id, position) ->
let dev = create id position in
let id = add dev in
plug id |> wait_for_task |> success_task;
id
) (List.combine ids positions) in
List.iter
(fun id ->
unplug id |> wait_for_task |> success_task;
remove id;
) ids
)
let add_list_remove _ =
with_vm example_uuid
(fun id ->
let dev = create (List.hd ids) (List.hd positions) in
let (dev_id: id) = add dev in
let (devs: (t * state) list) = list id in
let dev' = find dev_id devs in
assert_equal dev dev';
remove dev_id;
)
let add_vm_remove _ =
with_vm example_uuid
(fun id ->
let dev = create (List.hd ids) (List.hd positions) in
let (_: id) = add dev in
()
)
let remove_running _ =
with_added_vm example_uuid
(fun id ->
let dev = create (List.hd ids) (List.hd positions) in
let (dev_id: id) = add dev in
plug dev_id |> wait_for_task |> success_task;
(* no unplug *)
fail_connected (fun () -> remove dev_id);
)
end
module VbdDeviceTests = DeviceTests(struct
type t = Vbd.t
type id = Vbd.id
type state = Vbd.state
type position = Device_number.t option
let positions = [ None; None; None ]
let ids = List.map (fun x -> example_uuid, x) [ "0"; "1"; "2" ]
let create id position =
let open Vbd in {
Vbd.id = id;
position = position;
mode = ReadWrite;
backend = Some (Local "/dev/zero");
ty = Disk;
unpluggable = true;
extra_backend_keys = [ "backend", "keys" ];
extra_private_keys = [ "private", "keys" ];
qos = None;
}
let add = Client.VBD.add dbg
let remove = Client.VBD.remove dbg
let plug = Client.VBD.plug dbg
let unplug id = Client.VBD.unplug dbg id false
let list = Client.VBD.list dbg
let find id vbds = List.find (fun (x, _) -> x.Vbd.id = id) vbds |> fst
let assert_equal vbd vbd' =
let open Vbd in
assert_equal ~msg:"id" ~printer:(fun (a, b) -> Printf.sprintf "%s.%s" a b) vbd.id vbd'.id;
assert_equal ~msg:"mode" ~printer:(function ReadWrite -> "RW" | ReadOnly -> "RO") vbd.mode vbd'.mode;
assert_equal ~msg:"backend" ~printer:(fun x -> Opt.default "None" (Opt.map (fun x -> x |> rpc_of_disk |> Jsonrpc.to_string) x)) vbd.backend vbd'.backend;
assert_equal ~msg:"unpluggable" ~printer:string_of_bool vbd.unpluggable vbd'.unpluggable;
assert_equal ~msg:"extra_backend_keys" ~printer:sl vbd.extra_backend_keys vbd'.extra_backend_keys;
assert_equal ~msg:"extra_private_keys" ~printer:sl vbd.extra_private_keys vbd'.extra_private_keys
end)
module VifDeviceTests = DeviceTests(struct
type t = Vif.t
type id = Vif.id
type state = Vif.state
type position = int
let positions = [ 0; 1; 2 ]
let ids = List.map (fun x -> example_uuid, x) [ "0"; "1"; "2" ]
let create id position =
let open Vif in {
id = id;
position = position;
mac = "c0:ff:ee:c0:ff:ee";
carrier = false;
mtu = 1450;
rate = Some(1L, 2L);
backend = Network.Local "xenbr0";
other_config = [ "other", "config" ];
locking_mode = Vif.Unlocked;
extra_private_keys = [ "private", "keys" ];
}
let add = Client.VIF.add dbg
let remove = Client.VIF.remove dbg
let plug = Client.VIF.plug dbg
let unplug id = Client.VIF.unplug dbg id false
let list = Client.VIF.list dbg
let find id vifs = List.find (fun (x, _) -> x.Vif.id = id) vifs |> fst
let assert_equal vif vif' =
let open Vif in
assert_equal ~msg:"id" ~printer:(fun (a, b) -> Printf.sprintf "%s.%s" a b) vif.id vif'.id;
assert_equal ~msg:"position" ~printer:string_of_int vif.position vif'.position;
assert_equal ~msg:"mac" ~printer:(fun x -> x) vif.mac vif'.mac;
assert_equal ~msg:"carrier" ~printer:string_of_bool vif.carrier vif'.carrier;
assert_equal ~msg:"mtu" ~printer:string_of_int vif.mtu vif'.mtu;
assert_equal ~msg:"rate" ~printer:(function Some (a, b) -> Printf.sprintf "Some %Ld %Ld" a b | None -> "None") vif.rate vif'.rate;
assert_equal ~msg:"backend" ~printer:(fun x -> x |> Network.rpc_of_t |> Jsonrpc.to_string) vif.backend vif'.backend;
assert_equal ~msg:"other_config" ~printer:sl vif.other_config vif'.other_config;
assert_equal ~msg:"extra_private_keys" ~printer:sl vif.extra_private_keys vif'.extra_private_keys
end)
let vbd_plug_ordering_good _ =
let open Vbd in
let rw position id = {
Vbd.id = (id, position);
position = None;
mode = ReadWrite;
backend = Some (Local "/dev/zero");
ty = Disk;
unpluggable = true;
extra_backend_keys = [ "backend", "keys" ];
extra_private_keys = [ "private", "keys" ];
qos = None;
} in
let ro position id = { (rw position id) with mode = ReadOnly } in
(* We'll try adding the VBDs in both a good order and a bad order.
The VM.start should plug them in the correct order. *)
let vbds = [
[ ro "0"; rw "1" ];
[ rw "0"; ro "1" ];
] in
List.iter
(fun vbds ->
with_vm example_uuid
(fun id ->
List.iter
(fun vbd ->
let (_: Vbd.id) = Client.VBD.add dbg (vbd id) in
()
) vbds;
Client.VM.start dbg id |> wait_for_task |> success_task;
Client.DEBUG.trigger dbg "check-vbd-plug-ordering" [ id ];
Client.VM.shutdown dbg id None |> wait_for_task |> success_task;
)
) vbds
let ionice_qos_scheduler _ =
let open Vbd in
(* Check that we can parse and print the qos_scheduler values *)
let prios = [ Highest; High; Normal; Low; Lowest; Other 499 ] in
let xs = Idle :: (List.map (fun x -> RealTime x) prios) @ (List.map (fun x -> BestEffort x) prios) in
List.iter
(fun x ->
let cls, param = Ionice.to_class_param x in
let y = Ionice.of_class_param_exn (string_of_int cls) (string_of_int param) in
assert_equal ~msg:"qos" ~printer:(fun x -> x |> rpc_of_qos_scheduler |> Jsonrpc.to_string) x y
) xs
let ionice_output _ =
let open Vbd in
let equals = [
"none: prio 4", None;
"best-effort: prio 2", Some(BestEffort High);
"realtime: prio 6", Some(RealTime Low);
"idle: prio 7", Some Idle;
] in
List.iter
(fun (x, y) ->
let x' = try Ionice.parse_result_exn x with _ -> None in
assert_equal ~msg:"qos" ~printer:(function None -> "None"
| Some x -> x |> rpc_of_qos_scheduler |> Jsonrpc.to_string
) x' y
) equals
let _ =
let verbose = ref false in
Arg.parse [
"-verbose", Arg.Unit (fun _ -> verbose := true), "Run in verbose mode";
] (fun x -> Printf.fprintf stderr "Ignoring argument: %s\n" x)
"Test xenopd service";
let suite = "xenops test" >:::
[
"test_query" >:: test_query;
"vm_test_remove_missing" >:: vm_test_remove_missing;
"vm_test_add_remove" >:: vm_test_add_remove;
"vm_test_create_destroy" >:: vm_test_create_destroy;
"vm_test_pause_unpause" >:: vm_test_pause_unpause;
"vm_test_build_pause_unpause" >:: vm_test_build_pause_unpause;
"vm_test_build_vcpus" >:: vm_test_build_vcpus;
"vm_test_add_list_remove" >:: vm_test_add_list_remove;
"vm_remove_running" >:: vm_remove_running;
"vm_test_start_shutdown" >:: vm_test_start_shutdown;
"vm_test_parallel_start_shutdown" >:: vm_test_parallel_start_shutdown;
"vm_test_consoles" >:: vm_test_consoles;
"vm_test_reboot" >:: vm_test_reboot;
"vm_test_halt" >:: vm_test_halt;
"vbd_test_add_remove" >:: VbdDeviceTests.add_remove;
"vbd_test_add_list_remove" >:: VbdDeviceTests.add_list_remove;
"vbd_test_add_vm_remove" >:: VbdDeviceTests.add_vm_remove;
"vbd_test_add_plug_unplug_remove" >:: VbdDeviceTests.add_plug_unplug_remove;
"vbd_test_add_plug_unplug_many_remove" >:: VbdDeviceTests.add_plug_unplug_many_remove;
"vbd_remove_running" >:: VbdDeviceTests.remove_running;
"vbd_plug_ordering_good" >:: vbd_plug_ordering_good;
"vif_test_add_remove" >:: VifDeviceTests.add_remove;
"vif_test_add_list_remove" >:: VifDeviceTests.add_list_remove;
"vif_test_add_vm_remove" >:: VifDeviceTests.add_vm_remove;
"vif_test_add_plug_unplug_remove" >:: VifDeviceTests.add_plug_unplug_remove;
"vif_test_add_plug_unplug_many_remove" >:: VifDeviceTests.add_plug_unplug_many_remove;
"vif_remove_running" >:: VifDeviceTests.remove_running;
"vm_test_suspend" >:: vm_test_suspend;
"vm_test_resume" >:: vm_test_resume;
"ionice_qos_scheduler" >:: ionice_qos_scheduler;
"ionice_output" >:: ionice_output;
] in
if !verbose then Debug.log_to_stdout ();
run_test_tt ~verbose:!verbose suite
Jump to Line
Something went wrong with that request. Please try again.