Permalink
Browse files

Update performance benchmark to use real domain and device create cod…

…e from xenops (translated to lwt)
  • Loading branch information...
1 parent 47f26bf commit bbeee1fd90d16302786f5c4917e0b1800539d77c David Scott committed Aug 8, 2012
Showing with 296 additions and 14 deletions.
  1. +296 −14 bench/xs_bench.ml
View
@@ -22,11 +22,231 @@ let ( |> ) a b = b a
(* So we can run against a real xenstore, place all nodes in a subtree *)
let prefix = "/bench"
-let vm_start domid client =
+let getdomainpath domid client =
+ lwt dom_path = with_xs client (fun xs -> getdomainpath xs domid) in
+ return (prefix ^ dom_path)
+
+let readdir d client =
+ try_lwt
+ with_xs client (fun xs -> directory xs d)
+ with Xs_packet.Enoent _ ->
+ return []
+
+let read_opt path xs =
+ try_lwt
+ lwt x = read xs path in return (Some x)
+ with Xs_packet.Enoent _ ->
+ return None
+
+let exists path xs = read_opt path xs >|= (fun x -> x <> None)
+
+module Device = struct
+
+type kind = Vif | Vbd | Tap | Pci | Vfs | Vfb | Vkbd
+
+let kind_of_string = function
+ | "vif" -> Some Vif | "vbd" -> Some Vbd | "tap" -> Some Tap
+ | "pci" -> Some Pci | "vfs" -> Some Vfs | "vfb" -> Some Vfb
+ | "vkbd" -> Some Vkbd
+ | x -> None
+
+let string_of_kind = function
+ | Vif -> "vif" | Vbd -> "vbd" | Tap -> "tap" | Pci -> "pci" | Vfs -> "vfs" | Vfb -> "vfb" | Vkbd -> "vkbd"
+
+type devid = int
+(** Represents one end of a device *)
+type endpoint = { domid: int; kind: kind; devid: int }
+
+(** Represent a device as a pair of endpoints *)
+type device = {
+ frontend: endpoint;
+ backend: endpoint
+}
+
+let parse_int i =
+ try
+ Some (int_of_string i)
+ with _ -> None
+
+let rec split ?limit:(limit=(-1)) c s =
+ let i = try String.index s c with Not_found -> -1 in
+ let nlimit = if limit = -1 || limit = 0 then limit else limit - 1 in
+ if i = -1 || nlimit = 0 then
+ [ s ]
+ else
+ let a = String.sub s 0 i
+ and b = String.sub s (i + 1) (String.length s - i - 1) in
+ a :: (split ~limit: nlimit c b)
+
+let parse_backend_link x =
+ match split '/' x with
+ | [ ""; "local"; "domain"; domid; "backend"; kind; _; devid ] ->
+ begin
+ match parse_int domid, kind_of_string kind, parse_int devid with
+ | Some domid, Some kind, Some devid ->
+ Some { domid = domid; kind = kind; devid = devid }
+ | _, _, _ -> None
+ end
+ | _ -> None
+
+let to_list xs = List.fold_left (fun acc x -> match x with
+ | Some x -> x :: acc
+ | None -> acc
+) [] xs
+
+let list_kinds dir client =
+ readdir dir client >|= List.map kind_of_string >|= to_list
+
+(* NB: we only read data from the frontend directory. Therefore this gives
+ the "frontend's point of view". *)
+let list_frontends domid client =
+ lwt dom_path = getdomainpath domid client in
+ let frontend_dir = dom_path ^ "/device" in
+ lwt kinds = list_kinds frontend_dir client in
+
+ lwt ll = Lwt_list.map_s
+ (fun k ->
+ let dir = Printf.sprintf "%s/%s" frontend_dir (string_of_kind k) in
+ lwt devids = readdir dir client >|= List.map parse_int >|= to_list in
+ Lwt_list.map_s
+ (fun devid ->
+ (* domain [domid] believes it has a frontend for
+ device [devid] *)
+ let frontend = { domid = domid; kind = k; devid = devid } in
+ try_lwt
+ with_xs client
+ (fun xs ->
+ lwt x = read xs (Printf.sprintf "%s/%d/backend" dir devid) in
+ match parse_backend_link x with
+ | Some b -> return (Some { backend = b; frontend = frontend })
+ | None -> return None
+ )
+ with _ -> return None
+ ) devids >|= to_list
+ ) kinds in
+ return (List.concat ll)
+
+(** Location of the backend in xenstore *)
+let backend_path_of_device (x: device) client =
+ lwt dom_path = getdomainpath x.backend.domid client in
+ return (Printf.sprintf "%s/backend/%s/%u/%d"
+ dom_path
+ (string_of_kind x.backend.kind)
+ x.frontend.domid x.backend.devid)
+
+(** Location of the backend error path *)
+let backend_error_path_of_device (x: device) client =
+ lwt dom_path = getdomainpath x.backend.domid client in
+ return (Printf.sprintf "%s/error/backend/%s/%d"
+ dom_path
+ (string_of_kind x.backend.kind)
+ x.frontend.domid)
+
+(** Location of the frontend in xenstore *)
+let frontend_path_of_device (x: device) client =
+ lwt dom_path = getdomainpath x.backend.domid client in
+ return (Printf.sprintf "%s/device/%s/%d"
+ dom_path
+ (string_of_kind x.frontend.kind)
+ x.frontend.devid)
+
+(** Location of the frontend error node *)
+let frontend_error_path_of_device (x: device) client =
+ lwt dom_path = getdomainpath x.frontend.domid client in
+ return (Printf.sprintf "%s/error/device/%s/%d/error"
+ dom_path
+ (string_of_kind x.frontend.kind)
+ x.frontend.devid)
+
+let hard_shutdown_request (x: device) client =
+ lwt backend_path = backend_path_of_device x client in
+ lwt frontend_path = frontend_path_of_device x client in
+ let online_path = backend_path ^ "/online" in
+ with_xs client
+ (fun xs ->
+ lwt () = write xs online_path "0" in
+ lwt () = rm xs frontend_path in
+ return ()
+ )
+
+(* We store some transient data elsewhere in xenstore to avoid it getting
+ deleted by accident when a domain shuts down. We should always zap this
+ tree on boot. *)
+let private_path = prefix ^ "/xapi"
+
+(* The private data path is only used by xapi and ignored by frontend and backend *)
+let get_private_path domid = Printf.sprintf "%s/%d" private_path domid
+
+let get_private_data_path_of_device (x: device) =
+ Printf.sprintf "%s/private/%s/%d" (get_private_path x.frontend.domid) (string_of_kind x.backend.kind) x.backend.devid
+
+(* Path in xenstore where we stuff our transient hotplug-related stuff *)
+let get_hotplug_path (x: device) =
+ Printf.sprintf "%s/hotplug/%s/%d" (get_private_path x.frontend.domid) (string_of_kind x.backend.kind) x.backend.devid
+
+let get_private_data_path_of_device (x: device) =
+ Printf.sprintf "%s/private/%s/%d" (get_private_path x.frontend.domid) (string_of_kind x.backend.kind) x.backend.devid
+
+let rm_device_state (x: device) client =
+ with_xs client
+ (fun xs ->
+ lwt fe = frontend_path_of_device x client in
+ lwt be = backend_path_of_device x client in
+ lwt ber = backend_error_path_of_device x client in
+ lwt fer = frontend_error_path_of_device x client in
+ Lwt_list.iter_s (rm xs) [ fe; be; ber; Filename.dirname fer ]
+ )
+
+let hard_shutdown device client =
+ lwt () = hard_shutdown_request device client in
+ lwt () = rm_device_state device client in
+ return ()
+
+let add device client =
+ let backend_list = []
+ and frontend_list = []
+ and private_list = [] in
+
+ lwt frontend_path = frontend_path_of_device device client in
+ lwt backend_path = backend_path_of_device device client in
+ let hotplug_path = get_hotplug_path device in
+ let private_data_path = get_private_data_path_of_device device in
+ lwt () = with_xst client
+ (fun xs ->
+ lwt _ = exists (Printf.sprintf "/local/domain/%d/vm" device.backend.domid) xs in
+ lwt _ = exists frontend_path xs in
+ lwt () = try_lwt lwt () = rm xs frontend_path in return () with _ -> return () in
+ lwt () = try_lwt lwt () = rm xs backend_path in return () with _ -> return () in
+
+ (* CA-16259: don't clear the 'hotplug_path' because this is where we
+ record our own use of /dev/loop devices. Clearing this causes us to leak
+ one per PV .iso *)
+ lwt () = mkdir xs frontend_path in
+ lwt () = setperms xs frontend_path (Xs_packet.ACL.({owner = device.frontend.domid; other = NONE; acl = [ device.backend.domid, READ ]})) in
+ lwt () = mkdir xs backend_path in
+ lwt () = setperms xs backend_path (Xs_packet.ACL.({owner = device.backend.domid; other = NONE; acl = [ device.frontend.domid, READ ]})) in
+ lwt () = mkdir xs hotplug_path in
+ lwt () = setperms xs hotplug_path (Xs_packet.ACL.({owner = device.backend.domid; other = NONE; acl = []})) in
+ lwt () = Lwt_list.iter_s (fun (x, y) -> write xs (frontend_path ^ "/" ^ x) y)
+ (("backend", backend_path) :: frontend_list) in
+ lwt () = Lwt_list.iter_s (fun (x, y) -> write xs (backend_path ^ "/" ^ x) y)
+ (("frontend", frontend_path) :: backend_list) in
+ lwt () = mkdir xs private_data_path in
+ lwt () = setperms xs private_data_path (Xs_packet.ACL.({owner = device.backend.domid; other = NONE; acl = []})) in
+ lwt () = Lwt_list.iter_s (fun (x, y) -> write xs (private_data_path ^ "/" ^ x) y)
+ (("backend-kind", string_of_kind device.backend.kind) ::
+ ("backend-id", string_of_int device.backend.domid) :: private_list) in
+ return ()
+ ) in
+ return ()
+end
+
+module Domain = struct
+
+let make domid client =
(* create /local/domain/<domid> *)
(* create 3 VBDs, 1 VIF (workaround transaction problem?) *)
- lwt dom_path = with_xs client (fun xs -> getdomainpath xs domid) in
- let dom_path = prefix ^ dom_path in
+ lwt dom_path = getdomainpath domid client in
let uuid = Printf.sprintf "uuid-%d" domid in
let name = "name" in
let vm_path = prefix ^ "/vm/" ^ uuid in
@@ -50,7 +270,7 @@ let vm_start domid client =
lwt () = mkdir xs dom_path in
lwt () = setperms xs dom_path roperm in
(* The /vm path needs to be shared over a localhost migrate *)
- lwt vm_exists = try_lwt lwt _ = read xs vm_path in return true with _ -> return false in
+ lwt vm_exists = with_xs client (exists vm_path) in
lwt () = if not vm_exists then begin
lwt () = mkdir xs vm_path in
lwt () = setperms xs vm_path roperm in
@@ -102,18 +322,80 @@ let vm_start domid client =
) in
return ()
+let control_shutdown domid client =
+ getdomainpath domid client >|= (fun x -> x ^ "/control/shutdown")
+
+let string_of_shutdown_reason _ = "halt"
+
+let get_uuid domid = Printf.sprintf "uuid-%d" domid
+
+(** Request a shutdown, return without waiting for acknowledgement *)
+let shutdown domid req client =
+ let reason = string_of_shutdown_reason req in
+ lwt path = control_shutdown domid client in
+ lwt dom_path = getdomainpath domid client in
+ with_xst client
+ (fun xs ->
+ (* Fail if the directory has been deleted *)
+ lwt domain_exists = with_xs client (exists dom_path) in
+ if domain_exists then begin
+ lwt () = write xs path reason in
+ return true
+ end else return false
+ )
+
+let destroy domid client =
+ lwt dom_path = getdomainpath domid client in
+ (* These are the devices with a frontend in [domid] and a well-formed backend
+ in some other domain *)
+ lwt all_devices = Device.list_frontends domid client in
+
+ (* Forcibly shutdown every backend *)
+ lwt () = Lwt_list.iter_s
+ (fun device ->
+ Device.hard_shutdown device client
+ ) all_devices in
+ (* Remove our reference to the /vm/<uuid> directory *)
+ lwt vm_path = with_xs client (read_opt (dom_path ^ "/vm")) in
+ lwt vss_path = with_xs client (read_opt (dom_path ^ "/vss")) in
+ lwt () = begin match vm_path with
+ | Some vm_path ->
+ with_xs client
+ (fun xs ->
+ lwt () = rm xs (vm_path ^ "/domains/" ^ (string_of_int domid)) in
+ lwt domains = readdir (vm_path ^ "/domains") client in
+ if List.filter (fun x -> x <> "") domains = [] then begin
+ lwt () = rm xs vm_path in
+ begin match vss_path with
+ | Some vss_path -> rm xs vss_path
+ | None -> return ()
+ end
+ end else return ()
+ )
+ | None -> return ()
+ end in
+ lwt () = with_xs client (fun xs -> rm xs dom_path) in
+ lwt backend_path = getdomainpath 0 client >|= (fun x -> x ^ "/backend") in
+ lwt all_backend_types = readdir backend_path client in
+ lwt () = Lwt_list.iter_s
+ (fun ty ->
+ with_xs client (fun xs -> rm xs (Printf.sprintf "%s/%s/%d" backend_path ty domid))
+ ) all_backend_types in
+ return ()
+end
let vm_shutdown domid client =
- with_xs client
- (fun xs ->
- lwt p = getdomainpath xs domid in
- let p = prefix ^ p in
- lwt () = rm xs p in
- return ()
- )
+ lwt _ = Domain.shutdown domid () client in
+ Domain.destroy domid client
let vm_cycle domid client =
- vm_start domid client >> (vm_shutdown domid client)
+ let vbd devid = {
+ Device.frontend = { Device.domid = domid; kind = Device.Vbd; devid = 0 };
+ backend = { Device.domid = 0; kind = Device.Vbd; devid = 0 }
+ } in
+ lwt () = Domain.make domid client in
+ lwt () = Lwt_list.iter_s (fun d -> Device.add d client) [ vbd 0; vbd 1; vbd 2 ] in
+ vm_shutdown domid client
let rec between start finish =
if start > finish
@@ -178,12 +460,12 @@ let main () =
| Some n -> int_of_string n in
lwt client = make () in
-(*
lwt t = time (fun () -> sequential n client) in
lwt () = Lwt_io.write Lwt_io.stdout (Printf.sprintf "%d sequential starts and shutdowns: %.02f\n" n t) in
-*)
+(*
lwt t = time (fun () -> parallel n client) in
lwt () = Lwt_io.write Lwt_io.stdout (Printf.sprintf "%d parallel starts and shutdowns: %.02f\n" n t) in
+*)
return ()
end

0 comments on commit bbeee1f

Please sign in to comment.