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