# HG changeset patch # User Jonathan Knowles # Date 1258732393 0 # Node ID bda91c19d7318e3c86f0f18914307195e3b78f7c # Parent 3e8c0167940d249deeca80f93759bd1adf2c0a45 Adds a "-pad" function to the memory_breakdown tool. When run with no arguments, memory_breakdown periodically prints a single line to stdout containing memory data for the host and all currently active domains. When run with '-pad ', where contains the data output from a previous run, memory_breakdown inserts extra padding values so that all lines in the output have the same number of columns. Signed-off-by: Jonathan Knowles diff -r 3e8c0167940d -r bda91c19d731 ocaml/xenops/memory_breakdown.ml --- a/ocaml/xenops/memory_breakdown.ml Wed Nov 11 16:55:51 2009 +0000 +++ b/ocaml/xenops/memory_breakdown.ml Fri Nov 20 15:53:13 2009 +0000 @@ -12,30 +12,59 @@ * GNU Lesser General Public License for more details. *) -(** Command-line tool for displaying host and guest memory usage. *) +open Listext +open Stringext +open Unixext + +(** Command-line tool for sampling host and guest memory usage. *) (** {2 Command line interface} *) -let cli_description = "Displays a breakdown of host and guest memory usage." +let cli_description = "\ + Displays a breakdown of host and guest memory usage.\n\n\ + \ + When run with no arguments, memory_breakdown periodically prints \ + a single line to stdout containing memory data for the host and all \ + currently active domains.\n\n\ + \ + When run with '-pad ', where contains the data output \ + from a previous run, memory_breakdown inserts extra padding values \ + so that all lines in the output have the same number of columns.\n" -let cli_delay_period_seconds = ref (1.0) +let cli_argument_delay_period_seconds = ref (1.0) +let cli_argument_existing_file_to_pad = ref "" -let cli_arguments_named = - ["-period", Arg.Set_float cli_delay_period_seconds, "Delay between updates"] +let cli_arguments_named = [ + "-pad", + Arg.Set_string cli_argument_existing_file_to_pad, + "Pads an existing data file"; + "-period", + Arg.Set_float cli_argument_delay_period_seconds, + "Delay between updates"; + ] let cli_arguments_extra = (fun x -> Printf.fprintf stderr "Ignoring argument: %s" x) -(** {2 XenStore paths} *) +(** {2 Helper functions} *) + +module Int64Set = Set.Make (Int64) + +let ordered_list_of_int64_set set = + List.sort Int64.compare (Int64Set.fold (fun x y -> x :: y) set []) + +let flip f x y = f y x + +(** {2 XenStore functions} *) let supports_ballooning_path = - Printf.sprintf "/local/domain/%Ld/control/feature-balloon" + Printf.sprintf "/local/domain/%s/control/feature-balloon" let is_uncooperative_path = - Printf.sprintf "/local/domain/%Ld/memory/uncooperative" + Printf.sprintf "/local/domain/%s/memory/uncooperative" let memory_offset_path = - Printf.sprintf "/local/domain/%Ld/memory/memory-offset" + Printf.sprintf "/local/domain/%s/memory/memory-offset" let memory_target_path = - Printf.sprintf "/local/domain/%Ld/memory/target" + Printf.sprintf "/local/domain/%s/memory/target" (** Returns true if and only if the given [path] exists in XenStore. *) let xs_exists xs path = @@ -45,78 +74,246 @@ let xs_read xs path = try Some (xs.Xs.read path) with _ -> None -(** Prints (to the console) memory information about the given [guest]. *) -let print_guest_info xc xs guest = - let id = Int64.of_int guest.Xc.domid in - let total_bytes = Memory.bytes_of_pages - (Int64.of_nativeint guest.Xc.total_memory_pages) in - let maximum_bytes = Memory.bytes_of_pages - (Int64.of_nativeint guest.Xc.max_memory_pages) in - let shadow_bytes = - if guest.Xc.hvm_guest then try - Memory.bytes_of_mib - (Int64.of_int (Xc.shadow_allocation_get xc guest.Xc.domid)) - with _ -> 0L else 0L in - let supports_ballooning = xs_exists xs (supports_ballooning_path id) in - let is_uncooperative = xs_exists xs (is_uncooperative_path id) in - let read_bytes_from_kib_key path = match xs_read xs path with +let xs_read_bytes_from_kib_key xs path = match xs_read xs path with | None -> "n/a" | Some (string) -> - Int64.to_string (Memory.bytes_of_kib (Int64.of_string string)) in - let target_bytes = read_bytes_from_kib_key (memory_target_path id) in - let offset_bytes = read_bytes_from_kib_key (memory_offset_path id) in - Printf.printf " | %Ld %Ld %Ld %Ld %s %s %b %b" - id - shadow_bytes - maximum_bytes - total_bytes - target_bytes - offset_bytes - supports_ballooning - is_uncooperative + Int64.to_string (Memory.bytes_of_kib (Int64.of_string string)) -(** Prints (to the console) memory information about the current host. *) -let print_host_info xc xs = - let time = Date.to_string (Date.of_float (Unix.gettimeofday ())) in - let host_info = Xc.physinfo xc in - let total_bytes = Memory.bytes_of_pages - (Int64.of_nativeint host_info.Xc.total_pages) in - let free_bytes = Memory.bytes_of_pages - (Int64.of_nativeint host_info.Xc.free_pages) in - let scrub_bytes = Memory.bytes_of_pages - (Int64.of_nativeint host_info.Xc.scrub_pages) in - let guests = Xc.domain_getinfolist xc 0 in - Printf.printf "%s %Ld %Ld %Ld" - time - total_bytes - free_bytes - scrub_bytes; - List.iter (print_guest_info xc xs) guests; - print_endline ""; +(** {2 Host fields} *) + +let host_time h = + Date.to_string (Date.of_float (Unix.gettimeofday ())) +let host_total_bytes h = Int64.to_string + (Memory.bytes_of_pages (Int64.of_nativeint h.Xc.total_pages)) +let host_free_bytes h = Int64.to_string + (Memory.bytes_of_pages (Int64.of_nativeint h.Xc.free_pages)) +let host_scrub_bytes h = Int64.to_string + (Memory.bytes_of_pages (Int64.of_nativeint h.Xc.scrub_pages)) + +let host_fields = [ + "host_time" , host_time ; + "host_total_bytes", host_total_bytes; + "host_free_bytes" , host_free_bytes ; + "host_scrub_bytes", host_scrub_bytes; + ] + +let host_field_names = List.map fst host_fields +let host_field_extractors = List.map snd host_fields + +(** {2 Guest fields} *) + +let guest_id xc xs g = string_of_int + (g.Xc.domid) +let guest_total_bytes xc xs g = Int64.to_string + (Memory.bytes_of_pages (Int64.of_nativeint g.Xc.total_memory_pages)) +let guest_maximum_bytes xc xs g = Int64.to_string + (Memory.bytes_of_pages (Int64.of_nativeint g.Xc.max_memory_pages)) +let guest_target_bytes xc xs g = + xs_read_bytes_from_kib_key xs (memory_target_path (guest_id xc xs g)) +let guest_offset_bytes xc xs g = + xs_read_bytes_from_kib_key xs (memory_offset_path (guest_id xc xs g)) +let guest_balloonable xc xs g = string_of_bool + (xs_exists xs (supports_ballooning_path (guest_id xc xs g))) +let guest_uncooperative xc xs g = string_of_bool + (xs_exists xs (is_uncooperative_path (guest_id xc xs g))) +let guest_shadow_bytes xc xs g = Int64.to_string + (if g.Xc.hvm_guest + then + try + Memory.bytes_of_mib + (Int64.of_int (Xc.shadow_allocation_get xc g.Xc.domid)) + with _ -> 0L + else 0L) + +let guest_fields = [ + "id" , guest_id , "-" ; + "maximum_bytes", guest_maximum_bytes, "0" ; + "shadow_bytes" , guest_shadow_bytes , "0" ; + "target_bytes" , guest_target_bytes , "0" ; + "total_bytes" , guest_total_bytes , "0" ; + "offset_bytes" , guest_offset_bytes , "0" ; + "balloonable" , guest_balloonable , "false"; + "uncooperative", guest_uncooperative, "false"; + ] + +let get_1 (x, _, _) = x +let get_2 (_, x, _) = x +let get_3 (_, _, x) = x + +let guest_field_names = List.map get_1 guest_fields +let guest_field_extractors = List.map get_2 guest_fields +let guest_field_defaults = List.map get_3 guest_fields + +(** {2 Functions that sample the system and print sparse data to the console} *) + +(** Prints memory field names to the console. *) +let print_memory_field_names () = + let host_field_names = + host_field_names in + let guest_field_names = + (List.map (fun n -> "[" ^ n ^ "...]") guest_field_names) in + print_string "| "; + print_string (String.concat " " host_field_names); + print_string " | "; + print_string (String.concat " | " guest_field_names); + print_endline " |"; flush stdout -(** Prints (to the console) column header information. *) -let print_header () = - print_endline - " time total free scrub \ - | id shadow maximum total target offset balloonable uncooperative \ - | ..."; +(** Prints memory field values to the console. *) +let print_memory_field_values xc xs = + let host = Xc.physinfo xc in + let guests = List.sort + (fun g1 g2 -> compare g1.Xc.domid g2.Xc.domid) + (Xc.domain_getinfolist xc 0) in + let print_host_info field = + print_string " "; + print_string (field host) in + let print_guest_info field = + print_string " | "; + print_string (String.concat " " (List.map (field xc xs) guests)) in + print_string "|"; + List.iter print_host_info host_field_extractors; + List.iter print_guest_info guest_field_extractors; + print_endline " |"; flush stdout (** Sleeps for the given time period in seconds. *) let sleep time_period_seconds = ignore (Unix.select [] [] [] time_period_seconds) +(** Prints a header line of memory field names, and then periodically prints a + line of memory field values. *) +let record_new_data () = + print_memory_field_names (); + Xenops_helpers.with_xc_and_xs + (fun xc xs -> + while true do + print_memory_field_values xc xs; + sleep !cli_argument_delay_period_seconds; + done + ) + +(** {2 Functions that transform sparse data files into padded data files} *) + +let sections_of_line line = + let line = String.strip ((=) '|') line in + let sections = String.split '|' line in + List.map (String.strip String.isspace) sections + +let domain_ids_of_string domain_ids_string = + try + List.map Int64.of_string (String.split ' ' domain_ids_string) + with _ -> + [] + +let domain_ids_of_line line = + match sections_of_line line with + | host_info_string :: domain_ids_string :: rest -> + domain_ids_of_string domain_ids_string + | _ -> [] + +let domain_ids_of_file file_name = + ordered_list_of_int64_set + (file_lines_fold + (fun domain_ids line -> + List.fold_left + (flip Int64Set.add) + (domain_ids) + (domain_ids_of_line line)) + (Int64Set.empty) + (file_name)) + +let pad_value_list domain_ids_all domain_ids values default_value = + let fail () = raise (Invalid_argument ( + if (List.length domain_ids) <> (List.length values) + then "Expected: length (domain_ids) = length (values)" + else if not (List.is_sorted Int64.compare domain_ids) + then "Expected: sorted (domain_ids)" + else if not (List.is_sorted Int64.compare domain_ids_all) + then "Expected: sorted (domain_ids_all)" + else if not (List.subset domain_ids domain_ids_all) + then "Expected: domain_ids subset of domain_ids_all" + else "Unknown failure")) + in + let rec pad ids_all ids vs vs_padded = + match (ids_all, ids, vs) with + | (id::ids_all, id'::ids, v::vs) when id = id' -> + pad ids_all ids vs (v :: vs_padded) + | (id::ids_all, id'::ids, v::vs) when id < id' -> + pad ids_all (id' :: ids) (v :: vs) (default_value :: vs_padded) + | (id::ids_all, [], []) -> + pad ids_all [] [] (default_value :: vs_padded) + | ([], [], []) -> + vs_padded + | _ -> + fail () + in + List.rev (pad domain_ids_all domain_ids values []) + +let pad_value_string domain_ids_all domain_ids (value_string, default_value) = + Printf.sprintf "%s |" + (String.concat " " + (pad_value_list + (domain_ids_all) + (domain_ids) + (String.split ' ' value_string) + (default_value))) + +let pad_value_strings domain_ids_all domain_ids value_strings = + String.concat " " + (List.map + (pad_value_string domain_ids_all domain_ids) + (List.combine value_strings guest_field_defaults)) + +let pad_data_line domain_ids_all line = + match sections_of_line line with + | host_string :: domain_ids_string :: value_strings -> + Printf.sprintf "| %s | %s" + (host_string) + (pad_value_strings + (domain_ids_all) + (domain_ids_of_string domain_ids_string) + (domain_ids_string :: value_strings)) + | _ -> + line + +let print_padded_data_line domain_ids_all line = + try + print_endline (pad_data_line domain_ids_all line) + with _ -> + (* Just ignore lines that cannot be processed for any reason. *) + () + +let print_padded_header_line domain_ids_all = + Printf.printf "| %s | %s\n" + (String.concat " " host_field_names) + (String.concat + (" | ") + (List.map + (fun name -> + String.concat + (" ") + (List.map + (Printf.sprintf "%s_%Ld" name) + (domain_ids_all))) + (guest_field_names))) + +let pad_existing_data () = + let domain_ids_all = + domain_ids_of_file !cli_argument_existing_file_to_pad in + print_padded_header_line domain_ids_all; + file_lines_iter + (print_padded_data_line domain_ids_all) + (!cli_argument_existing_file_to_pad); + flush stdout + +(** {2 Command line entry point.} **) + let () = Arg.parse cli_arguments_named cli_arguments_extra cli_description; - print_header (); - Xenops_helpers.with_xc_and_xs - (fun xc xs -> - while true do - print_host_info xc xs; - sleep !cli_delay_period_seconds; - done - ) \ No newline at end of file + if !cli_argument_existing_file_to_pad = "" + then record_new_data () + else pad_existing_data ()