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 List::Util qw(sum);
   9 use PVE::Tools;
  10 use Cwd qw();
  11
  12 use Socket qw(PF_INET PF_INET6 SOCK_DGRAM IPPROTO_IP);
  13
  14 use constant IFF_UP => 1;
  15 use constant IFNAMSIZ => 16;
  16 use constant SIOCGIFFLAGS => 0x8913;
  17
  18 my $clock_ticks = POSIX::sysconf(&POSIX::_SC_CLK_TCK);
  19
  20 my $cpuinfo;
  21
  22 sub read_cpuinfo {
  23     my $fn = '/proc/cpuinfo';
  24
  25     return $cpuinfo if $cpuinfo;
  26
  27     my $res = {
  28         user_hz => $clock_ticks,
  29         model => 'unknown',
  30         mhz => 0,
  31         cpus => 1,
  32         sockets => 1,
  33         flags => '',
  34     };
  35
  36     my $fh = IO::File->new ($fn, "r");
  37     return $res if !$fh;
  38
  39     my $cpuid = 0;
  40     my $idhash = {};
  41     my $count = 0;
  42     while (defined(my $line = <$fh>)) {
  43         if ($line =~ m/^processor\s*:\s*\d+\s*$/i) {
  44             $count++;
  45         } elsif ($line =~ m/^model\s+name\s*:\s*(.*)\s*$/i) {
  46             $res->{model} = $1 if $res->{model} eq 'unknown';
  47         } elsif ($line =~ m/^cpu\s+MHz\s*:\s*(\d+\.\d+)\s*$/i) {
  48             $res->{mhz} = $1 if !$res->{mhz};
  49         } elsif ($line =~ m/^flags\s*:\s*(.*)$/) {
  50             $res->{flags} = $1 if !length $res->{flags};
  51         } elsif ($line =~ m/^physical id\s*:\s*(\d+)\s*$/i) {
  52             $cpuid = $1;
  53             $idhash->{$1} = 1 if not defined($idhash->{$1});
  54         } elsif ($line =~ m/^cpu cores\s*:\s*(\d+)\s*$/i) {
  55             $idhash->{$cpuid} = $1 if defined($idhash->{$cpuid});
  56         }
  57     }
  58
  59     # Hardware Virtual Machine (Intel VT / AMD-V)
  60     $res->{hvm} = $res->{flags} =~ m/\s(vmx|svm)\s/;
  61
  62     $res->{sockets} = scalar(keys %$idhash) || 1;
  63
  64     $res->{cores} = sum(values %$idhash) || 1;
  65
  66     $res->{cpus} = $count;
  67
  68     $fh->close;
  69
  70     $cpuinfo = $res;
  71
  72     return $res;
  73 }
  74
  75 sub read_proc_uptime {
  76     my $ticks = shift;
  77
  78     my $line = PVE::Tools::file_read_firstline("/proc/uptime");
  79     if ($line && $line =~ m|^(\d+\.\d+)\s+(\d+\.\d+)\s*$|) {
  80         if ($ticks) {
  81             return (int($1*$clock_ticks), int($2*$clock_ticks));
  82         } else {
  83             return (int($1), int($2));
  84         }
  85     }
  86
  87     return (0, 0);
  88 }
  89
  90 sub kernel_version {
  91     my $line = PVE::Tools::file_read_firstline("/proc/version");
  92
  93     if ($line && $line =~ m|^Linux\sversion\s((\d+(?:\.\d+)+)-?(\S+)?)|) {
  94         my ($fullversion, $version_numbers, $extra) = ($1, $2, $3);
  95
  96         # variable names are the one from the Linux kernel Makefile
  97         my ($version, $patchlevel, $sublevel) = split(/\./, $version_numbers);
  98
  99         return wantarray
 100             ? (int($version), int($patchlevel), int($sublevel), $extra, $fullversion)
 101             : $fullversion;
 102     }
 103
 104     return (0, 0, 0, '', '');
 105 }
 106
 107 # Check if the kernel is at least $major.$minor. Return either just a boolean,
 108 # or a boolean and the kernel version's major.minor string from /proc/version
 109 sub check_kernel_release {
 110     my ($major, $minor) = @_;
 111
 112     my ($k_major, $k_minor) = kernel_version();
 113
 114     my $ok;
 115     if (defined($minor)) {
 116         $ok = $k_major > $major || ($k_major == $major && $k_minor >= $minor);
 117     } else {
 118         $ok = $k_major >= $major;
 119     }
 120
 121     return wantarray ? ($ok, "$k_major.$k_minor") : $ok;
 122 }
 123
 124 sub read_loadavg {
 125
 126     my $line = PVE::Tools::file_read_firstline('/proc/loadavg');
 127
 128     if ($line =~ m|^(\d+\.\d+)\s+(\d+\.\d+)\s+(\d+\.\d+)\s+\d+/\d+\s+\d+\s*$|) {
 129         return wantarray ? ($1, $2, $3) : $1;
 130     }
 131
 132     return wantarray ? (0, 0, 0) : 0;
 133 }
 134
 135 sub parse_pressure {
 136     my ($path) = @_;
 137
 138     my $res = {};
 139     my $v = qr/\d+\.\d+/;
 140     my $fh = IO::File->new($path, "r") or return undef;
 141     while (defined (my $line = <$fh>)) {
 142         if ($line =~ /^(some|full)\s+avg10\=($v)\s+avg60\=($v)\s+avg300\=($v)\s+total\=(\d+)/) {
 143             $res->{$1}->{avg10} = $2;
 144             $res->{$1}->{avg60} = $3;
 145             $res->{$1}->{avg300} = $4;
 146             $res->{$1}->{total} = $4;
 147         }
 148     }
 149     $fh->close;
 150     return $res;
 151 }
 152
 153 sub read_pressure {
 154     my $res = {};
 155     foreach my $type (qw(cpu memory io)) {
 156         my $stats = parse_pressure("/proc/pressure/$type");
 157         $res->{$type} = $stats if $stats;
 158     }
 159     return $res;
 160 }
 161
 162 my $last_proc_stat;
 163
 164 sub read_proc_stat {
 165     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};
 166
 167     my $cpucount = 0;
 168
 169     if (my $fh = IO::File->new ("/proc/stat", "r")) {
 170         while (defined (my $line = <$fh>)) {
 171             if ($line =~ m|^cpu\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)|) {
 172                 $res->{user} = $1 - $9;
 173                 $res->{nice} = $2 - $10;
 174                 $res->{system} = $3;
 175                 $res->{idle} = $4;
 176                 $res->{used} = $1+$2+$3+$6+$7+$8;
 177                 $res->{iowait} = $5;
 178                 $res->{irq} = $6;
 179                 $res->{softirq} = $7;
 180                 $res->{steal} = $8;
 181                 $res->{guest} = $9;
 182                 $res->{guest_nice} = $10;
 183             } elsif ($line =~ m|^cpu\d+\s|) {
 184                 $cpucount++;
 185             }
 186         }
 187         $fh->close;
 188     }
 189
 190     $cpucount = 1 if !$cpucount;
 191
 192     my $ctime = gettimeofday; # floating point time in seconds
 193
 194     # the sum of all fields
 195     $res->{total} = $res->{user}
 196         + $res->{nice}
 197         + $res->{system}
 198         + $res->{iowait}
 199         + $res->{irq}
 200         + $res->{softirq}
 201         + $res->{steal}
 202         + $res->{idle}
 203         + $res->{guest}
 204         + $res->{guest_nice};
 205
 206     $res->{ctime} = $ctime;
 207     $res->{cpu} = 0;
 208     $res->{wait} = 0;
 209
 210     $last_proc_stat = $res if !$last_proc_stat;
 211
 212     my $diff = ($ctime - $last_proc_stat->{ctime}) * $clock_ticks * $cpucount;
 213
 214     if ($diff > 1000) { # don't update too often
 215         my $useddiff =  $res->{used} - $last_proc_stat->{used};
 216         $useddiff = $diff if $useddiff > $diff;
 217
 218         my $totaldiff = $res->{total} - $last_proc_stat->{total};
 219         $totaldiff = $diff if $totaldiff > $diff;
 220
 221         $res->{cpu} = $useddiff/$totaldiff;
 222
 223         my $waitdiff =  $res->{iowait} - $last_proc_stat->{iowait};
 224         $waitdiff = $diff if $waitdiff > $diff;
 225         $res->{wait} = $waitdiff/$totaldiff;
 226
 227         $last_proc_stat = $res;
 228     } else {
 229         $res->{cpu} = $last_proc_stat->{cpu};
 230         $res->{wait} = $last_proc_stat->{wait};
 231     }
 232
 233     return $res;
 234 }
 235
 236 sub read_proc_pid_stat {
 237     my $pid = shift;
 238
 239     my $statstr = PVE::Tools::file_read_firstline("/proc/$pid/stat");
 240
 241     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+/) {
 242         return {
 243             status => $1,
 244             ppid => $2,
 245             utime => $3,
 246             stime => $4,
 247             starttime => $7,
 248             vsize => $8,
 249             rss => $9 * 4096,
 250         };
 251     }
 252
 253     return undef;
 254 }
 255
 256 sub check_process_running {
 257     my ($pid, $pstart) = @_;
 258
 259     # note: waitpid only work for child processes, but not
 260     # for processes spanned by other processes.
 261     # kill(0, pid) return succes for zombies.
 262     # So we read the status form /proc/$pid/stat instead
 263
 264     my $info = read_proc_pid_stat($pid);
 265
 266     return $info && (!$pstart || ($info->{starttime} eq $pstart)) && ($info->{status} ne 'Z') ? $info : undef;
 267 }
 268
 269 sub read_proc_starttime {
 270     my $pid = shift;
 271
 272     my $info = read_proc_pid_stat($pid);
 273     return $info ? $info->{starttime} : 0;
 274 }
 275
 276 sub read_meminfo {
 277
 278     my $res = {
 279         memtotal => 0,
 280         memfree => 0,
 281         memused => 0,
 282         memshared => 0,
 283         swaptotal => 0,
 284         swapfree => 0,
 285         swapused => 0,
 286     };
 287
 288     my $fh = IO::File->new ("/proc/meminfo", "r");
 289     return $res if !$fh;
 290
 291     my $d = {};
 292     while (my $line = <$fh>) {
 293         if ($line =~ m/^(\S+):\s+(\d+)\s*kB/i) {
 294             $d->{lc ($1)} = $2 * 1024;
 295         }
 296     }
 297     close($fh);
 298
 299     $res->{memtotal} = $d->{memtotal};
 300     $res->{memfree} =  $d->{memfree} + $d->{buffers} + $d->{cached};
 301     $res->{memused} = $res->{memtotal} - $res->{memfree};
 302
 303     $res->{swaptotal} = $d->{swaptotal};
 304     $res->{swapfree} = $d->{swapfree};
 305     $res->{swapused} = $res->{swaptotal} - $res->{swapfree};
 306
 307     my $spages = PVE::Tools::file_read_firstline("/sys/kernel/mm/ksm/pages_sharing") // 0 ;
 308     $res->{memshared} = int($spages) * 4096;
 309
 310     return $res;
 311 }
 312
 313 # memory usage of current process
 314 sub read_memory_usage {
 315
 316     my $res = { size => 0, resident => 0, shared => 0 };
 317
 318     my $ps = 4096;
 319
 320     my $line = PVE::Tools::file_read_firstline("/proc/$$/statm");
 321
 322     if ($line =~ m/^(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s*/) {
 323         $res->{size} = $1*$ps;
 324         $res->{resident} = $2*$ps;
 325         $res->{shared} = $3*$ps;
 326     }
 327
 328     return $res;
 329 }
 330
 331 sub read_proc_net_dev {
 332
 333     my $res = {};
 334
 335     my $fh = IO::File->new ("/proc/net/dev", "r");
 336     return $res if !$fh;
 337
 338     while (defined (my $line = <$fh>)) {
 339         if ($line =~ m/^\s*(.*):\s*(\d+)\s+\d+\s+\d+\s+\d+\s+\d+\s+\d+\s+\d+\s+\d+\s+(\d+)\s+/) {
 340             $res->{$1} = {
 341                 receive => $2,
 342                 transmit => $3,
 343             };
 344         }
 345     }
 346
 347     close($fh);
 348
 349     return $res;
 350 }
 351
 352 sub write_proc_entry {
 353     my ($filename, $data) = @_;#
 354
 355     my $fh = IO::File->new($filename,  O_WRONLY);
 356     die "unable to open file '$filename' - $!\n" if !$fh;
 357     die "unable to write '$filename' - $!\n" unless print $fh $data;
 358     die "closing file '$filename' failed - $!\n" unless close $fh;
 359     $fh->close();
 360 }
 361
 362 sub read_proc_net_route {
 363     my $filename = "/proc/net/route";
 364
 365     my $res = [];
 366
 367     my $fh = IO::File->new ($filename, "r");
 368     return $res if !$fh;
 369
 370     my $int_to_quad = sub {
 371        return join '.' => map { ($_[0] >> 8*(3-$_)) % 256 } (3, 2, 1, 0);
 372     };
 373
 374     while (defined(my $line = <$fh>)) {
 375        next if $line =~/^Iface\s+Destination/; # skip head
 376        my ($iface, $dest, $gateway, $metric, $mask, $mtu) = (split(/\s+/, $line))[0,1,2,6,7,8];
 377        push @$res, {
 378            dest => &$int_to_quad(hex($dest)),
 379            gateway => &$int_to_quad(hex($gateway)),
 380            mask => &$int_to_quad(hex($mask)),
 381            metric => $metric,
 382            mtu => $mtu,
 383            iface => $iface,
 384        };
 385     }
 386
 387     return $res;
 388 }
 389
 390 sub read_proc_mounts {
 391     return PVE::Tools::file_get_contents("/proc/mounts", 512*1024);
 392 }
 393
 394 # mounts encode spaces (\040), tabs (\011), newlines (\012), backslashes (\\ or \134)
 395 sub decode_mount {
 396     my ($str) = @_;
 397     return $str =~ s/\\(?:040|01[12]|134|\\)/"\"$&\""/geer;
 398 }
 399
 400 sub parse_mounts {
 401     my ($mounts) = @_;
 402
 403     my $mntent = [];
 404     while ($mounts =~ /^\s*([^#].*)$/gm) {
 405         # lines from the file are encoded so we can just split at spaces
 406         my ($what, $dir, $fstype, $opts) = split(/[ \t]/, $1, 4);
 407         my ($freq, $passno) = (0, 0);
 408         # in glibc's parser frequency and pass seem to be optional
 409         $freq = $1 if $opts =~ s/\s+(\d+)$//;
 410         $passno = $1 if $opts =~ s/\s+(\d+)$//;
 411         push @$mntent, [
 412             decode_mount($what),
 413             decode_mount($dir),
 414             decode_mount($fstype),
 415             decode_mount($opts),
 416             $freq,
 417             $passno,
 418         ];
 419     }
 420     return $mntent;
 421 }
 422
 423 sub parse_proc_mounts {
 424     return parse_mounts(read_proc_mounts());
 425 }
 426
 427 sub is_mounted {
 428     my ($mountpoint) = @_;
 429
 430     $mountpoint = Cwd::realpath($mountpoint);
 431
 432     return 0 if !defined($mountpoint); # path does not exist
 433
 434     my $mounts = parse_proc_mounts();
 435     return (grep { $_->[1] eq $mountpoint } @$mounts) ? 1 : 0;
 436 }
 437
 438 sub read_proc_net_ipv6_route {
 439     my $filename = "/proc/net/ipv6_route";
 440
 441     my $res = [];
 442
 443     my $fh = IO::File->new ($filename, "r");
 444     return $res if !$fh;
 445
 446     my $read_v6addr = sub { $_[0] =~ s/....(?!$)/$&:/gr };
 447
 448     # ipv6_route has no header
 449     while (defined(my $line = <$fh>)) {
 450         my ($dest, $prefix, $nexthop, $metric, $iface) = (split(/\s+/, $line))[0,1,4,5,9];
 451         push @$res, {
 452             dest => &$read_v6addr($dest),
 453             prefix => hex("$prefix"),
 454             gateway => &$read_v6addr($nexthop),
 455             metric => hex("$metric"),
 456             iface => $iface
 457         };
 458     }
 459
 460     return $res;
 461 }
 462
 463 sub upid_wait {
 464     my ($upid, $waitfunc, $sleep_intervall) = @_;
 465
 466     my $task = PVE::Tools::upid_decode($upid);
 467
 468     $sleep_intervall = $sleep_intervall ? $sleep_intervall : 1;
 469
 470     my $next_time = time + $sleep_intervall;
 471
 472     while (check_process_running($task->{pid}, $task->{pstart})) {
 473
 474         if (time >= $next_time && $waitfunc && ref($waitfunc) eq 'CODE'){
 475             &$waitfunc($task);
 476             $next_time = time + $sleep_intervall;
 477         }
 478
 479         CORE::sleep(1);
 480     }
 481 }
 482
 483 # struct ifreq { // FOR SIOCGIFFLAGS:
 484 #   char ifrn_name[IFNAMSIZ]
 485 #   short ifru_flags
 486 # };
 487 my $STRUCT_IFREQ_SIOCGIFFLAGS = 'Z' . IFNAMSIZ . 's1';
 488 sub get_active_network_interfaces {
 489     # Use the interface name list from /proc/net/dev
 490     open my $fh, '<', '/proc/net/dev'
 491         or die "failed to open /proc/net/dev: $!\n";
 492     # And filter by IFF_UP flag fetched via a PF_INET6 socket ioctl:
 493     my $sock;
 494     socket($sock, PF_INET6, SOCK_DGRAM, &IPPROTO_IP)
 495     or socket($sock, PF_INET, SOCK_DGRAM, &IPPROTO_IP)
 496     or return [];
 497
 498     my $ifaces = [];
 499     while(defined(my $line = <$fh>)) {
 500         next if $line !~ /^\s*([^:\s]+):/;
 501         my $ifname = $1;
 502         my $ifreq = pack($STRUCT_IFREQ_SIOCGIFFLAGS, $ifname, 0);
 503         if (!defined(ioctl($sock, SIOCGIFFLAGS, $ifreq))) {
 504             warn "failed to get interface flags for: $ifname\n";
 505             next;
 506         }
 507         my ($name, $flags) = unpack($STRUCT_IFREQ_SIOCGIFFLAGS, $ifreq);
 508         push @$ifaces, $ifname if ($flags & IFF_UP);
 509     }
 510     close $fh;
 511     close $sock;
 512     return $ifaces;
 513 }
 514
 515 1;