X-Git-Url: https://git.proxmox.com/?p=pve-common.git;a=blobdiff_plain;f=data%2FPVE%2FProcFSTools.pm;fp=data%2FPVE%2FProcFSTools.pm;h=0000000000000000000000000000000000000000;hp=8bb0d729b50b8ab974cdbc5d3b2ac57d5fe24e70;hb=b51b16e6f58de4cb385bd461d97866b3d94c93ec;hpb=47e4eb112911b530d0646c1808fd06cbeb921572 diff --git a/data/PVE/ProcFSTools.pm b/data/PVE/ProcFSTools.pm deleted file mode 100644 index 8bb0d72..0000000 --- a/data/PVE/ProcFSTools.pm +++ /dev/null @@ -1,287 +0,0 @@ -package PVE::ProcFSTools; - -use strict; -use warnings; -use POSIX; -use Time::HiRes qw (gettimeofday); -use IO::File; -use PVE::Tools; - -my $clock_ticks = POSIX::sysconf(&POSIX::_SC_CLK_TCK); - -my $cpuinfo; - -sub read_cpuinfo { - my $fn = '/proc/cpuinfo'; - - return $cpuinfo if $cpuinfo; - - my $res = { - user_hz => $clock_ticks, - model => 'unknown', - mhz => 0, - cpus => 1, - sockets => 1, - }; - - my $fh = IO::File->new ($fn, "r"); - return $res if !$fh; - - my $idhash = {}; - my $count = 0; - while (defined(my $line = <$fh>)) { - if ($line =~ m/^processor\s*:\s*\d+\s*$/i) { - $count++; - } elsif ($line =~ m/^model\s+name\s*:\s*(.*)\s*$/i) { - $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/^physical id\s*:\s*(\d+)\s*$/i) { - $idhash->{$1} = 1; - } - } - - $res->{sockets} = scalar(keys %$idhash) || 1; - - $res->{cpus} = $count; - - $fh->close; - - $cpuinfo = $res; - - return $res; -} - -sub read_proc_uptime { - my $ticks = shift; - - my $line = PVE::Tools::file_read_firstline("/proc/uptime"); - if ($line && $line =~ m|^(\d+\.\d+)\s+(\d+\.\d+)\s*$|) { - if ($ticks) { - return (int($1*$clock_ticks), int($2*$clock_ticks)); - } else { - return (int($1), int($2)); - } - } - - return (0, 0); -} - -sub read_loadavg { - - my $line = PVE::Tools::file_read_firstline('/proc/loadavg'); - - if ($line =~ m|^(\d+\.\d+)\s+(\d+\.\d+)\s+(\d+\.\d+)\s+\d+/\d+\s+\d+\s*$|) { - return wantarray ? ($1, $2, $3) : $1; - } - - return wantarray ? (0, 0, 0) : 0; -} - -my $last_proc_stat; - -sub read_proc_stat { - my $res = { user => 0, nice => 0, system => 0, idle => 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; - $res->{system} = $3; - $res->{idle} = $4; - $res->{used} = $1+$2+$3; - $res->{iowait} = $5; - } elsif ($line =~ m|^cpu\d+\s|) { - $cpucount++; - } - } - $fh->close; - } - - $cpucount = 1 if !$cpucount; - - my $ctime = gettimeofday; # floating point time in seconds - - $res->{ctime} = $ctime; - $res->{cpu} = 0; - $res->{wait} = 0; - - $last_proc_stat = $res if !$last_proc_stat; - - my $diff = ($ctime - $last_proc_stat->{ctime}) * $clock_ticks * $cpucount; - - 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 $waitdiff = $res->{iowait} - $last_proc_stat->{iowait}; - $waitdiff = $diff if $waitdiff > $diff; - $res->{wait} = $waitdiff/$diff; - $last_proc_stat = $res; - } else { - $res->{cpu} = $last_proc_stat->{cpu}; - $res->{wait} = $last_proc_stat->{wait}; - } - - return $res; -} - -sub read_proc_pid_stat { - my $pid = shift; - - my $statstr = PVE::Tools::file_read_firstline("/proc/$pid/stat"); - - 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, - utime => $3, - stime => $4, - starttime => $7, - vsize => $8, - rss => $9 * 4096, - }; - } - - return undef; -} - -sub check_process_running { - my ($pid, $pstart) = @_; - - # note: waitpid only work for child processes, but not - # 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; -} - -sub read_proc_starttime { - my $pid = shift; - - my $info = read_proc_pid_stat($pid); - return $info ? $info->{starttime} : 0; -} - -sub read_meminfo { - - my $res = { - memtotal => 0, - memfree => 0, - memused => 0, - memshared => 0, - swaptotal => 0, - swapfree => 0, - swapused => 0, - }; - - my $fh = IO::File->new ("/proc/meminfo", "r"); - return $res if !$fh; - - my $d = {}; - while (my $line = <$fh>) { - if ($line =~ m/^(\S+):\s+(\d+)\s*kB/i) { - $d->{lc ($1)} = $2 * 1024; - } - } - close($fh); - - $res->{memtotal} = $d->{memtotal}; - $res->{memfree} = $d->{memfree} + $d->{buffers} + $d->{cached}; - $res->{memused} = $res->{memtotal} - $res->{memfree}; - - $res->{swaptotal} = $d->{swaptotal}; - $res->{swapfree} = $d->{swapfree}; - $res->{swapused} = $res->{swaptotal} - $res->{swapfree}; - - my $spages = PVE::Tools::file_read_firstline("/sys/kernel/mm/ksm/pages_sharing"); - $res->{memshared} = int($spages) * 4096; - - return $res; -} - -# memory usage of current process -sub read_memory_usage { - - my $res = { size => 0, resident => 0, shared => 0 }; - - my $ps = 4096; - - my $line = PVE::Tools::file_read_firstline("/proc/$$/statm"); - - if ($line =~ m/^(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s*/) { - $res->{size} = $1*$ps; - $res->{resident} = $2*$ps; - $res->{shared} = $3*$ps; - } - - return $res; -} - -sub read_proc_net_dev { - - my $res = {}; - - my $fh = IO::File->new ("/proc/net/dev", "r"); - return $res if !$fh; - - while (defined (my $line = <$fh>)) { - if ($line =~ m/^\s*(.*):\s*(\d+)\s+\d+\s+\d+\s+\d+\s+\d+\s+\d+\s+\d+\s+\d+\s+(\d+)\s+/) { - $res->{$1} = { - receive => $2, - transmit => $3, - }; - } - } - - close($fh); - - return $res; -} - -sub write_proc_entry { - my ($filename, $data) = @_;# - - 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; - $fh->close(); -} - -sub read_proc_net_route { - my $filename = "/proc/net/route"; - - my $res = []; - - my $fh = IO::File->new ($filename, "r"); - return $res if !$fh; - - my $int_to_quad = sub { - return join '.' => map { ($_[0] >> 8*(3-$_)) % 256 } (3, 2, 1, 0); - }; - - while (defined(my $line = <$fh>)) { - next if $line =~/^Iface\s+Destination/; # skip head - my ($iface, $dest, $gateway, $metric, $mask, $mtu) = (split(/\s+/, $line))[0,1,2,6,7,8]; - push @$res, { - dest => &$int_to_quad(hex($dest)), - gateway => &$int_to_quad(hex($gateway)), - mask => &$int_to_quad(hex($mask)), - metric => $metric, - mtu => $mtu, - iface => $iface, - }; - } - - return $res; -} - -1;