mirror of https://github.com/mikaku/Monitorix.git
Increase time difference resolution for libvirt.pm, net.pm and process.pm.
Assuming a 60s time difference between two update calls introduces some error of up to 3% on the time intervall, especially in parallel mode. To reduce this error the time difference is measured and not assumed to be 60s.
This commit is contained in:
Andreas Bachlechner
parent
544152cd37
commit
f505f18eda
295
lib/libvirt.pm
295
lib/libvirt.pm
|
|
@ -24,9 +24,161 @@ use strict;
|
|||
use warnings;
|
||||
use Monitorix;
|
||||
use RRDs;
|
||||
use Time::HiRes;
|
||||
use Exporter 'import';
|
||||
our @EXPORT = qw(libvirt_init libvirt_update libvirt_cgi);
|
||||
|
||||
sub measure {
|
||||
my ($myself, $config, $libvirt) = @_;
|
||||
my $rrdata = "N";
|
||||
my $e = 0;
|
||||
foreach my $vmg (sort keys %{$libvirt->{list}}) {
|
||||
my @lvl = split(',', $libvirt->{list}->{$vmg});
|
||||
for(my $n = 0; $n < 8; $n++) {
|
||||
my $cpu = 0;
|
||||
my $mem = 0;
|
||||
my $dsk = 0;
|
||||
my $net = 0;
|
||||
|
||||
my $str;
|
||||
my $state = "";
|
||||
my $vm = trim($lvl[$n] || "");
|
||||
|
||||
my @vda;
|
||||
my @vmac;
|
||||
|
||||
# convert from old configuration to new
|
||||
if(ref($libvirt->{desc}->{$vm} || "") ne "HASH") {
|
||||
my $val;
|
||||
|
||||
$val = trim((split(',', $libvirt->{desc}->{$vm} || ""))[1]);
|
||||
push(@vda, $val) if $val;
|
||||
$val = trim((split(',', $libvirt->{desc}->{$vm} || ""))[2]);
|
||||
push(@vmac, $val) if $val;
|
||||
} else {
|
||||
@vda = split(',', $libvirt->{desc}->{$vm}->{disk} || "");
|
||||
@vmac = split(',', $libvirt->{desc}->{$vm}->{net} || "");
|
||||
}
|
||||
|
||||
my $vnet = "";
|
||||
|
||||
if($vm && (!scalar(@vda) || !scalar(@vmac))) {
|
||||
logger("$myself: missing parameters in '$vm' virtual machine.");
|
||||
$vm = ""; # invalidates this vm
|
||||
}
|
||||
|
||||
# check first if that 'vm' is running
|
||||
if($vm && open(IN, "$libvirt->{cmd} domstate $vm |")) {
|
||||
$state = trim(<IN>);
|
||||
close(IN);
|
||||
}
|
||||
|
||||
if($state eq "running") {
|
||||
|
||||
my $epoc_identifier = "last_epoc_" . $e . "_" . $n;
|
||||
my $last_epoc = ($config->{libvirt_hist}->{$epoc_identifier} || 0);
|
||||
my $epoc = Time::HiRes::time();
|
||||
$config->{libvirt_hist}->{$epoc_identifier} = $epoc;
|
||||
my $delta_t = ($last_epoc ne 0) ? ($epoc - $last_epoc) : 60;
|
||||
|
||||
my $t;
|
||||
|
||||
if(open(IN, "$libvirt->{cmd} cpu-stats $vm --total |")) {
|
||||
my $c = 0;
|
||||
while(<IN>) {
|
||||
if(/^\s+cpu_time\s+(\d+\.\d+) seconds$/) {
|
||||
$c = $1;
|
||||
}
|
||||
}
|
||||
close(IN);
|
||||
$str = $e . "_cpu" . $n;
|
||||
$cpu = $c - ($config->{libvirt_hist}->{$str} || 0);
|
||||
$cpu = 0 unless $c != $cpu;
|
||||
$cpu = $cpu * 100 / $delta_t;
|
||||
$cpu = $cpu > 100 ? 100 : $cpu;
|
||||
$config->{libvirt_hist}->{$str} = $c;
|
||||
}
|
||||
if(open(IN, "$libvirt->{cmd} dommemstat $vm |")) {
|
||||
while(<IN>) {
|
||||
if(/^rss\s+(\d+)$/) {
|
||||
$mem = $1 * 1024;
|
||||
}
|
||||
}
|
||||
close(IN);
|
||||
}
|
||||
|
||||
# summarizes all virtual disks stats for each 'vm'
|
||||
$t = 0;
|
||||
foreach my $vd (@vda) {
|
||||
$vd = trim($vd);
|
||||
if(open(IN, "$libvirt->{cmd} domblkstat $vm $vd |")) {
|
||||
my $r = 0;
|
||||
my $w = 0;
|
||||
while(<IN>) {
|
||||
if(/^$vd\s+rd_bytes\s+(\d+)$/) {
|
||||
$r = $1;
|
||||
}
|
||||
if(/^$vd\s+wr_bytes\s+(\d+)$/) {
|
||||
$w = $1;
|
||||
last;
|
||||
}
|
||||
}
|
||||
close(IN);
|
||||
$t += ($r + $w);
|
||||
}
|
||||
}
|
||||
$str = $e . "_dsk" . $n;
|
||||
$dsk = $t - ($config->{libvirt_hist}->{$str} || 0);
|
||||
$dsk = 0 unless $t != $dsk;
|
||||
$dsk /= $delta_t;
|
||||
$config->{libvirt_hist}->{$str} = $t;
|
||||
|
||||
# summarizes all virtual network stats for each 'vm'
|
||||
$t = 0;
|
||||
foreach my $vn (@vmac) {
|
||||
$vn = trim($vn);
|
||||
if(open(IN, "$libvirt->{cmd} domiflist $vm |")) {
|
||||
while(<IN>) {
|
||||
if(/^\s*(\S+)\s+.*?\s+$vn$/) {
|
||||
$vnet = $1;
|
||||
}
|
||||
}
|
||||
close(IN);
|
||||
}
|
||||
if(!$vnet) {
|
||||
logger("$myself: invalid MAC address '$vn' in '$vm'.");
|
||||
next;
|
||||
}
|
||||
|
||||
if(open(IN, "$libvirt->{cmd} domifstat $vm $vnet |")) {
|
||||
my $r = 0;
|
||||
my $w = 0;
|
||||
while(<IN>) {
|
||||
if(/^$vnet\s+rx_bytes\s+(\d+)$/) {
|
||||
$r = $1;
|
||||
}
|
||||
if(/^$vnet\s+tx_bytes\s+(\d+)$/) {
|
||||
$w = $1;
|
||||
last;
|
||||
}
|
||||
}
|
||||
close(IN);
|
||||
$t += ($r + $w);
|
||||
}
|
||||
}
|
||||
$str = $e . "_net" . $n;
|
||||
$net = $t - ($config->{libvirt_hist}->{$str} || 0);
|
||||
$net = 0 unless $t != $net;
|
||||
$net /= $delta_t;
|
||||
$config->{libvirt_hist}->{$str} = $t;
|
||||
}
|
||||
$rrdata .= ":$cpu:$mem:$dsk:$net:0:0:0:0";
|
||||
}
|
||||
$e++;
|
||||
}
|
||||
return $rrdata;
|
||||
}
|
||||
|
||||
sub libvirt_init {
|
||||
my $myself = (caller(0))[3];
|
||||
my ($package, $config, $debug) = @_;
|
||||
|
|
@ -133,6 +285,7 @@ sub libvirt_init {
|
|||
|
||||
$config->{libvirt_hist} = ();
|
||||
push(@{$config->{func_update}}, $package);
|
||||
measure($myself, $config, $libvirt); # Call to measuring routine to initialize the last values for calculating the differences. This way, the first update call will actually measure correct values.
|
||||
logger("$myself: Ok") if $debug;
|
||||
}
|
||||
|
||||
|
|
@ -142,147 +295,7 @@ sub libvirt_update {
|
|||
my $rrd = $config->{base_lib} . $package . ".rrd";
|
||||
my $libvirt = $config->{libvirt};
|
||||
|
||||
my $n;
|
||||
my $rrdata = "N";
|
||||
|
||||
my $e = 0;
|
||||
foreach my $vmg (sort keys %{$libvirt->{list}}) {
|
||||
my @lvl = split(',', $libvirt->{list}->{$vmg});
|
||||
for($n = 0; $n < 8; $n++) {
|
||||
my $cpu = 0;
|
||||
my $mem = 0;
|
||||
my $dsk = 0;
|
||||
my $net = 0;
|
||||
|
||||
my $str;
|
||||
my $state = "";
|
||||
my $vm = trim($lvl[$n] || "");
|
||||
|
||||
my @vda;
|
||||
my @vmac;
|
||||
|
||||
# convert from old configuration to new
|
||||
if(ref($libvirt->{desc}->{$vm} || "") ne "HASH") {
|
||||
my $val;
|
||||
|
||||
$val = trim((split(',', $libvirt->{desc}->{$vm} || ""))[1]);
|
||||
push(@vda, $val) if $val;
|
||||
$val = trim((split(',', $libvirt->{desc}->{$vm} || ""))[2]);
|
||||
push(@vmac, $val) if $val;
|
||||
} else {
|
||||
@vda = split(',', $libvirt->{desc}->{$vm}->{disk} || "");
|
||||
@vmac = split(',', $libvirt->{desc}->{$vm}->{net} || "");
|
||||
}
|
||||
|
||||
my $vnet = "";
|
||||
|
||||
if($vm && (!scalar(@vda) || !scalar(@vmac))) {
|
||||
logger("$myself: missing parameters in '$vm' virtual machine.");
|
||||
$vm = ""; # invalidates this vm
|
||||
}
|
||||
|
||||
# check first if that 'vm' is running
|
||||
if($vm && open(IN, "$libvirt->{cmd} domstate $vm |")) {
|
||||
$state = trim(<IN>);
|
||||
close(IN);
|
||||
}
|
||||
|
||||
if($state eq "running") {
|
||||
my $t;
|
||||
|
||||
if(open(IN, "$libvirt->{cmd} cpu-stats $vm --total |")) {
|
||||
my $c = 0;
|
||||
while(<IN>) {
|
||||
if(/^\s+cpu_time\s+(\d+\.\d+) seconds$/) {
|
||||
$c = $1;
|
||||
}
|
||||
}
|
||||
close(IN);
|
||||
$str = $e . "_cpu" . $n;
|
||||
$cpu = $c - ($config->{libvirt_hist}->{$str} || 0);
|
||||
$cpu = 0 unless $c != $cpu;
|
||||
$cpu = $cpu * 100 / 60;
|
||||
$cpu = $cpu > 100 ? 100 : $cpu;
|
||||
$config->{libvirt_hist}->{$str} = $c;
|
||||
}
|
||||
if(open(IN, "$libvirt->{cmd} dommemstat $vm |")) {
|
||||
while(<IN>) {
|
||||
if(/^rss\s+(\d+)$/) {
|
||||
$mem = $1 * 1024;
|
||||
}
|
||||
}
|
||||
close(IN);
|
||||
}
|
||||
|
||||
# summarizes all virtual disks stats for each 'vm'
|
||||
$t = 0;
|
||||
foreach my $vd (@vda) {
|
||||
$vd = trim($vd);
|
||||
if(open(IN, "$libvirt->{cmd} domblkstat $vm $vd |")) {
|
||||
my $r = 0;
|
||||
my $w = 0;
|
||||
while(<IN>) {
|
||||
if(/^$vd\s+rd_bytes\s+(\d+)$/) {
|
||||
$r = $1;
|
||||
}
|
||||
if(/^$vd\s+wr_bytes\s+(\d+)$/) {
|
||||
$w = $1;
|
||||
last;
|
||||
}
|
||||
}
|
||||
close(IN);
|
||||
$t += ($r + $w);
|
||||
}
|
||||
}
|
||||
$str = $e . "_dsk" . $n;
|
||||
$dsk = $t - ($config->{libvirt_hist}->{$str} || 0);
|
||||
$dsk = 0 unless $t != $dsk;
|
||||
$dsk /= 60;
|
||||
$config->{libvirt_hist}->{$str} = $t;
|
||||
|
||||
# summarizes all virtual network stats for each 'vm'
|
||||
$t = 0;
|
||||
foreach my $vn (@vmac) {
|
||||
$vn = trim($vn);
|
||||
if(open(IN, "$libvirt->{cmd} domiflist $vm |")) {
|
||||
while(<IN>) {
|
||||
if(/^\s*(\S+)\s+.*?\s+$vn$/) {
|
||||
$vnet = $1;
|
||||
}
|
||||
}
|
||||
close(IN);
|
||||
}
|
||||
if(!$vnet) {
|
||||
logger("$myself: invalid MAC address '$vn' in '$vm'.");
|
||||
next;
|
||||
}
|
||||
|
||||
if(open(IN, "$libvirt->{cmd} domifstat $vm $vnet |")) {
|
||||
my $r = 0;
|
||||
my $w = 0;
|
||||
while(<IN>) {
|
||||
if(/^$vnet\s+rx_bytes\s+(\d+)$/) {
|
||||
$r = $1;
|
||||
}
|
||||
if(/^$vnet\s+tx_bytes\s+(\d+)$/) {
|
||||
$w = $1;
|
||||
last;
|
||||
}
|
||||
}
|
||||
close(IN);
|
||||
$t += ($r + $w);
|
||||
}
|
||||
}
|
||||
$str = $e . "_net" . $n;
|
||||
$net = $t - ($config->{libvirt_hist}->{$str} || 0);
|
||||
$net = 0 unless $t != $net;
|
||||
$net /= 60;
|
||||
$config->{libvirt_hist}->{$str} = $t;
|
||||
}
|
||||
$rrdata .= ":$cpu:$mem:$dsk:$net:0:0:0:0";
|
||||
}
|
||||
$e++;
|
||||
}
|
||||
my $rrdata = measure($myself, $config, $libvirt);
|
||||
|
||||
RRDs::update($rrd, $rrdata);
|
||||
logger("$myself: $rrdata") if $debug;
|
||||
|
|
|
|||
200
lib/net.pm
200
lib/net.pm
|
|
@ -24,9 +24,113 @@ use strict;
|
|||
use warnings;
|
||||
use Monitorix;
|
||||
use RRDs;
|
||||
use Time::HiRes;
|
||||
use Exporter 'import';
|
||||
our @EXPORT = qw(net_init net_update net_cgi);
|
||||
|
||||
sub measure {
|
||||
my ($myself, $config, $net) = @_;
|
||||
my $rrdata = "N";
|
||||
for(my $n = 0; $n < $net->{max} ; $n++) {
|
||||
my ($bytes_in, $bi) = (0, 0);
|
||||
my ($bytes_out, $bo) = (0, 0);
|
||||
my ($packs_in, $pi) = (0, 0);
|
||||
my ($packs_out, $po) = (0, 0);
|
||||
my ($error_in, $ei) = (0, 0);
|
||||
my ($error_out, $eo) = (0, 0);
|
||||
my $str;
|
||||
|
||||
if($n < scalar(my @nl = split(',', $net->{list}))) {
|
||||
$nl[$n] = trim($nl[$n]);
|
||||
if($config->{os} eq "Linux") {
|
||||
open(IN, "/proc/net/dev");
|
||||
while(<IN>) {
|
||||
my ($dev, $data) = split(':', $_);
|
||||
if(trim($dev) eq $nl[$n]) {
|
||||
($bi, $pi, $ei, undef, undef, undef, undef, undef, $bo, $po, $eo) = split(' ', $data);
|
||||
last;
|
||||
}
|
||||
}
|
||||
close(IN);
|
||||
} elsif($config->{os} eq "FreeBSD") {
|
||||
open(IN, "netstat -nibdW |");
|
||||
while(<IN>) {
|
||||
if(/Link/ && /$nl[$n]/) {
|
||||
# Idrop column added in 8.0
|
||||
if($config->{kernel} > "7.2") {
|
||||
(undef, undef, undef, undef, $pi, $ei, undef, $bi, $po, $eo, $bo) = split(' ', $_);
|
||||
} else {
|
||||
(undef, undef, undef, undef, $pi, $ei, $bi, $po, $eo, $bo) = split(' ', $_);
|
||||
}
|
||||
last;
|
||||
}
|
||||
}
|
||||
close(IN);
|
||||
} elsif($config->{os} eq "OpenBSD" || $config->{os} eq "NetBSD") {
|
||||
open(IN, "netstat -nibd |");
|
||||
while(<IN>) {
|
||||
if(/Link/ && /^$nl[$n]/) {
|
||||
(undef, undef, undef, undef, $bi, $bo) = split(' ', $_);
|
||||
$pi = 0;
|
||||
$ei = 0;
|
||||
$po = 0;
|
||||
$eo = 0;
|
||||
last;
|
||||
}
|
||||
}
|
||||
close(IN);
|
||||
}
|
||||
}
|
||||
chomp($bi, $bo, $pi, $po, $ei, $eo);
|
||||
|
||||
my $epoc_identifier = "last_epoc_" . $n;
|
||||
my $last_epoc = ($config->{net_hist}->{$epoc_identifier} || 0);
|
||||
my $epoc = Time::HiRes::time();
|
||||
$config->{net_hist}->{$epoc_identifier} = $epoc;
|
||||
my $delta_t = ($last_epoc ne 0) ? ($epoc - $last_epoc) : 60;
|
||||
|
||||
$str = $n . "_bytes_in";
|
||||
$bytes_in = $bi - ($config->{net_hist}->{$str} || 0);
|
||||
$bytes_in = 0 unless $bytes_in != $bi;
|
||||
$config->{net_hist}->{$str} = $bi;
|
||||
$bytes_in /= $delta_t;
|
||||
|
||||
$str = $n . "_bytes_out";
|
||||
$bytes_out = $bo - ($config->{net_hist}->{$str} || 0);
|
||||
$bytes_out = 0 unless $bytes_out != $bo;
|
||||
$config->{net_hist}->{$str} = $bo;
|
||||
$bytes_out /= $delta_t;
|
||||
|
||||
$str = $n . "_packs_in";
|
||||
$packs_in = $pi - ($config->{net_hist}->{$str} || 0);
|
||||
$packs_in = 0 unless $packs_in != $pi;
|
||||
$config->{net_hist}->{$str} = $pi;
|
||||
$packs_in /= $delta_t;
|
||||
|
||||
$str = $n . "_packs_out";
|
||||
$packs_out = $po - ($config->{net_hist}->{$str} || 0);
|
||||
$packs_out = 0 unless $packs_out != $po;
|
||||
$config->{net_hist}->{$str} = $po;
|
||||
$packs_out /= $delta_t;
|
||||
|
||||
$str = $n . "_error_in";
|
||||
$error_in = $ei - ($config->{net_hist}->{$str} || 0);
|
||||
$error_in = 0 unless $error_in != $ei;
|
||||
$config->{net_hist}->{$str} = $ei;
|
||||
$error_in /= $delta_t;
|
||||
|
||||
$str = $n . "_error_out";
|
||||
$error_out = $eo - ($config->{net_hist}->{$str} || 0);
|
||||
$error_out = 0 unless $error_out != $eo;
|
||||
$config->{net_hist}->{$str} = $eo;
|
||||
$error_out /= $delta_t;
|
||||
|
||||
$rrdata .= ":$bytes_in:$bytes_out:$packs_in:$packs_out:$error_in:$error_out";
|
||||
}
|
||||
|
||||
return $rrdata;
|
||||
}
|
||||
|
||||
sub net_init {
|
||||
my $myself = (caller(0))[3];
|
||||
my ($package, $config, $debug) = @_;
|
||||
|
|
@ -137,6 +241,7 @@ sub net_init {
|
|||
|
||||
$config->{net_hist} = ();
|
||||
push(@{$config->{func_update}}, $package);
|
||||
measure($myself, $config, $net); # Call to measuring routine to initialize the last values for calculating the differences. This way, the first update call will actually measure correct values.
|
||||
logger("$myself: Ok") if $debug;
|
||||
}
|
||||
|
||||
|
|
@ -146,100 +251,7 @@ sub net_update {
|
|||
my $rrd = $config->{base_lib} . $package . ".rrd";
|
||||
my $net = $config->{net};
|
||||
|
||||
my $n;
|
||||
my $rrdata = "N";
|
||||
|
||||
for($n = 0; $n < $net->{max} ; $n++) {
|
||||
my ($bytes_in, $bi) = (0, 0);
|
||||
my ($bytes_out, $bo) = (0, 0);
|
||||
my ($packs_in, $pi) = (0, 0);
|
||||
my ($packs_out, $po) = (0, 0);
|
||||
my ($error_in, $ei) = (0, 0);
|
||||
my ($error_out, $eo) = (0, 0);
|
||||
my $str;
|
||||
|
||||
if($n < scalar(my @nl = split(',', $net->{list}))) {
|
||||
$nl[$n] = trim($nl[$n]);
|
||||
if($config->{os} eq "Linux") {
|
||||
open(IN, "/proc/net/dev");
|
||||
while(<IN>) {
|
||||
my ($dev, $data) = split(':', $_);
|
||||
if(trim($dev) eq $nl[$n]) {
|
||||
($bi, $pi, $ei, undef, undef, undef, undef, undef, $bo, $po, $eo) = split(' ', $data);
|
||||
last;
|
||||
}
|
||||
}
|
||||
close(IN);
|
||||
} elsif($config->{os} eq "FreeBSD") {
|
||||
open(IN, "netstat -nibdW |");
|
||||
while(<IN>) {
|
||||
if(/Link/ && /$nl[$n]/) {
|
||||
# Idrop column added in 8.0
|
||||
if($config->{kernel} > "7.2") {
|
||||
(undef, undef, undef, undef, $pi, $ei, undef, $bi, $po, $eo, $bo) = split(' ', $_);
|
||||
} else {
|
||||
(undef, undef, undef, undef, $pi, $ei, $bi, $po, $eo, $bo) = split(' ', $_);
|
||||
}
|
||||
last;
|
||||
}
|
||||
}
|
||||
close(IN);
|
||||
} elsif($config->{os} eq "OpenBSD" || $config->{os} eq "NetBSD") {
|
||||
open(IN, "netstat -nibd |");
|
||||
while(<IN>) {
|
||||
if(/Link/ && /^$nl[$n]/) {
|
||||
(undef, undef, undef, undef, $bi, $bo) = split(' ', $_);
|
||||
$pi = 0;
|
||||
$ei = 0;
|
||||
$po = 0;
|
||||
$eo = 0;
|
||||
last;
|
||||
}
|
||||
}
|
||||
close(IN);
|
||||
}
|
||||
}
|
||||
chomp($bi, $bo, $pi, $po, $ei, $eo);
|
||||
|
||||
$str = $n . "_bytes_in";
|
||||
$bytes_in = $bi - ($config->{net_hist}->{$str} || 0);
|
||||
$bytes_in = 0 unless $bytes_in != $bi;
|
||||
$config->{net_hist}->{$str} = $bi;
|
||||
$bytes_in /= 60;
|
||||
|
||||
$str = $n . "_bytes_out";
|
||||
$bytes_out = $bo - ($config->{net_hist}->{$str} || 0);
|
||||
$bytes_out = 0 unless $bytes_out != $bo;
|
||||
$config->{net_hist}->{$str} = $bo;
|
||||
$bytes_out /= 60;
|
||||
|
||||
$str = $n . "_packs_in";
|
||||
$packs_in = $pi - ($config->{net_hist}->{$str} || 0);
|
||||
$packs_in = 0 unless $packs_in != $pi;
|
||||
$config->{net_hist}->{$str} = $pi;
|
||||
$packs_in /= 60;
|
||||
|
||||
$str = $n . "_packs_out";
|
||||
$packs_out = $po - ($config->{net_hist}->{$str} || 0);
|
||||
$packs_out = 0 unless $packs_out != $po;
|
||||
$config->{net_hist}->{$str} = $po;
|
||||
$packs_out /= 60;
|
||||
|
||||
$str = $n . "_error_in";
|
||||
$error_in = $ei - ($config->{net_hist}->{$str} || 0);
|
||||
$error_in = 0 unless $error_in != $ei;
|
||||
$config->{net_hist}->{$str} = $ei;
|
||||
$error_in /= 60;
|
||||
|
||||
$str = $n . "_error_out";
|
||||
$error_out = $eo - ($config->{net_hist}->{$str} || 0);
|
||||
$error_out = 0 unless $error_out != $eo;
|
||||
$config->{net_hist}->{$str} = $eo;
|
||||
$error_out /= 60;
|
||||
|
||||
|
||||
$rrdata .= ":$bytes_in:$bytes_out:$packs_in:$packs_out:$error_in:$error_out";
|
||||
}
|
||||
my $rrdata = measure($myself, $config, $net);
|
||||
|
||||
RRDs::update($rrd, $rrdata);
|
||||
logger("$myself: $rrdata") if $debug;
|
||||
|
|
|
|||
348
lib/process.pm
348
lib/process.pm
|
|
@ -24,9 +24,188 @@ use strict;
|
|||
use warnings;
|
||||
use Monitorix;
|
||||
use RRDs;
|
||||
use Time::HiRes;
|
||||
use Exporter 'import';
|
||||
our @EXPORT = qw(process_init process_update process_cgi);
|
||||
|
||||
sub measure {
|
||||
my ($myself, $config, $process) = @_;
|
||||
my $rrdata = "N";
|
||||
my $ticks = `getconf CLK_TCK`;
|
||||
my ($sysuptime) = split(' ', `cat /proc/uptime`);
|
||||
|
||||
my $e = 0;
|
||||
foreach my $pg (sort keys %{$process->{list}}) {
|
||||
my @lp = split(',', $process->{list}->{$pg});
|
||||
for(my $n = 0; $n < 10; $n++) {
|
||||
my $cpu = 0;
|
||||
my $mem = 0;
|
||||
my $dsk = 0;
|
||||
my $net = 0;
|
||||
my $nof = 0;
|
||||
my $pro = 0;
|
||||
my $nth = 0;
|
||||
my $vcs = 0;
|
||||
my $ics = 0;
|
||||
my $upt = 0;
|
||||
|
||||
my $str;
|
||||
my @pids;
|
||||
my $p = trim($lp[$n] || "");
|
||||
my $val;
|
||||
my $s_usage = 0;
|
||||
|
||||
# check if that process is running
|
||||
if(open(IN, "ps -eo pid,comm,command |")) {
|
||||
my $pidwidth = length(`cat /proc/sys/kernel/pid_max`);
|
||||
|
||||
while(<IN>) {
|
||||
if(m/^\s*(\d+)\s+(\S+)\s+(.*?)$/) {
|
||||
if($p eq trim($2)) {
|
||||
push(@pids, $1);
|
||||
$pro++;
|
||||
next;
|
||||
}
|
||||
if($p eq trim($3)) {
|
||||
push(@pids, $1);
|
||||
$pro++;
|
||||
next;
|
||||
}
|
||||
if(index($3, $p) != -1) {
|
||||
push(@pids, $1);
|
||||
$pro++;
|
||||
next;
|
||||
}
|
||||
}
|
||||
if(substr($p, 0, 15) eq substr($_, $pidwidth, 15)) {
|
||||
push(@pids, $1);
|
||||
$pro++;
|
||||
next;
|
||||
}
|
||||
}
|
||||
close(IN);
|
||||
}
|
||||
|
||||
if(open(IN, "/proc/stat")) {
|
||||
while(<IN>) {
|
||||
if(/^cpu /) {
|
||||
my (undef, $user, $nice, $sys, $idle, $iow, $irq, $sirq, $steal, $guest) = split(' ', $_);
|
||||
$s_usage = $user + $nice + $sys + $idle + $iow + $irq + $sirq + $steal + ($guest || 0);
|
||||
last;
|
||||
}
|
||||
}
|
||||
close(IN);
|
||||
}
|
||||
|
||||
my $p_usage = 0;
|
||||
foreach my $pid (@pids) {
|
||||
if(open(IN, "/proc/$pid/stat")) {
|
||||
my $utime = 0;
|
||||
my $stime = 0;
|
||||
my $v_nth = 0;
|
||||
my $starttime = 0;
|
||||
my $v_mem = 0;
|
||||
my $rest;
|
||||
|
||||
# since a process name can include spaces an 'split(' ', <IN>)' wouldn't work here,
|
||||
# therefore we discard the first part of the process information (pid, comm and state).
|
||||
(undef, $rest) = <IN> =~ m/^(\d+\s\(.*?\)\s\S\s)(.*?)$/;
|
||||
close(IN);
|
||||
if($rest) {
|
||||
(undef, undef, undef, undef, undef, undef, undef, undef, undef, undef, $utime, $stime, undef, undef, undef, undef, $v_nth, undef, $starttime, undef, $v_mem) = split(' ', $rest);
|
||||
$mem += ($v_mem *= 4096);
|
||||
$nth += ($v_nth - 1);
|
||||
$p_usage += $utime + $stime;
|
||||
$starttime /= $ticks;
|
||||
my $diff = $sysuptime - $starttime;
|
||||
$upt = $diff unless $diff < $upt;
|
||||
} else {
|
||||
logger("$myself: WARNING: PID $pid ('$p') has vanished while accounting!");
|
||||
}
|
||||
}
|
||||
}
|
||||
$str = $e . "_cpu" . $n;
|
||||
$cpu += 100 * ($p_usage - ($config->{process_hist}->{$str}->{pusage} || 0)) / ($s_usage - ($config->{process_hist}->{$str}->{susage} || 0));
|
||||
$config->{process_hist}->{$str}->{pusage} = $p_usage;
|
||||
$config->{process_hist}->{$str}->{susage} = $s_usage;
|
||||
|
||||
my $v_dsk = 0;
|
||||
my $v_net = 0;
|
||||
foreach my $pid (@pids) {
|
||||
if(open(IN, "/proc/$pid/io")) {
|
||||
my $rchar = 0;
|
||||
my $wchar = 0;
|
||||
my $readb = 0;
|
||||
my $writb = 0;
|
||||
while(<IN>) {
|
||||
$rchar = $1 if /^rchar:\s+(\d+)$/;
|
||||
$wchar = $1 if /^wchar:\s+(\d+)$/;
|
||||
$readb = $1 if /^read_bytes:\s+(\d+)$/;
|
||||
$writb = $1 if /^write_bytes:\s+(\d+)$/;
|
||||
}
|
||||
close(IN);
|
||||
$v_dsk += $readb + $writb;
|
||||
$v_net += ($rchar + $wchar) - ($readb + $writb);
|
||||
}
|
||||
}
|
||||
my $epoc_identifier = "last_epoc_" . $e . "_" . $n;
|
||||
my $last_epoc = ($config->{process_hist}->{$epoc_identifier} || 0);
|
||||
my $epoc = Time::HiRes::time();
|
||||
$config->{process_hist}->{$epoc_identifier} = $epoc;
|
||||
my $delta_t = ($last_epoc ne 0) ? ($epoc - $last_epoc) : 60;
|
||||
|
||||
$str = $e . "_dsk" . $n;
|
||||
$dsk = $v_dsk - ($config->{process_hist}->{$str} || 0);
|
||||
$dsk = 0 unless $v_dsk != $dsk;
|
||||
$dsk /= $delta_t;
|
||||
$config->{process_hist}->{$str} = $v_dsk;
|
||||
$str = $e . "_net" . $n;
|
||||
$net = $v_net - ($config->{process_hist}->{$str} || 0);
|
||||
$net = 0 unless $v_net != $net;
|
||||
$net /= $delta_t;
|
||||
$config->{process_hist}->{$str} = $v_net;
|
||||
$net = 0 if $net < 0;
|
||||
|
||||
my $v_vcs = 0;
|
||||
my $v_ics = 0;
|
||||
foreach my $pid (@pids) {
|
||||
if(opendir(DIR, "/proc/$pid/fdinfo")) {
|
||||
my @files = grep { !/^[.]/ } readdir(DIR);
|
||||
$nof += scalar(@files);
|
||||
closedir(DIR);
|
||||
}
|
||||
|
||||
if(open(IN, "/proc/$pid/status")) {
|
||||
while(<IN>) {
|
||||
if(/^voluntary_ctxt_switches:\s+(\d+)$/) {
|
||||
$v_vcs += $1;
|
||||
}
|
||||
if(/^nonvoluntary_ctxt_switches:\s+(\d+)$/) {
|
||||
$v_ics += $1;
|
||||
}
|
||||
}
|
||||
close(IN);
|
||||
}
|
||||
}
|
||||
$str = $e . "_vcs" . $n;
|
||||
$vcs = $v_vcs - ($config->{process_hist}->{$str} || 0);
|
||||
$vcs = 0 unless $v_vcs != $vcs;
|
||||
$vcs /= $delta_t;
|
||||
$config->{process_hist}->{$str} = $v_vcs;
|
||||
$str = $e . "_ics" . $n;
|
||||
$ics = $v_ics - ($config->{process_hist}->{$str} || 0);
|
||||
$ics = 0 unless $v_ics != $ics;
|
||||
$ics /= $delta_t;
|
||||
$config->{process_hist}->{$str} = $v_ics;
|
||||
|
||||
$rrdata .= ":$cpu:$mem:$dsk:$net:$nof:$pro:$nth:$vcs:$ics:$upt:0";
|
||||
}
|
||||
$e++;
|
||||
}
|
||||
|
||||
return $rrdata;
|
||||
}
|
||||
|
||||
sub process_init {
|
||||
my $myself = (caller(0))[3];
|
||||
my ($package, $config, $debug) = @_;
|
||||
|
|
@ -145,6 +324,7 @@ sub process_init {
|
|||
|
||||
$config->{process_hist} = ();
|
||||
push(@{$config->{func_update}}, $package);
|
||||
measure($myself, $config, $process); # Call to measuring routine to initialize the last values for calculating the differences. This way, the first update call will actually measure correct values.
|
||||
logger("$myself: Ok") if $debug;
|
||||
}
|
||||
|
||||
|
|
@ -154,173 +334,7 @@ sub process_update {
|
|||
my $rrd = $config->{base_lib} . $package . ".rrd";
|
||||
my $process = $config->{process};
|
||||
|
||||
my $n;
|
||||
my $rrdata = "N";
|
||||
my $ticks = `getconf CLK_TCK`;
|
||||
my ($sysuptime) = split(' ', `cat /proc/uptime`);
|
||||
|
||||
my $e = 0;
|
||||
foreach my $pg (sort keys %{$process->{list}}) {
|
||||
my @lp = split(',', $process->{list}->{$pg});
|
||||
for($n = 0; $n < 10; $n++) {
|
||||
my $cpu = 0;
|
||||
my $mem = 0;
|
||||
my $dsk = 0;
|
||||
my $net = 0;
|
||||
my $nof = 0;
|
||||
my $pro = 0;
|
||||
my $nth = 0;
|
||||
my $vcs = 0;
|
||||
my $ics = 0;
|
||||
my $upt = 0;
|
||||
|
||||
my $str;
|
||||
my @pids;
|
||||
my $p = trim($lp[$n] || "");
|
||||
my $val;
|
||||
my $s_usage = 0;
|
||||
|
||||
# check if that process is running
|
||||
if(open(IN, "ps -eo pid,comm,command |")) {
|
||||
my $pidwidth = length(`cat /proc/sys/kernel/pid_max`);
|
||||
|
||||
while(<IN>) {
|
||||
if(m/^\s*(\d+)\s+(\S+)\s+(.*?)$/) {
|
||||
if($p eq trim($2)) {
|
||||
push(@pids, $1);
|
||||
$pro++;
|
||||
next;
|
||||
}
|
||||
if($p eq trim($3)) {
|
||||
push(@pids, $1);
|
||||
$pro++;
|
||||
next;
|
||||
}
|
||||
if(index($3, $p) != -1) {
|
||||
push(@pids, $1);
|
||||
$pro++;
|
||||
next;
|
||||
}
|
||||
}
|
||||
if(substr($p, 0, 15) eq substr($_, $pidwidth, 15)) {
|
||||
push(@pids, $1);
|
||||
$pro++;
|
||||
next;
|
||||
}
|
||||
}
|
||||
close(IN);
|
||||
}
|
||||
|
||||
if(open(IN, "/proc/stat")) {
|
||||
while(<IN>) {
|
||||
if(/^cpu /) {
|
||||
my (undef, $user, $nice, $sys, $idle, $iow, $irq, $sirq, $steal, $guest) = split(' ', $_);
|
||||
$s_usage = $user + $nice + $sys + $idle + $iow + $irq + $sirq + $steal + ($guest || 0);
|
||||
last;
|
||||
}
|
||||
}
|
||||
close(IN);
|
||||
}
|
||||
|
||||
my $p_usage = 0;
|
||||
foreach my $pid (@pids) {
|
||||
if(open(IN, "/proc/$pid/stat")) {
|
||||
my $utime = 0;
|
||||
my $stime = 0;
|
||||
my $v_nth = 0;
|
||||
my $starttime = 0;
|
||||
my $v_mem = 0;
|
||||
my $rest;
|
||||
|
||||
# since a process name can include spaces an 'split(' ', <IN>)' wouldn't work here,
|
||||
# therefore we discard the first part of the process information (pid, comm and state).
|
||||
(undef, $rest) = <IN> =~ m/^(\d+\s\(.*?\)\s\S\s)(.*?)$/;
|
||||
close(IN);
|
||||
if($rest) {
|
||||
(undef, undef, undef, undef, undef, undef, undef, undef, undef, undef, $utime, $stime, undef, undef, undef, undef, $v_nth, undef, $starttime, undef, $v_mem) = split(' ', $rest);
|
||||
$mem += ($v_mem *= 4096);
|
||||
$nth += ($v_nth - 1);
|
||||
$p_usage += $utime + $stime;
|
||||
$starttime /= $ticks;
|
||||
my $diff = $sysuptime - $starttime;
|
||||
$upt = $diff unless $diff < $upt;
|
||||
} else {
|
||||
logger("$myself: WARNING: PID $pid ('$p') has vanished while accounting!");
|
||||
}
|
||||
}
|
||||
}
|
||||
$str = $e . "_cpu" . $n;
|
||||
$cpu += 100 * ($p_usage - ($config->{process_hist}->{$str}->{pusage} || 0)) / ($s_usage - ($config->{process_hist}->{$str}->{susage} || 0));
|
||||
$config->{process_hist}->{$str}->{pusage} = $p_usage;
|
||||
$config->{process_hist}->{$str}->{susage} = $s_usage;
|
||||
|
||||
my $v_dsk = 0;
|
||||
my $v_net = 0;
|
||||
foreach my $pid (@pids) {
|
||||
if(open(IN, "/proc/$pid/io")) {
|
||||
my $rchar = 0;
|
||||
my $wchar = 0;
|
||||
my $readb = 0;
|
||||
my $writb = 0;
|
||||
while(<IN>) {
|
||||
$rchar = $1 if /^rchar:\s+(\d+)$/;
|
||||
$wchar = $1 if /^wchar:\s+(\d+)$/;
|
||||
$readb = $1 if /^read_bytes:\s+(\d+)$/;
|
||||
$writb = $1 if /^write_bytes:\s+(\d+)$/;
|
||||
}
|
||||
close(IN);
|
||||
$v_dsk += $readb + $writb;
|
||||
$v_net += ($rchar + $wchar) - ($readb + $writb);
|
||||
}
|
||||
}
|
||||
$str = $e . "_dsk" . $n;
|
||||
$dsk = $v_dsk - ($config->{process_hist}->{$str} || 0);
|
||||
$dsk = 0 unless $v_dsk != $dsk;
|
||||
$dsk /= 60;
|
||||
$config->{process_hist}->{$str} = $v_dsk;
|
||||
$str = $e . "_net" . $n;
|
||||
$net = $v_net - ($config->{process_hist}->{$str} || 0);
|
||||
$net = 0 unless $v_net != $net;
|
||||
$net /= 60;
|
||||
$config->{process_hist}->{$str} = $v_net;
|
||||
$net = 0 if $net < 0;
|
||||
|
||||
my $v_vcs = 0;
|
||||
my $v_ics = 0;
|
||||
foreach my $pid (@pids) {
|
||||
if(opendir(DIR, "/proc/$pid/fdinfo")) {
|
||||
my @files = grep { !/^[.]/ } readdir(DIR);
|
||||
$nof += scalar(@files);
|
||||
closedir(DIR);
|
||||
}
|
||||
|
||||
if(open(IN, "/proc/$pid/status")) {
|
||||
while(<IN>) {
|
||||
if(/^voluntary_ctxt_switches:\s+(\d+)$/) {
|
||||
$v_vcs += $1;
|
||||
}
|
||||
if(/^nonvoluntary_ctxt_switches:\s+(\d+)$/) {
|
||||
$v_ics += $1;
|
||||
}
|
||||
}
|
||||
close(IN);
|
||||
}
|
||||
}
|
||||
$str = $e . "_vcs" . $n;
|
||||
$vcs = $v_vcs - ($config->{process_hist}->{$str} || 0);
|
||||
$vcs = 0 unless $v_vcs != $vcs;
|
||||
$vcs /= 60;
|
||||
$config->{process_hist}->{$str} = $v_vcs;
|
||||
$str = $e . "_ics" . $n;
|
||||
$ics = $v_ics - ($config->{process_hist}->{$str} || 0);
|
||||
$ics = 0 unless $v_ics != $ics;
|
||||
$ics /= 60;
|
||||
$config->{process_hist}->{$str} = $v_ics;
|
||||
|
||||
$rrdata .= ":$cpu:$mem:$dsk:$net:$nof:$pro:$nth:$vcs:$ics:$upt:0";
|
||||
}
|
||||
$e++;
|
||||
}
|
||||
my $rrdata = measure($myself, $config, $process);
|
||||
|
||||
RRDs::update($rrd, $rrdata);
|
||||
logger("$myself: $rrdata") if $debug;
|
||||
|
|
|
|||
Loading…
Reference in New Issue