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
  10 my $clock_ticks = POSIX::sysconf(&POSIX::_SC_CLK_TCK);
  11
  12 my $cpuinfo;
  13
  14 sub read_cpuinfo {
  15     my $fn = '/proc/cpuinfo';
  16
  17     return $cpuinfo if $cpuinfo;
  18
  19     my $res = {
  20         user_hz => $clock_ticks,
  21         model => 'unknown',
  22         mhz => 0,
  23         cpus => 1,
  24         sockets => 1,
  25     };
  26
  27     my $fh = IO::File->new ($fn, "r");
  28     return $res if !$fh;
  29
  30     my $idhash = {};
  31     my $count = 0;
  32     while (defined(my $line = <$fh>)) {
  33         if ($line =~ m/^processor\s*:\s*\d+\s*$/i) {
  34             $count++;
  35         } elsif ($line =~ m/^model\s+name\s*:\s*(.*)\s*$/i) {
  36             $res->{model} = $1 if $res->{model} eq 'unknown';
  37         } elsif ($line =~ m/^cpu\s+MHz\s*:\s*(\d+\.\d+)\s*$/i) {
  38             $res->{mhz} = $1 if !$res->{mhz};
  39         } elsif ($line =~ m/^flags\s*:.*(vmx|svm)/) {
  40             $res->{hvm} = 1; # Hardware Virtual Machine (Intel VT / AMD-V)
  41         } elsif ($line =~ m/^physical id\s*:\s*(\d+)\s*$/i) {
  42             $idhash->{$1} = 1;
  43         }
  44     }
  45
  46     $res->{sockets} = scalar(keys %$idhash) || 1;
  47
  48     $res->{cpus} = $count;
  49
  50     $fh->close;
  51
  52     $cpuinfo = $res;
  53
  54     return $res;
  55 }
  56
  57 sub read_proc_uptime {
  58     my $ticks = shift;
  59
  60     my $line = PVE::Tools::file_read_firstline("/proc/uptime");
  61     if ($line && $line =~ m|^(\d+\.\d+)\s+(\d+\.\d+)\s*$|) {
  62         if ($ticks) {
  63             return (int($1*$clock_ticks), int($2*$clock_ticks));
  64         } else {
  65             return (int($1), int($2));
  66         }
  67     }
  68
  69     return (0, 0);
  70 }
  71
  72 sub read_loadavg {
  73
  74     my $line = PVE::Tools::file_read_firstline('/proc/loadavg');
  75
  76     if ($line =~ m|^(\d+\.\d+)\s+(\d+\.\d+)\s+(\d+\.\d+)\s+\d+/\d+\s+\d+\s*$|) {
  77         return wantarray ? ($1, $2, $3) : $1;
  78     }
  79
  80     return wantarray ? (0, 0, 0) : 0;
  81 }
  82
  83 my $last_proc_stat;
  84
  85 sub read_proc_stat {
  86     my $res = { user => 0, nice => 0, system => 0, idle => 0 , sum => 0};
  87
  88     my $cpucount = 0;
  89
  90     if (my $fh = IO::File->new ("/proc/stat", "r")) {
  91         while (defined (my $line = <$fh>)) {
  92             if ($line =~ m|^cpu\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s|) {
  93                 $res->{user} = $1;
  94                 $res->{nice} = $2;
  95                 $res->{system} = $3;
  96                 $res->{idle} = $4;
  97                 $res->{used} = $1+$2+$3;
  98                 $res->{iowait} = $5;
  99             } elsif ($line =~ m|^cpu\d+\s|) {
 100                 $cpucount++;
 101             }
 102         }
 103         $fh->close;
 104     }
 105
 106     $cpucount = 1 if !$cpucount;
 107
 108     my $ctime = gettimeofday; # floating point time in seconds
 109
 110     $res->{ctime} = $ctime;
 111     $res->{cpu} = 0;
 112     $res->{wait} = 0;
 113
 114     $last_proc_stat = $res if !$last_proc_stat;
 115
 116     my $diff = ($ctime - $last_proc_stat->{ctime}) * $clock_ticks * $cpucount;
 117
 118     if ($diff > 1000) { # don't update too often
 119         my $useddiff =  $res->{used} - $last_proc_stat->{used};
 120         $useddiff = $diff if $useddiff > $diff;
 121         $res->{cpu} = $useddiff/$diff;
 122         my $waitdiff =  $res->{iowait} - $last_proc_stat->{iowait};
 123         $waitdiff = $diff if $waitdiff > $diff;
 124         $res->{wait} = $waitdiff/$diff;
 125         $last_proc_stat = $res;
 126     } else {
 127         $res->{cpu} = $last_proc_stat->{cpu};
 128         $res->{wait} = $last_proc_stat->{wait};
 129     }
 130
 131     return $res;
 132 }
 133
 134 sub read_proc_pid_stat {
 135     my $pid = shift;
 136
 137     my $statstr = PVE::Tools::file_read_firstline("/proc/$pid/stat");
 138
 139     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+/) {
 140         return {
 141             status => $1,
 142             utime => $3,
 143             stime => $4,
 144             starttime => $7,
 145             vsize => $8,
 146             rss => $9 * 4096,
 147         };
 148     }
 149
 150     return undef;
 151 }
 152
 153 sub check_process_running {
 154     my ($pid, $pstart) = @_;
 155
 156     # note: waitpid only work for child processes, but not
 157     # for processes spanned by other processes.
 158     # kill(0, pid) return succes for zombies.
 159     # So we read the status form /proc/$pid/stat instead
 160
 161     my $info = read_proc_pid_stat($pid);
 162
 163     return $info && (!$pstart || ($info->{starttime} eq $pstart)) && ($info->{status} ne 'Z') ? $info : undef;
 164 }
 165
 166 sub read_proc_starttime {
 167     my $pid = shift;
 168
 169     my $info = read_proc_pid_stat($pid);
 170     return $info ? $info->{starttime} : 0;
 171 }
 172
 173 sub read_meminfo {
 174
 175     my $res = {
 176         memtotal => 0,
 177         memfree => 0,
 178         memused => 0,
 179         memshared => 0,
 180         swaptotal => 0,
 181         swapfree => 0,
 182         swapused => 0,
 183     };
 184
 185     my $fh = IO::File->new ("/proc/meminfo", "r");
 186     return $res if !$fh;
 187
 188     my $d = {};
 189     while (my $line = <$fh>) {
 190         if ($line =~ m/^(\S+):\s+(\d+)\s*kB/i) {
 191             $d->{lc ($1)} = $2 * 1024;
 192         }
 193     }
 194     close($fh);
 195
 196     $res->{memtotal} = $d->{memtotal};
 197     $res->{memfree} =  $d->{memfree} + $d->{buffers} + $d->{cached};
 198     $res->{memused} = $res->{memtotal} - $res->{memfree};
 199
 200     $res->{swaptotal} = $d->{swaptotal};
 201     $res->{swapfree} = $d->{swapfree};
 202     $res->{swapused} = $res->{swaptotal} - $res->{swapfree};
 203
 204     my $spages = PVE::Tools::file_read_firstline("/sys/kernel/mm/ksm/pages_sharing");
 205     $res->{memshared} = int($spages) * 4096;
 206
 207     return $res;
 208 }
 209
 210 # memory usage of current process
 211 sub read_memory_usage {
 212
 213     my $res = { size => 0, resident => 0, shared => 0 };
 214
 215     my $ps = 4096;
 216
 217     my $line = PVE::Tools::file_read_firstline("/proc/$$/statm");
 218
 219     if ($line =~ m/^(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s*/) {
 220         $res->{size} = $1*$ps;
 221         $res->{resident} = $2*$ps;
 222         $res->{shared} = $3*$ps;
 223     }
 224
 225     return $res;
 226 }
 227
 228 sub read_proc_net_dev {
 229
 230     my $res = {};
 231
 232     my $fh = IO::File->new ("/proc/net/dev", "r");
 233     return $res if !$fh;
 234
 235     while (defined (my $line = <$fh>)) {
 236         if ($line =~ m/^\s*(.*):\s*(\d+)\s+\d+\s+\d+\s+\d+\s+\d+\s+\d+\s+\d+\s+\d+\s+(\d+)\s+/) {
 237             $res->{$1} = {
 238                 receive => $2,
 239                 transmit => $3,
 240             };
 241         }
 242     }
 243
 244     close($fh);
 245
 246     return $res;
 247 }
 248
 249 sub write_proc_entry {
 250     my ($filename, $data) = @_;#
 251
 252     my $fh = IO::File->new($filename,  O_WRONLY);
 253     die "unable to open file '$filename' - $!\n" if !$fh;
 254     die "unable to write '$filename' - $!\n" unless print $fh $data;
 255     die "closing file '$filename' failed - $!\n" unless close $fh;
 256     $fh->close();
 257 }
 258
 259 sub read_proc_net_route {
 260     my $filename = "/proc/net/route";
 261
 262     my $res = [];
 263
 264     my $fh = IO::File->new ($filename, "r");
 265     return $res if !$fh;
 266
 267     my $int_to_quad = sub {
 268        return join '.' => map { ($_[0] >> 8*(3-$_)) % 256 } (3, 2, 1, 0);
 269     };
 270
 271     while (defined(my $line = <$fh>)) {
 272        next if $line =~/^Iface\s+Destination/; # skip head
 273        my ($iface, $dest, $gateway, $metric, $mask, $mtu) = (split(/\s+/, $line))[0,1,2,6,7,8];
 274        push @$res, {
 275            dest => &$int_to_quad(hex($dest)),
 276            gateway => &$int_to_quad(hex($gateway)),
 277            mask => &$int_to_quad(hex($mask)),
 278            metric => $metric,
 279            mtu => $mtu,
 280            iface => $iface,
 281        };
 282     }
 283
 284     return $res;
 285 }
 286
 287 sub read_proc_mounts {
 288     return PVE::Tools::file_get_contents("/proc/mounts");
 289 }
 290
 291 sub read_proc_net_ipv6_route {
 292     my $filename = "/proc/net/ipv6_route";
 293
 294     my $res = [];
 295
 296     my $fh = IO::File->new ($filename, "r");
 297     return $res if !$fh;
 298
 299     my $read_v6addr = sub { s/....(?!$)/$&:/g };
 300
 301     # ipv6_route has no header
 302     while (defined(my $line = <$fh>)) {
 303         my ($dest, $prefix, $nexthop, $metric, $iface) = (split(/\s+/, $line))[0,1,4,5,9];
 304         push @$res, {
 305             dest => &$read_v6addr($dest),
 306             prefix => $prefix,
 307             gateway => &$read_v6addr($nexthop),
 308             metric => $metric,
 309             iface => $iface
 310         };
 311     }
 312
 313     return $res;
 314 }
 315
 316 1;