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