1 package PVE
::ProcFSTools
;
8 use List
::Util
qw(sum);
10 use Socket
qw(PF_INET PF_INET6 SOCK_DGRAM IPPROTO_IP);
11 use Time
::HiRes qw
(gettimeofday
);
15 use constant IFF_UP
=> 1;
16 use constant IFNAMSIZ
=> 16;
17 use constant SIOCGIFFLAGS
=> 0x8913;
19 my $clock_ticks = POSIX
::sysconf
(&POSIX
::_SC_CLK_TCK
);
24 my $fn = '/proc/cpuinfo';
26 return $cpuinfo if $cpuinfo;
29 user_hz
=> $clock_ticks,
37 my $fh = IO
::File-
>new ($fn, "r");
43 while (defined(my $line = <$fh>)) {
44 if ($line =~ m/^processor\s*:\s*\d+\s*$/i) {
46 } elsif ($line =~ m/^model\s+name\s*:\s*(.*)\s*$/i) {
47 $res->{model
} = $1 if $res->{model
} eq 'unknown';
48 } elsif ($line =~ m/^cpu\s+MHz\s*:\s*(\d+\.\d+)\s*$/i) {
49 $res->{mhz
} = $1 if !$res->{mhz
};
50 } elsif ($line =~ m/^flags\s*:\s*(.*)$/) {
51 $res->{flags
} = $1 if !length $res->{flags
};
52 } elsif ($line =~ m/^physical id\s*:\s*(\d+)\s*$/i) {
54 $idhash->{$1} = 1 if not defined($idhash->{$1});
55 } elsif ($line =~ m/^cpu cores\s*:\s*(\d+)\s*$/i) {
56 $idhash->{$cpuid} = $1 if defined($idhash->{$cpuid});
60 # Hardware Virtual Machine (Intel VT / AMD-V)
61 $res->{hvm
} = $res->{flags
} =~ m/\s(vmx|svm)\s/;
63 $res->{sockets
} = scalar(keys %$idhash) || 1;
65 $res->{cores
} = sum
(values %$idhash) || 1;
67 $res->{cpus
} = $count;
76 sub read_proc_uptime
{
79 my $line = PVE
::Tools
::file_read_firstline
("/proc/uptime");
80 if ($line && $line =~ m
|^(\d
+\
.\d
+)\s
+(\d
+\
.\d
+)\s
*$|) {
82 return (int($1*$clock_ticks), int($2*$clock_ticks));
84 return (int($1), int($2));
92 my $line = PVE
::Tools
::file_read_firstline
("/proc/version");
94 if ($line && $line =~ m
|^Linux\sversion\s
((\d
+(?
:\
.\d
+)+)-?
(\S
+)?
)|) {
95 my ($fullversion, $version_numbers, $extra) = ($1, $2, $3);
97 # variable names are the one from the Linux kernel Makefile
98 my ($version, $patchlevel, $sublevel) = split(/\./, $version_numbers);
101 ?
(int($version), int($patchlevel), int($sublevel), $extra, $fullversion)
105 return (0, 0, 0, '', '');
108 # Check if the kernel is at least $major.$minor. Return either just a boolean,
109 # or a boolean and the kernel version's major.minor string from /proc/version
110 sub check_kernel_release
{
111 my ($major, $minor) = @_;
113 my ($k_major, $k_minor) = kernel_version
();
116 if (defined($minor)) {
117 $ok = $k_major > $major || ($k_major == $major && $k_minor >= $minor);
119 $ok = $k_major >= $major;
122 return wantarray ?
($ok, "$k_major.$k_minor") : $ok;
127 my $line = PVE
::Tools
::file_read_firstline
('/proc/loadavg');
129 if ($line =~ m
|^(\d
+\
.\d
+)\s
+(\d
+\
.\d
+)\s
+(\d
+\
.\d
+)\s
+\d
+/\d
+\s
+\d
+\s
*$|) {
130 return wantarray ?
($1, $2, $3) : $1;
133 return wantarray ?
(0, 0, 0) : 0;
140 my $v = qr/\d+\.\d+/;
141 my $fh = IO
::File-
>new($path, "r") or return undef;
142 while (defined (my $line = <$fh>)) {
143 if ($line =~ /^(some|full)\s+avg10\=($v)\s+avg60\=($v)\s+avg300\=($v)\s+total\=(\d+)/) {
144 $res->{$1}->{avg10
} = $2;
145 $res->{$1}->{avg60
} = $3;
146 $res->{$1}->{avg300
} = $4;
147 $res->{$1}->{total
} = $4;
156 foreach my $type (qw(cpu memory io)) {
157 my $stats = parse_pressure
("/proc/pressure/$type");
158 $res->{$type} = $stats if $stats;
166 my $res = { user
=> 0, nice
=> 0, system => 0, idle
=> 0 , iowait
=> 0, irq
=> 0, softirq
=> 0, steal
=> 0, guest
=> 0, guest_nice
=> 0, sum
=> 0};
170 if (my $fh = IO
::File-
>new ("/proc/stat", "r")) {
171 while (defined (my $line = <$fh>)) {
172 if ($line =~ m
|^cpu\s
+(\d
+)\s
+(\d
+)\s
+(\d
+)\s
+(\d
+)\s
+(\d
+)\s
+(\d
+)\s
+(\d
+)\s
+(\d
+)(?
:\s
+(\d
+)\s
+(\d
+))?
|) {
173 $res->{user
} = $1 - ($9 // 0);
174 $res->{nice
} = $2 - ($10 // 0);
177 $res->{used
} = $1+$2+$3+$6+$7+$8;
180 $res->{softirq
} = $7;
182 $res->{guest
} = $9 // 0;
183 $res->{guest_nice
} = $10 // 0;
184 } elsif ($line =~ m
|^cpu\d
+\s
|) {
191 $cpucount = 1 if !$cpucount;
193 my $ctime = gettimeofday
; # floating point time in seconds
195 # the sum of all fields
196 $res->{total
} = $res->{user
}
205 + $res->{guest_nice
};
207 $res->{ctime
} = $ctime;
211 $last_proc_stat = $res if !$last_proc_stat;
213 my $diff = ($ctime - $last_proc_stat->{ctime
}) * $clock_ticks * $cpucount;
215 if ($diff > 1000) { # don't update too often
216 my $useddiff = $res->{used
} - $last_proc_stat->{used
};
217 $useddiff = $diff if $useddiff > $diff;
219 my $totaldiff = $res->{total
} - $last_proc_stat->{total
};
220 $totaldiff = $diff if $totaldiff > $diff;
222 $res->{cpu
} = $useddiff/$totaldiff;
224 my $waitdiff = $res->{iowait
} - $last_proc_stat->{iowait
};
225 $waitdiff = $diff if $waitdiff > $diff;
226 $res->{wait} = $waitdiff/$totaldiff;
228 $last_proc_stat = $res;
230 $res->{cpu
} = $last_proc_stat->{cpu
};
231 $res->{wait} = $last_proc_stat->{wait};
237 sub read_proc_pid_stat
{
240 my $statstr = PVE
::Tools
::file_read_firstline
("/proc/$pid/stat");
242 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+/) {
257 sub check_process_running
{
258 my ($pid, $pstart) = @_;
260 # note: waitpid only work for child processes, but not
261 # for processes spanned by other processes.
262 # kill(0, pid) return succes for zombies.
263 # So we read the status form /proc/$pid/stat instead
265 my $info = read_proc_pid_stat
($pid);
267 return $info && (!$pstart || ($info->{starttime
} eq $pstart)) && ($info->{status
} ne 'Z') ?
$info : undef;
270 sub read_proc_starttime
{
273 my $info = read_proc_pid_stat
($pid);
274 return $info ?
$info->{starttime
} : 0;
290 my $fh = IO
::File-
>new ("/proc/meminfo", "r");
294 while (my $line = <$fh>) {
295 if ($line =~ m/^(\S+):\s+(\d+)\s*kB/i) {
296 $d->{lc ($1)} = $2 * 1024;
301 $res->{memtotal
} = $d->{memtotal
};
302 $res->{memfree
} = $d->{memfree
} + $d->{buffers
} + $d->{cached
};
303 $res->{memused
} = $res->{memtotal
} - $res->{memfree
};
305 $res->{swaptotal
} = $d->{swaptotal
};
306 $res->{swapfree
} = $d->{swapfree
};
307 $res->{swapused
} = $res->{swaptotal
} - $res->{swapfree
};
309 my $spages = PVE
::Tools
::file_read_firstline
("/sys/kernel/mm/ksm/pages_sharing") // 0 ;
310 $res->{memshared
} = int($spages) * 4096;
312 my $arc_stats = eval { PVE
::Tools
::file_get_contents
("/proc/spl/kstat/zfs/arcstats") };
313 if ($arc_stats && $arc_stats =~ m/^size\s+\d+\s+(\d+)$/m) {
314 $res->{arcsize
} = int($1);
320 # memory usage of current process
321 sub read_memory_usage
{
323 my $res = { size
=> 0, resident
=> 0, shared
=> 0 };
327 my $line = PVE
::Tools
::file_read_firstline
("/proc/$$/statm");
329 if ($line =~ m/^(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s*/) {
330 $res->{size
} = $1*$ps;
331 $res->{resident
} = $2*$ps;
332 $res->{shared
} = $3*$ps;
338 sub read_proc_net_dev
{
342 my $fh = IO
::File-
>new ("/proc/net/dev", "r");
345 while (defined (my $line = <$fh>)) {
346 if ($line =~ m/^\s*(.*):\s*(\d+)\s+\d+\s+\d+\s+\d+\s+\d+\s+\d+\s+\d+\s+\d+\s+(\d+)\s+/) {
359 sub write_proc_entry
{
360 my ($filename, $data) = @_;#
362 my $fh = IO
::File-
>new($filename, O_WRONLY
);
363 die "unable to open file '$filename' - $!\n" if !$fh;
364 print $fh $data or die "unable to write '$filename' - $!\n";
365 close $fh or die "closing file '$filename' failed - $!\n";
369 sub read_proc_net_route
{
370 my $filename = "/proc/net/route";
374 my $fh = IO
::File-
>new ($filename, "r");
377 my $int_to_quad = sub {
378 return join '.' => map { ($_[0] >> 8*(3-$_)) % 256 } (3, 2, 1, 0);
381 while (defined(my $line = <$fh>)) {
382 next if $line =~/^Iface\s+Destination/; # skip head
383 my ($iface, $dest, $gateway, $metric, $mask, $mtu) = (split(/\s+/, $line))[0,1,2,6,7,8];
385 dest
=> &$int_to_quad(hex($dest)),
386 gateway
=> &$int_to_quad(hex($gateway)),
387 mask
=> &$int_to_quad(hex($mask)),
397 sub read_proc_mounts
{
398 return PVE
::Tools
::file_get_contents
("/proc/mounts", 512*1024);
401 # mounts encode spaces (\040), tabs (\011), newlines (\012), backslashes (\\ or \134)
404 return $str =~ s/\\(?:040|01[12]|134|\\)/"\"$&\""/geer;
411 while ($mounts =~ /^\s*([^#].*)$/gm) {
412 # lines from the file are encoded so we can just split at spaces
413 my ($what, $dir, $fstype, $opts) = split(/[ \t]/, $1, 4);
414 my ($freq, $passno) = (0, 0);
415 # in glibc's parser frequency and pass seem to be optional
416 $freq = $1 if $opts =~ s/\s+(\d+)$//;
417 $passno = $1 if $opts =~ s/\s+(\d+)$//;
421 decode_mount
($fstype),
430 sub parse_proc_mounts
{
431 return parse_mounts
(read_proc_mounts
());
435 my ($mountpoint) = @_;
437 $mountpoint = Cwd
::realpath
($mountpoint);
439 return 0 if !defined($mountpoint); # path does not exist
441 my $mounts = parse_proc_mounts
();
442 return (grep { $_->[1] eq $mountpoint } @$mounts) ?
1 : 0;
445 sub read_proc_net_ipv6_route
{
446 my $filename = "/proc/net/ipv6_route";
450 my $fh = IO
::File-
>new ($filename, "r");
453 my $read_v6addr = sub { $_[0] =~ s/....(?!$)/$&:/gr };
455 # ipv6_route has no header
456 while (defined(my $line = <$fh>)) {
457 my ($dest, $prefix, $nexthop, $metric, $iface) = (split(/\s+/, $line))[0,1,4,5,9];
459 dest
=> &$read_v6addr($dest),
460 prefix
=> hex("$prefix"),
461 gateway
=> &$read_v6addr($nexthop),
462 metric
=> hex("$metric"),
471 my ($upid, $waitfunc, $sleep_intervall) = @_;
473 my $task = PVE
::Tools
::upid_decode
($upid);
475 $sleep_intervall = $sleep_intervall ?
$sleep_intervall : 1;
477 my $next_time = time + $sleep_intervall;
479 while (check_process_running
($task->{pid
}, $task->{pstart
})) {
481 if (time >= $next_time && $waitfunc && ref($waitfunc) eq 'CODE'){
483 $next_time = time + $sleep_intervall;
490 # struct ifreq { // FOR SIOCGIFFLAGS:
491 # char ifrn_name[IFNAMSIZ]
494 my $STRUCT_IFREQ_SIOCGIFFLAGS = 'Z' . IFNAMSIZ
. 's1';
495 sub get_active_network_interfaces
{
496 # Use the interface name list from /proc/net/dev
497 open my $fh, '<', '/proc/net/dev'
498 or die "failed to open /proc/net/dev: $!\n";
499 # And filter by IFF_UP flag fetched via a PF_INET6 socket ioctl:
501 socket($sock, PF_INET6
, SOCK_DGRAM
, &IPPROTO_IP
)
502 or socket($sock, PF_INET
, SOCK_DGRAM
, &IPPROTO_IP
)
506 while(defined(my $line = <$fh>)) {
507 next if $line !~ /^\s*([^:\s]+):/;
509 my $ifreq = pack($STRUCT_IFREQ_SIOCGIFFLAGS, $ifname, 0);
510 if (!defined(ioctl($sock, SIOCGIFFLAGS
, $ifreq))) {
511 warn "failed to get interface flags for: $ifname\n";
514 my ($name, $flags) = unpack($STRUCT_IFREQ_SIOCGIFFLAGS, $ifreq);
515 push @$ifaces, $ifname if ($flags & IFF_UP
);