467069430c6a7baa927a4975ae3e9159925f3abe
[pve-common.git] / src / PVE / ProcFSTools.pm
1 package PVE::ProcFSTools;
2
3 use strict;
4 use warnings;
5 use POSIX;
6 use Time::HiRes qw (gettimeofday);
7 use IO::File;
8 use PVE::Tools;
9
10 my $clock_ticks = POSIX::sysconf(&POSIX::_SC_CLK_TCK);
11
12 my $cpuinfo;
13
14 sub read_cpuinfo {
15     my $fn = '/proc/cpuinfo';
16
17     return $cpuinfo if $cpuinfo;
18
19     my $res = {
20         user_hz => $clock_ticks,
21         model => 'unknown',
22         mhz => 0,
23         cpus => 1,
24         sockets => 1,
25     };
26
27     my $fh = IO::File->new ($fn, "r");
28     return $res if !$fh;
29
30     my $idhash = {};
31     my $count = 0;
32     while (defined(my $line = <$fh>)) {
33         if ($line =~ m/^processor\s*:\s*\d+\s*$/i) {
34             $count++;
35         } elsif ($line =~ m/^model\s+name\s*:\s*(.*)\s*$/i) {
36             $res->{model} = $1 if $res->{model} eq 'unknown';
37         } elsif ($line =~ m/^cpu\s+MHz\s*:\s*(\d+\.\d+)\s*$/i) {
38             $res->{mhz} = $1 if !$res->{mhz};
39         } elsif ($line =~ m/^flags\s*:.*(vmx|svm)/) {
40             $res->{hvm} = 1; # Hardware Virtual Machine (Intel VT / AMD-V)
41         } elsif ($line =~ m/^physical id\s*:\s*(\d+)\s*$/i) {
42             $idhash->{$1} = 1;
43         }
44     }
45
46     $res->{sockets} = scalar(keys %$idhash) || 1;
47
48     $res->{cpus} = $count;
49
50     $fh->close;
51     
52     $cpuinfo = $res;
53
54     return $res;
55 }
56
57 sub read_proc_uptime {
58     my $ticks = shift;
59
60     my $line = PVE::Tools::file_read_firstline("/proc/uptime");
61     if ($line && $line =~ m|^(\d+\.\d+)\s+(\d+\.\d+)\s*$|) {
62         if ($ticks) {
63             return (int($1*$clock_ticks), int($2*$clock_ticks));
64         } else {
65             return (int($1), int($2));
66         }
67     }
68
69     return (0, 0);
70 }
71
72 sub read_loadavg {
73
74     my $line = PVE::Tools::file_read_firstline('/proc/loadavg');
75
76     if ($line =~ m|^(\d+\.\d+)\s+(\d+\.\d+)\s+(\d+\.\d+)\s+\d+/\d+\s+\d+\s*$|) {
77         return wantarray ? ($1, $2, $3) : $1;
78     }
79
80     return wantarray ? (0, 0, 0) : 0;
81 }
82
83 my $last_proc_stat;
84
85 sub read_proc_stat {
86     my $res = { user => 0, nice => 0, system => 0, idle => 0 , sum => 0};
87
88     my $cpucount = 0;
89
90     if (my $fh = IO::File->new ("/proc/stat", "r")) {
91         while (defined (my $line = <$fh>)) {
92             if ($line =~ m|^cpu\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s|) {
93                 $res->{user} = $1;
94                 $res->{nice} = $2;
95                 $res->{system} = $3;
96                 $res->{idle} = $4;
97                 $res->{used} = $1+$2+$3;
98                 $res->{iowait} = $5;
99             } elsif ($line =~ m|^cpu\d+\s|) {
100                 $cpucount++;
101             }
102         }
103         $fh->close;
104     }
105
106     $cpucount = 1 if !$cpucount;
107
108     my $ctime = gettimeofday; # floating point time in seconds
109
110     $res->{ctime} = $ctime;
111     $res->{cpu} = 0;
112     $res->{wait} = 0;
113
114     $last_proc_stat = $res if !$last_proc_stat;
115
116     my $diff = ($ctime - $last_proc_stat->{ctime}) * $clock_ticks * $cpucount;
117
118     if ($diff > 1000) { # don't update too often
119         my $useddiff =  $res->{used} - $last_proc_stat->{used};
120         $useddiff = $diff if $useddiff > $diff;
121         $res->{cpu} = $useddiff/$diff;
122         my $waitdiff =  $res->{iowait} - $last_proc_stat->{iowait};
123         $waitdiff = $diff if $waitdiff > $diff;
124         $res->{wait} = $waitdiff/$diff;
125         $last_proc_stat = $res;
126     } else {
127         $res->{cpu} = $last_proc_stat->{cpu};
128         $res->{wait} = $last_proc_stat->{wait};
129     }
130
131     return $res;
132 }
133
134 sub read_proc_pid_stat {
135     my $pid = shift;
136
137     my $statstr = PVE::Tools::file_read_firstline("/proc/$pid/stat");
138
139     if ($statstr && $statstr =~ m/^$pid \(.*\) (\S) (-?\d+) -?\d+ -?\d+ -?\d+ -?\d+ \d+ \d+ \d+ \d+ \d+ (\d+) (\d+) (-?\d+) (-?\d+) -?\d+ -?\d+ -?\d+ 0 (\d+) (\d+) (-?\d+) \d+ \d+ \d+ \d+ \d+ \d+ \d+ \d+ \d+ \d+ \d+ \d+ \d+ -?\d+ -?\d+ \d+ \d+ \d+/) {
140         return {
141             status => $1,
142             utime => $3,
143             stime => $4,
144             starttime => $7,
145             vsize => $8,
146             rss => $9 * 4096,
147         };
148     }
149
150     return undef;
151 }
152
153 sub check_process_running {
154     my ($pid, $pstart) = @_;
155
156     # note: waitpid only work for child processes, but not
157     # for processes spanned by other processes.
158     # kill(0, pid) return succes for zombies.
159     # So we read the status form /proc/$pid/stat instead
160  
161     my $info = read_proc_pid_stat($pid);
162  
163     return $info && (!$pstart || ($info->{starttime} eq $pstart)) && ($info->{status} ne 'Z') ? $info : undef;
164 }
165
166 sub read_proc_starttime {
167     my $pid = shift;
168
169     my $info = read_proc_pid_stat($pid);
170     return $info ? $info->{starttime} : 0;
171 }
172
173 sub read_meminfo {
174
175     my $res = {
176         memtotal => 0,
177         memfree => 0,
178         memused => 0,
179         memshared => 0,
180         swaptotal => 0,
181         swapfree => 0,
182         swapused => 0,
183     };
184
185     my $fh = IO::File->new ("/proc/meminfo", "r");
186     return $res if !$fh;
187
188     my $d = {};
189     while (my $line = <$fh>) {
190         if ($line =~ m/^(\S+):\s+(\d+)\s*kB/i) {
191             $d->{lc ($1)} = $2 * 1024;
192         } 
193     }
194     close($fh);
195
196     $res->{memtotal} = $d->{memtotal};
197     $res->{memfree} =  $d->{memfree} + $d->{buffers} + $d->{cached};
198     $res->{memused} = $res->{memtotal} - $res->{memfree};
199
200     $res->{swaptotal} = $d->{swaptotal};
201     $res->{swapfree} = $d->{swapfree};
202     $res->{swapused} = $res->{swaptotal} - $res->{swapfree};
203
204     my $spages = PVE::Tools::file_read_firstline("/sys/kernel/mm/ksm/pages_sharing");
205     $res->{memshared} = int($spages) * 4096;
206
207     return $res;
208 }
209
210 # memory usage of current process
211 sub read_memory_usage {
212
213     my $res = { size => 0, resident => 0, shared => 0 };
214
215     my $ps = 4096;
216
217     my $line = PVE::Tools::file_read_firstline("/proc/$$/statm");
218
219     if ($line =~ m/^(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s*/) {
220         $res->{size} = $1*$ps;
221         $res->{resident} = $2*$ps;
222         $res->{shared} = $3*$ps;
223     }
224
225     return $res;
226 }
227
228 sub read_proc_net_dev {
229
230     my $res = {};
231
232     my $fh = IO::File->new ("/proc/net/dev", "r");
233     return $res if !$fh;
234
235     while (defined (my $line = <$fh>)) {
236         if ($line =~ m/^\s*(.*):\s*(\d+)\s+\d+\s+\d+\s+\d+\s+\d+\s+\d+\s+\d+\s+\d+\s+(\d+)\s+/) {
237             $res->{$1} = {
238                 receive => $2,
239                 transmit => $3,
240             };
241         }
242     }
243
244     close($fh);
245
246     return $res;
247 }
248
249 sub write_proc_entry {
250     my ($filename, $data) = @_;#
251
252     my $fh = IO::File->new($filename,  O_WRONLY);
253     die "unable to open file '$filename' - $!\n" if !$fh;
254     die "unable to write '$filename' - $!\n" unless print $fh $data;
255     die "closing file '$filename' failed - $!\n" unless close $fh;
256     $fh->close();
257 }
258
259 sub read_proc_net_route {
260     my $filename = "/proc/net/route";
261
262     my $res = [];
263
264     my $fh = IO::File->new ($filename, "r");
265     return $res if !$fh;
266
267     my $int_to_quad = sub {
268        return join '.' => map { ($_[0] >> 8*(3-$_)) % 256 } (3, 2, 1, 0);
269     };
270
271     while (defined(my $line = <$fh>)) {
272        next if $line =~/^Iface\s+Destination/; # skip head
273        my ($iface, $dest, $gateway, $metric, $mask, $mtu) = (split(/\s+/, $line))[0,1,2,6,7,8];
274        push @$res, {
275            dest => &$int_to_quad(hex($dest)),
276            gateway => &$int_to_quad(hex($gateway)),
277            mask => &$int_to_quad(hex($mask)),
278            metric => $metric,
279            mtu => $mtu,
280            iface => $iface,
281        };
282     }
283
284     return $res;
285 }
286
287 sub read_proc_mounts {
288     return PVE::Tools::file_get_contents("/proc/mounts");
289 }
290
291 sub is_mounted {
292     my ($mountpoint) = @_;
293
294     my $mountdata = read_proc_mounts();
295
296     if ($mountdata =~ m/\s$mountpoint\s/) {
297         return 1;
298     } else {
299         return 0;
300     }
301 }
302
303 sub read_proc_net_ipv6_route {
304     my $filename = "/proc/net/ipv6_route";
305
306     my $res = [];
307
308     my $fh = IO::File->new ($filename, "r");
309     return $res if !$fh;
310
311     my $read_v6addr = sub { s/....(?!$)/$&:/g };
312
313     # ipv6_route has no header
314     while (defined(my $line = <$fh>)) {
315         my ($dest, $prefix, $nexthop, $metric, $iface) = (split(/\s+/, $line))[0,1,4,5,9];
316         push @$res, {
317             dest => &$read_v6addr($dest),
318             prefix => $prefix,
319             gateway => &$read_v6addr($nexthop),
320             metric => $metric,
321             iface => $iface
322         };
323     }
324
325     return $res;
326 }
327
328 1;