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