X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;ds=sidebyside;f=ps%2Fvirt_ps.ml;h=5c53dbf7e29aa7475d77f94a4c3239265d2fc3e1;hb=45b7766e66fb59ece5f07305553dc54a26b32d9d;hp=41e8af7ab00dd09af3a0eb79e4531eed0c8bce4b;hpb=df3b931012515e3f0e7b741d000f4930dbea0a79;p=virt-mem.git diff --git a/ps/virt_ps.ml b/ps/virt_ps.ml index 41e8af7..5c53dbf 100644 --- a/ps/virt_ps.ml +++ b/ps/virt_ps.ml @@ -23,14 +23,50 @@ open Virt_mem_gettext.Gettext open Virt_mem_utils open Virt_mem_types +open Kernel_task_struct +let run debug { domname = domname; mem = mem } + { utsname = utsname; tasks = tasks } = + let utsname = Option.get utsname in + let kernel_version = utsname.kernel_release in + let init_task_addr = Option.get tasks in -let run debug ({ mem = mem }, ksymmap, _) = - () + (* Starting at init_task, navigate through the linked list of + * tasks (through tasks.next). The main program has already made + * sure these are mapped into memory. + *) + let tasks = + let rec loop acc task = + let next = task.task_struct_tasks'next in + if next <> init_task_addr then ( + let task = get_task_struct kernel_version mem next in + let task = { + task with + task_struct_comm = truncate_c_string task.task_struct_comm + } in + let acc = task :: acc in + loop acc task + ) else + acc + in + loop [] (get_task_struct kernel_version mem init_task_addr) in + + (* Sort tasks by PID. *) + let cmp { task_struct_pid = p1 } { task_struct_pid = p2 } = compare p1 p2 in + let tasks = List.sort cmp tasks in + + printf " PID STAT COMMAND\n"; + + List.iter ( + fun task -> + printf "%5Ld %s\n" task.task_struct_pid task.task_struct_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_utsname:true ~needs_tasks:true ~run