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