X-Git-Url: http://git.annexia.org/?p=virt-mem.git;a=blobdiff_plain;f=ps%2Fvirt_ps.ml;h=fe538a9f15b17e3230cce4bce64abe01e4726865;hp=100a298b25675f3aa2436312206874aec09016e8;hb=f6bb3caa719a564615e7fd2f21a3ad5bca010a88;hpb=f3de53811aa32fb257e80c3640fce1f21f7bc660 diff --git a/ps/virt_ps.ml b/ps/virt_ps.ml index 100a298..fe538a9 100644 --- a/ps/virt_ps.ml +++ b/ps/virt_ps.ml @@ -23,73 +23,26 @@ open Virt_mem_gettext.Gettext open Virt_mem_utils open Virt_mem_types +open Kernel_task_struct -let run debug (image, ksymmap, utsname) = - try - let { domname = domname } = image in +let run debug { domname = domname; mem = mem } { tasks = tasks } = + let tasks = Option.get tasks in - let kernel_version = - match utsname with - | None -> - eprintf (f_"%s: could not guess kernel version\n") domname; - raise Exit - | Some { kernel_release = v } -> v in + (* Sort tasks by PID. *) + let cmp { task_pid = p1 } { task_pid = p2 } = compare p1 p2 in + let tasks = List.sort cmp tasks in - if not (Kernel_task_struct.known kernel_version) then ( - eprintf (f_"%s: %s: unknown kernel version -Try a newer version of virt-mem, or if the guest is not from a -supported Linux distribution, see this page about adding support: - http://et.redhat.com/~rjones/virt-mem/faq.html\n") domname kernel_version; - raise Exit - ); + printf " PID STAT COMMAND\n"; - let task_struct_size = Kernel_task_struct.size kernel_version in - - let init_task, init_task_addr = - let init_task_addr = - try Ksymmap.find "init_task" ksymmap - with Not_found -> - eprintf (f_"%s: could not find init_task in kernel image\n") domname; - raise Exit in - let addr = - (Virt_mem_mmap.unsafe_typed_addr_of_addr init_task_addr : - [ `task_struct ] Virt_mem_mmap.typed_addr) in - let init_task = Kernel_task_struct.get kernel_version image.mem addr in - init_task, init_task_addr in - - (* Starting at init_task, navigate through the linked list of - * tasks (through tasks.next). Grab each task_struct as we go. - *) - let tasks, image = - let rec loop image acc task = - let next = task.Kernel_task_struct.tasks'next in - let next_addr = Virt_mem_mmap.unsafe_addr_of_typed_addr next in - if next_addr <> init_task_addr then ( - let mapped = - Virt_mem_mmap.is_mapped_range image.mem - next_addr task_struct_size in - let image = - if not mapped then load_memory image next_addr task_struct_size - else image in - let task = Kernel_task_struct.get kernel_version image.mem next in - let acc = task :: acc in - loop image acc task - ) else - acc, image - in - loop image [] init_task in - - List.iter ( - fun task -> - printf "%S\n" task.Kernel_task_struct.comm - ) tasks - - with - | Exit -> () + List.iter ( + fun task -> + printf "%5Ld %s\n" task.task_pid task.task_comm + ) tasks let summary = s_"list processes in virtual machine" let description = s_"\ virt-ps prints a process listing for virtual machines running under libvirt." -let () = Virt_mem.register "ps" summary description ~run +let () = + Virt_mem.register "ps" summary description ~needs_tasks:true ~run