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