Much more similar to real 'ps' command now.
[virt-mem.git] / ps / virt_ps.ml
1 (* Memory info for virtual domains.
2    (C) Copyright 2008 Richard W.M. Jones, Red Hat Inc.
3    http://libvirt.org/
4
5    This program is free software; you can redistribute it and/or modify
6    it under the terms of the GNU General Public License as published by
7    the Free Software Foundation; either version 2 of the License, or
8    (at your option) any later version.
9
10    This program is distributed in the hope that it will be useful,
11    but WITHOUT ANY WARRANTY; without even the implied warranty of
12    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
13    GNU General Public License for more details.
14
15    You should have received a copy of the GNU General Public License
16    along with this program; if not, write to the Free Software
17    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
18  *)
19
20 open Printf
21
22 open Virt_mem_gettext.Gettext
23 open Virt_mem_utils
24 open Virt_mem_types
25
26 open Kernel_task_struct
27
28 let run debug (image, ksymmap, utsname) =
29   try
30     let { domname = domname } = image in
31
32     let kernel_version =
33       match utsname with
34       | None ->
35           eprintf (f_"%s: could not guess kernel version\n") domname;
36           raise Exit
37       | Some { kernel_release = v } -> v in
38
39     if not (task_struct_known kernel_version) then (
40       eprintf (f_"%s: %s: unknown kernel version
41 Try a newer version of virt-mem, or if the guest is not from a
42 supported Linux distribution, see this page about adding support:
43   http://et.redhat.com/~rjones/virt-mem/faq.html\n") domname kernel_version;
44       raise Exit
45     );
46
47     let task_struct_size = task_struct_size kernel_version in
48
49     let init_task, init_task_addr =
50       let init_task_addr =
51         try Ksymmap.find "init_task" ksymmap
52         with Not_found ->
53           eprintf (f_"%s: could not find init_task in kernel image\n") domname;
54           raise Exit in
55       let init_task =
56         get_task_struct kernel_version image.mem init_task_addr in
57       init_task, init_task_addr in
58
59     (* Starting at init_task, navigate through the linked list of
60      * tasks (through tasks.next).  Grab each task_struct as we go.
61      *)
62     let tasks, image =
63       let rec loop image acc task =
64         let next = task.task_struct_tasks'next in
65         if next <> init_task_addr then (
66           let mapped =
67             Virt_mem_mmap.is_mapped_range image.mem next task_struct_size in
68           let image =
69             if not mapped then load_memory image next task_struct_size
70             else image in
71           let task = get_task_struct kernel_version image.mem next in
72           let task = {
73             task with
74               task_struct_comm = truncate_c_string task.task_struct_comm
75           } in
76           let acc = task :: acc in
77           loop image acc task
78         ) else
79           acc, image
80       in
81       loop image [] init_task in
82
83     (* Sort tasks by PID. *)
84     let cmp { task_struct_pid = p1 } { task_struct_pid = p2 } = compare p1 p2 in
85     let tasks = List.sort cmp tasks in
86
87     printf "  PID STAT COMMAND\n";
88
89     List.iter (
90       fun task ->
91         printf "%5Ld      %s\n" task.task_struct_pid task.task_struct_comm
92     ) tasks
93
94   with Exit -> ()
95
96 let summary = s_"list processes in virtual machine"
97 let description = s_"\
98 virt-ps prints a process listing for virtual machines running under
99 libvirt."
100
101 let () = Virt_mem.register "ps" summary description ~run