use strict;
use warnings;
+
+use Cwd qw();
+use IO::File;
+use List::Util qw(sum);
use POSIX;
+use Socket qw(PF_INET PF_INET6 SOCK_DGRAM IPPROTO_IP);
use Time::HiRes qw (gettimeofday);
-use IO::File;
+
use PVE::Tools;
-use Cwd qw();
+
+use constant IFF_UP => 1;
+use constant IFNAMSIZ => 16;
+use constant SIOCGIFFLAGS => 0x8913;
my $clock_ticks = POSIX::sysconf(&POSIX::_SC_CLK_TCK);
mhz => 0,
cpus => 1,
sockets => 1,
+ flags => '',
};
my $fh = IO::File->new ($fn, "r");
return $res if !$fh;
+ my $cpuid = 0;
my $idhash = {};
my $count = 0;
while (defined(my $line = <$fh>)) {
$res->{model} = $1 if $res->{model} eq 'unknown';
} elsif ($line =~ m/^cpu\s+MHz\s*:\s*(\d+\.\d+)\s*$/i) {
$res->{mhz} = $1 if !$res->{mhz};
- } elsif ($line =~ m/^flags\s*:.*(vmx|svm)/) {
- $res->{hvm} = 1; # Hardware Virtual Machine (Intel VT / AMD-V)
+ } elsif ($line =~ m/^flags\s*:\s*(.*)$/) {
+ $res->{flags} = $1 if !length $res->{flags};
} elsif ($line =~ m/^physical id\s*:\s*(\d+)\s*$/i) {
- $idhash->{$1} = 1;
+ $cpuid = $1;
+ $idhash->{$1} = 1 if not defined($idhash->{$1});
+ } elsif ($line =~ m/^cpu cores\s*:\s*(\d+)\s*$/i) {
+ $idhash->{$cpuid} = $1 if defined($idhash->{$cpuid});
}
}
+ # Hardware Virtual Machine (Intel VT / AMD-V)
+ $res->{hvm} = $res->{flags} =~ m/\s(vmx|svm)\s/;
+
$res->{sockets} = scalar(keys %$idhash) || 1;
+ $res->{cores} = sum(values %$idhash) || 1;
+
$res->{cpus} = $count;
$fh->close;
-
+
$cpuinfo = $res;
return $res;
return (0, 0);
}
+sub kernel_version {
+ my $line = PVE::Tools::file_read_firstline("/proc/version");
+
+ if ($line && $line =~ m|^Linux\sversion\s((\d+(?:\.\d+)+)-?(\S+)?)|) {
+ my ($fullversion, $version_numbers, $extra) = ($1, $2, $3);
+
+ # variable names are the one from the Linux kernel Makefile
+ my ($version, $patchlevel, $sublevel) = split(/\./, $version_numbers);
+
+ return wantarray
+ ? (int($version), int($patchlevel), int($sublevel), $extra, $fullversion)
+ : $fullversion;
+ }
+
+ return (0, 0, 0, '', '');
+}
+
+# Check if the kernel is at least $major.$minor. Return either just a boolean,
+# or a boolean and the kernel version's major.minor string from /proc/version
+sub check_kernel_release {
+ my ($major, $minor) = @_;
+
+ my ($k_major, $k_minor) = kernel_version();
+
+ my $ok;
+ if (defined($minor)) {
+ $ok = $k_major > $major || ($k_major == $major && $k_minor >= $minor);
+ } else {
+ $ok = $k_major >= $major;
+ }
+
+ return wantarray ? ($ok, "$k_major.$k_minor") : $ok;
+}
+
sub read_loadavg {
my $line = PVE::Tools::file_read_firstline('/proc/loadavg');
return wantarray ? (0, 0, 0) : 0;
}
+sub parse_pressure {
+ my ($path) = @_;
+
+ my $res = {};
+ my $v = qr/\d+\.\d+/;
+ my $fh = IO::File->new($path, "r") or return undef;
+ while (defined (my $line = <$fh>)) {
+ if ($line =~ /^(some|full)\s+avg10\=($v)\s+avg60\=($v)\s+avg300\=($v)\s+total\=(\d+)/) {
+ $res->{$1}->{avg10} = $2;
+ $res->{$1}->{avg60} = $3;
+ $res->{$1}->{avg300} = $4;
+ $res->{$1}->{total} = $4;
+ }
+ }
+ $fh->close;
+ return $res;
+}
+
+sub read_pressure {
+ my $res = {};
+ foreach my $type (qw(cpu memory io)) {
+ my $stats = parse_pressure("/proc/pressure/$type");
+ $res->{$type} = $stats if $stats;
+ }
+ return $res;
+}
+
my $last_proc_stat;
sub read_proc_stat {
- my $res = { user => 0, nice => 0, system => 0, idle => 0 , sum => 0};
+ 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};
my $cpucount = 0;
if (my $fh = IO::File->new ("/proc/stat", "r")) {
while (defined (my $line = <$fh>)) {
- if ($line =~ m|^cpu\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s|) {
- $res->{user} = $1;
- $res->{nice} = $2;
+ if ($line =~ m|^cpu\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)(?:\s+(\d+)\s+(\d+))?|) {
+ $res->{user} = $1 - ($9 // 0);
+ $res->{nice} = $2 - ($10 // 0);
$res->{system} = $3;
$res->{idle} = $4;
- $res->{used} = $1+$2+$3;
+ $res->{used} = $1+$2+$3+$6+$7+$8;
$res->{iowait} = $5;
+ $res->{irq} = $6;
+ $res->{softirq} = $7;
+ $res->{steal} = $8;
+ $res->{guest} = $9 // 0;
+ $res->{guest_nice} = $10 // 0;
} elsif ($line =~ m|^cpu\d+\s|) {
$cpucount++;
}
my $ctime = gettimeofday; # floating point time in seconds
+ # the sum of all fields
+ $res->{total} = $res->{user}
+ + $res->{nice}
+ + $res->{system}
+ + $res->{iowait}
+ + $res->{irq}
+ + $res->{softirq}
+ + $res->{steal}
+ + $res->{idle}
+ + $res->{guest}
+ + $res->{guest_nice};
+
$res->{ctime} = $ctime;
$res->{cpu} = 0;
$res->{wait} = 0;
if ($diff > 1000) { # don't update too often
my $useddiff = $res->{used} - $last_proc_stat->{used};
$useddiff = $diff if $useddiff > $diff;
- $res->{cpu} = $useddiff/$diff;
+
+ my $totaldiff = $res->{total} - $last_proc_stat->{total};
+ $totaldiff = $diff if $totaldiff > $diff;
+
+ $res->{cpu} = $useddiff/$totaldiff;
+
my $waitdiff = $res->{iowait} - $last_proc_stat->{iowait};
$waitdiff = $diff if $waitdiff > $diff;
- $res->{wait} = $waitdiff/$diff;
+ $res->{wait} = $waitdiff/$totaldiff;
+
$last_proc_stat = $res;
} else {
$res->{cpu} = $last_proc_stat->{cpu};
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+/) {
return {
status => $1,
+ ppid => $2,
utime => $3,
stime => $4,
starttime => $7,
# for processes spanned by other processes.
# kill(0, pid) return succes for zombies.
# So we read the status form /proc/$pid/stat instead
-
+
my $info = read_proc_pid_stat($pid);
-
+
return $info && (!$pstart || ($info->{starttime} eq $pstart)) && ($info->{status} ne 'Z') ? $info : undef;
}
swaptotal => 0,
swapfree => 0,
swapused => 0,
+ arcsize => 0,
};
my $fh = IO::File->new ("/proc/meminfo", "r");
while (my $line = <$fh>) {
if ($line =~ m/^(\S+):\s+(\d+)\s*kB/i) {
$d->{lc ($1)} = $2 * 1024;
- }
+ }
}
close($fh);
$res->{swapfree} = $d->{swapfree};
$res->{swapused} = $res->{swaptotal} - $res->{swapfree};
- my $spages = PVE::Tools::file_read_firstline("/sys/kernel/mm/ksm/pages_sharing");
+ my $spages = PVE::Tools::file_read_firstline("/sys/kernel/mm/ksm/pages_sharing") // 0 ;
$res->{memshared} = int($spages) * 4096;
+ my $arc_stats = eval { PVE::Tools::file_get_contents("/proc/spl/kstat/zfs/arcstats") };
+ if ($arc_stats && $arc_stats =~ m/^size\s+\d+\s+(\d+)$/m) {
+ $res->{arcsize} = int($1);
+ }
+
return $res;
}
sub write_proc_entry {
my ($filename, $data) = @_;#
- my $fh = IO::File->new($filename, O_WRONLY);
+ my $fh = IO::File->new($filename, O_WRONLY);
die "unable to open file '$filename' - $!\n" if !$fh;
- die "unable to write '$filename' - $!\n" unless print $fh $data;
- die "closing file '$filename' failed - $!\n" unless close $fh;
+ print $fh $data or die "unable to write '$filename' - $!\n";
+ close $fh or die "closing file '$filename' failed - $!\n";
$fh->close();
}
}
sub read_proc_mounts {
- return PVE::Tools::file_get_contents("/proc/mounts");
+ return PVE::Tools::file_get_contents("/proc/mounts", 512*1024);
+}
+
+# mounts encode spaces (\040), tabs (\011), newlines (\012), backslashes (\\ or \134)
+sub decode_mount {
+ my ($str) = @_;
+ return $str =~ s/\\(?:040|01[12]|134|\\)/"\"$&\""/geer;
+}
+
+sub parse_mounts {
+ my ($mounts) = @_;
+
+ my $mntent = [];
+ while ($mounts =~ /^\s*([^#].*)$/gm) {
+ # lines from the file are encoded so we can just split at spaces
+ my ($what, $dir, $fstype, $opts) = split(/[ \t]/, $1, 4);
+ my ($freq, $passno) = (0, 0);
+ # in glibc's parser frequency and pass seem to be optional
+ $freq = $1 if $opts =~ s/\s+(\d+)$//;
+ $passno = $1 if $opts =~ s/\s+(\d+)$//;
+ push @$mntent, [
+ decode_mount($what),
+ decode_mount($dir),
+ decode_mount($fstype),
+ decode_mount($opts),
+ $freq,
+ $passno,
+ ];
+ }
+ return $mntent;
+}
+
+sub parse_proc_mounts {
+ return parse_mounts(read_proc_mounts());
}
sub is_mounted {
$mountpoint = Cwd::realpath($mountpoint);
- my $mountdata = read_proc_mounts();
+ return 0 if !defined($mountpoint); # path does not exist
- if ($mountdata =~ m/\s$mountpoint\s/) {
- return 1;
- } else {
- return 0;
- }
+ my $mounts = parse_proc_mounts();
+ return (grep { $_->[1] eq $mountpoint } @$mounts) ? 1 : 0;
}
sub read_proc_net_ipv6_route {
my $fh = IO::File->new ($filename, "r");
return $res if !$fh;
- my $read_v6addr = sub { s/....(?!$)/$&:/g };
+ my $read_v6addr = sub { $_[0] =~ s/....(?!$)/$&:/gr };
# ipv6_route has no header
while (defined(my $line = <$fh>)) {
my ($dest, $prefix, $nexthop, $metric, $iface) = (split(/\s+/, $line))[0,1,4,5,9];
push @$res, {
dest => &$read_v6addr($dest),
- prefix => $prefix,
+ prefix => hex("$prefix"),
gateway => &$read_v6addr($nexthop),
- metric => $metric,
+ metric => hex("$metric"),
iface => $iface
};
}
return $res;
}
+sub upid_wait {
+ my ($upid, $waitfunc, $sleep_intervall) = @_;
+
+ my $task = PVE::Tools::upid_decode($upid);
+
+ $sleep_intervall = $sleep_intervall ? $sleep_intervall : 1;
+
+ my $next_time = time + $sleep_intervall;
+
+ while (check_process_running($task->{pid}, $task->{pstart})) {
+
+ if (time >= $next_time && $waitfunc && ref($waitfunc) eq 'CODE'){
+ &$waitfunc($task);
+ $next_time = time + $sleep_intervall;
+ }
+
+ CORE::sleep(1);
+ }
+}
+
+# struct ifreq { // FOR SIOCGIFFLAGS:
+# char ifrn_name[IFNAMSIZ]
+# short ifru_flags
+# };
+my $STRUCT_IFREQ_SIOCGIFFLAGS = 'Z' . IFNAMSIZ . 's1';
+sub get_active_network_interfaces {
+ # Use the interface name list from /proc/net/dev
+ open my $fh, '<', '/proc/net/dev'
+ or die "failed to open /proc/net/dev: $!\n";
+ # And filter by IFF_UP flag fetched via a PF_INET6 socket ioctl:
+ my $sock;
+ socket($sock, PF_INET6, SOCK_DGRAM, &IPPROTO_IP)
+ or socket($sock, PF_INET, SOCK_DGRAM, &IPPROTO_IP)
+ or return [];
+
+ my $ifaces = [];
+ while(defined(my $line = <$fh>)) {
+ next if $line !~ /^\s*([^:\s]+):/;
+ my $ifname = $1;
+ my $ifreq = pack($STRUCT_IFREQ_SIOCGIFFLAGS, $ifname, 0);
+ if (!defined(ioctl($sock, SIOCGIFFLAGS, $ifreq))) {
+ warn "failed to get interface flags for: $ifname\n";
+ next;
+ }
+ my ($name, $flags) = unpack($STRUCT_IFREQ_SIOCGIFFLAGS, $ifreq);
+ push @$ifaces, $ifname if ($flags & IFF_UP);
+ }
+ close $fh;
+ close $sock;
+ return $ifaces;
+}
+
1;
projects / pve-common.git / blobdiff