[pve-common.git] / src / PVE / ProcFSTools.pm

package PVE::ProcFSTools;

use strict;
use warnings;

use Cwd qw();
use IO::File;
use List::Util qw(sum);
use POSIX;
use Socket qw(PF_INET PF_INET6 SOCK_DGRAM IPPROTO_IP);
use Time::HiRes qw (gettimeofday);

use PVE::Tools;

use constant IFF_UP => 1;
use constant IFNAMSIZ => 16;
use constant SIOCGIFFLAGS => 0x8913;

my $clock_ticks = POSIX::sysconf(&POSIX::_SC_CLK_TCK);

my $cpuinfo;

sub read_cpuinfo {
    my $fn = '/proc/cpuinfo';

    return $cpuinfo if $cpuinfo;

    my $res = {
	user_hz => $clock_ticks,
	model => 'unknown',
	mhz => 0,
	cpus => 1,
	sockets => 1,
	flags => '',
    };

    my $fh = IO::File->new ($fn, "r");
    return $res if !$fh;

    my $cpuid = 0;
    my $idhash = {};
    my $count = 0;
    while (defined(my $line = <$fh>)) {
	if ($line =~ m/^processor\s*:\s*\d+\s*$/i) {
	    $count++;
	} elsif ($line =~ m/^model\s+name\s*:\s*(.*)\s*$/i) {
	    $res->{model} = $1 if $res->{model} eq 'unknown';
	} elsif ($line =~ m/^cpu\s+MHz\s*:\s*(\d+\.\d+)\s*$/i) {
	    $res->{mhz} = $1 if !$res->{mhz};
	} elsif ($line =~ m/^flags\s*:\s*(.*)$/) {
	    $res->{flags} = $1 if !length $res->{flags};
	} elsif ($line =~ m/^physical id\s*:\s*(\d+)\s*$/i) {
	    $cpuid = $1;
	    $idhash->{$1} = 1 if not defined($idhash->{$1});
	} elsif ($line =~ m/^cpu cores\s*:\s*(\d+)\s*$/i) {
	    $idhash->{$cpuid} = $1 if defined($idhash->{$cpuid});
	}
    }

    # Hardware Virtual Machine (Intel VT / AMD-V)
    $res->{hvm} = $res->{flags} =~ m/\s(vmx|svm)\s/;

    $res->{sockets} = scalar(keys %$idhash) || 1;

    $res->{cores} = sum(values %$idhash) || 1;

    $res->{cpus} = $count;

    $fh->close;

    $cpuinfo = $res;

    return $res;
}

sub read_proc_uptime {
    my $ticks = shift;

    my $line = PVE::Tools::file_read_firstline("/proc/uptime");
    if ($line && $line =~ m|^(\d+\.\d+)\s+(\d+\.\d+)\s*$|) {
	if ($ticks) {
	    return (int($1*$clock_ticks), int($2*$clock_ticks));
	} else {
	    return (int($1), int($2));
	}
    }

    return (0, 0);
}

sub kernel_version {
    my $line = PVE::Tools::file_read_firstline("/proc/version");

    if ($line && $line =~ m|^Linux\sversion\s((\d+(?:\.\d+)+)-?(\S+)?)|) {
        my ($fullversion, $version_numbers, $extra) = ($1, $2, $3);

	# variable names are the one from the Linux kernel Makefile
	my ($version, $patchlevel, $sublevel) = split(/\./, $version_numbers);

	return wantarray
	    ? (int($version), int($patchlevel), int($sublevel), $extra, $fullversion)
	    : $fullversion;
    }

    return (0, 0, 0, '', '');
}

# Check if the kernel is at least $major.$minor. Return either just a boolean,
# or a boolean and the kernel version's major.minor string from /proc/version
sub check_kernel_release {
    my ($major, $minor) = @_;

    my ($k_major, $k_minor) = kernel_version();

    my $ok;
    if (defined($minor)) {
	$ok = $k_major > $major || ($k_major == $major && $k_minor >= $minor);
    } else {
	$ok = $k_major >= $major;
    }

    return wantarray ? ($ok, "$k_major.$k_minor") : $ok;
}

sub read_loadavg {

    my $line = PVE::Tools::file_read_firstline('/proc/loadavg');

    if ($line =~ m|^(\d+\.\d+)\s+(\d+\.\d+)\s+(\d+\.\d+)\s+\d+/\d+\s+\d+\s*$|) {
	return wantarray ? ($1, $2, $3) : $1;
    }

    return wantarray ? (0, 0, 0) : 0;
}

sub parse_pressure {
    my ($path) = @_;

    my $res = {};
    my $v = qr/\d+\.\d+/;
    my $fh = IO::File->new($path, "r") or return undef;
    while (defined (my $line = <$fh>)) {
	if ($line =~ /^(some|full)\s+avg10\=($v)\s+avg60\=($v)\s+avg300\=($v)\s+total\=(\d+)/) {
	    $res->{$1}->{avg10} = $2;
	    $res->{$1}->{avg60} = $3;
	    $res->{$1}->{avg300} = $4;
	    $res->{$1}->{total} = $4;
	}
    }
    $fh->close;
    return $res;
}

sub read_pressure {
    my $res = {};
    foreach my $type (qw(cpu memory io)) {
	my $stats = parse_pressure("/proc/pressure/$type");
	$res->{$type} = $stats if $stats;
    }
    return $res;
}

my $last_proc_stat;

sub read_proc_stat {
    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};

    my $cpucount = 0;

    if (my $fh = IO::File->new ("/proc/stat", "r")) {
	while (defined (my $line = <$fh>)) {
	    if ($line =~ m|^cpu\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)(?:\s+(\d+)\s+(\d+))?|) {
		$res->{user} = $1 - ($9 // 0);
		$res->{nice} = $2 - ($10 // 0);
		$res->{system} = $3;
		$res->{idle} = $4;
		$res->{used} = $1+$2+$3+$6+$7+$8;
		$res->{iowait} = $5;
		$res->{irq} = $6;
		$res->{softirq} = $7;
		$res->{steal} = $8;
		$res->{guest} = $9 // 0;
		$res->{guest_nice} = $10 // 0;
	    } elsif ($line =~ m|^cpu\d+\s|) {
		$cpucount++;
	    }
	}
	$fh->close;
    }

    $cpucount = 1 if !$cpucount;

    my $ctime = gettimeofday; # floating point time in seconds

    # the sum of all fields
    $res->{total} = $res->{user}
	+ $res->{nice}
	+ $res->{system}
	+ $res->{iowait}
	+ $res->{irq}
	+ $res->{softirq}
	+ $res->{steal}
	+ $res->{idle}
	+ $res->{guest}
	+ $res->{guest_nice};

    $res->{ctime} = $ctime;
    $res->{cpu} = 0;
    $res->{wait} = 0;

    $last_proc_stat = $res if !$last_proc_stat;

    my $diff = ($ctime - $last_proc_stat->{ctime}) * $clock_ticks * $cpucount;

    if ($diff > 1000) { # don't update too often
	my $useddiff =  $res->{used} - $last_proc_stat->{used};
	$useddiff = $diff if $useddiff > $diff;

	my $totaldiff = $res->{total} - $last_proc_stat->{total};
	$totaldiff = $diff if $totaldiff > $diff;

	$res->{cpu} = $useddiff/$totaldiff;

	my $waitdiff =  $res->{iowait} - $last_proc_stat->{iowait};
	$waitdiff = $diff if $waitdiff > $diff;
	$res->{wait} = $waitdiff/$totaldiff;

	$last_proc_stat = $res;
    } else {
	$res->{cpu} = $last_proc_stat->{cpu};
	$res->{wait} = $last_proc_stat->{wait};
    }

    return $res;
}

sub read_proc_pid_stat {
    my $pid = shift;

    my $statstr = PVE::Tools::file_read_firstline("/proc/$pid/stat");

    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+/) {
	return {
	    status => $1,
	    ppid => $2,
	    utime => $3,
	    stime => $4,
	    starttime => $7,
	    vsize => $8,
	    rss => $9 * 4096,
	};
    }

    return undef;
}

sub check_process_running {
    my ($pid, $pstart) = @_;

    # note: waitpid only work for child processes, but not
    # for processes spanned by other processes.
    # kill(0, pid) return succes for zombies.
    # So we read the status form /proc/$pid/stat instead

    my $info = read_proc_pid_stat($pid);

    return $info && (!$pstart || ($info->{starttime} eq $pstart)) && ($info->{status} ne 'Z') ? $info : undef;
}

sub read_proc_starttime {
    my $pid = shift;

    my $info = read_proc_pid_stat($pid);
    return $info ? $info->{starttime} : 0;
}

sub read_meminfo {

    my $res = {
	memtotal => 0,
	memfree => 0,
	memused => 0,
	memshared => 0,
	swaptotal => 0,
	swapfree => 0,
	swapused => 0,
	arcsize => 0,
    };

    my $fh = IO::File->new ("/proc/meminfo", "r");
    return $res if !$fh;

    my $d = {};
    while (my $line = <$fh>) {
	if ($line =~ m/^(\S+):\s+(\d+)\s*kB/i) {
	    $d->{lc ($1)} = $2 * 1024;
	}
    }
    close($fh);

    $res->{memtotal} = $d->{memtotal};
    $res->{memfree} =  $d->{memfree} + $d->{buffers} + $d->{cached};
    $res->{memused} = $res->{memtotal} - $res->{memfree};

    $res->{swaptotal} = $d->{swaptotal};
    $res->{swapfree} = $d->{swapfree};
    $res->{swapused} = $res->{swaptotal} - $res->{swapfree};

    my $spages = PVE::Tools::file_read_firstline("/sys/kernel/mm/ksm/pages_sharing") // 0 ;
    $res->{memshared} = int($spages) * 4096;

    my $arc_stats = eval { PVE::Tools::file_get_contents("/proc/spl/kstat/zfs/arcstats") };
    if ($arc_stats && $arc_stats =~ m/^size\s+\d+\s+(\d+)$/m) {
	$res->{arcsize} = int($1);
    }

    return $res;
}

# memory usage of current process
sub read_memory_usage {

    my $res = { size => 0, resident => 0, shared => 0 };

    my $ps = 4096;

    my $line = PVE::Tools::file_read_firstline("/proc/$$/statm");

    if ($line =~ m/^(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s*/) {
	$res->{size} = $1*$ps;
	$res->{resident} = $2*$ps;
	$res->{shared} = $3*$ps;
    }

    return $res;
}

sub read_proc_net_dev {

    my $res = {};

    my $fh = IO::File->new ("/proc/net/dev", "r");
    return $res if !$fh;

    while (defined (my $line = <$fh>)) {
	if ($line =~ m/^\s*(.*):\s*(\d+)\s+\d+\s+\d+\s+\d+\s+\d+\s+\d+\s+\d+\s+\d+\s+(\d+)\s+/) {
	    $res->{$1} = {
		receive => $2,
		transmit => $3,
	    };
	}
    }

    close($fh);

    return $res;
}

sub write_proc_entry {
    my ($filename, $data) = @_;#

    my $fh = IO::File->new($filename, O_WRONLY);
    die "unable to open file '$filename' - $!\n" if !$fh;
    print $fh $data or die "unable to write '$filename' - $!\n";
    close $fh or die "closing file '$filename' failed - $!\n";
    $fh->close();
}

sub read_proc_net_route {
    my $filename = "/proc/net/route";

    my $res = [];

    my $fh = IO::File->new ($filename, "r");
    return $res if !$fh;

    my $int_to_quad = sub {
       return join '.' => map { ($_[0] >> 8*(3-$_)) % 256 } (3, 2, 1, 0);
    };

    while (defined(my $line = <$fh>)) {
       next if $line =~/^Iface\s+Destination/; # skip head
       my ($iface, $dest, $gateway, $metric, $mask, $mtu) = (split(/\s+/, $line))[0,1,2,6,7,8];
       push @$res, {
           dest => &$int_to_quad(hex($dest)),
           gateway => &$int_to_quad(hex($gateway)),
           mask => &$int_to_quad(hex($mask)),
           metric => $metric,
           mtu => $mtu,
	   iface => $iface,
       };
    }

    return $res;
}

sub read_proc_mounts {
    return PVE::Tools::file_get_contents("/proc/mounts", 512*1024);
}

# mounts encode spaces (\040), tabs (\011), newlines (\012), backslashes (\\ or \134)
sub decode_mount {
    my ($str) = @_;
    return $str =~ s/\\(?:040|01[12]|134|\\)/"\"$&\""/geer;
}

sub parse_mounts {
    my ($mounts) = @_;

    my $mntent = [];
    while ($mounts =~ /^\s*([^#].*)$/gm) {
	# lines from the file are encoded so we can just split at spaces
	my ($what, $dir, $fstype, $opts) = split(/[ \t]/, $1, 4);
	my ($freq, $passno) = (0, 0);
	# in glibc's parser frequency and pass seem to be optional
	$freq = $1 if $opts =~ s/\s+(\d+)$//;
	$passno = $1 if $opts =~ s/\s+(\d+)$//;
	push @$mntent, [
	    decode_mount($what),
	    decode_mount($dir),
	    decode_mount($fstype),
	    decode_mount($opts),
	    $freq,
	    $passno,
	];
    }
    return $mntent;
}

sub parse_proc_mounts {
    return parse_mounts(read_proc_mounts());
}

sub is_mounted {
    my ($mountpoint) = @_;

    $mountpoint = Cwd::realpath($mountpoint);

    return 0 if !defined($mountpoint); # path does not exist

    my $mounts = parse_proc_mounts();
    return (grep { $_->[1] eq $mountpoint } @$mounts) ? 1 : 0;
}

sub read_proc_net_ipv6_route {
    my $filename = "/proc/net/ipv6_route";

    my $res = [];

    my $fh = IO::File->new ($filename, "r");
    return $res if !$fh;

    my $read_v6addr = sub { $_[0] =~ s/....(?!$)/$&:/gr };

    # ipv6_route has no header
    while (defined(my $line = <$fh>)) {
	my ($dest, $prefix, $nexthop, $metric, $iface) = (split(/\s+/, $line))[0,1,4,5,9];
	push @$res, {
	    dest => &$read_v6addr($dest),
	    prefix => hex("$prefix"),
	    gateway => &$read_v6addr($nexthop),
	    metric => hex("$metric"),
	    iface => $iface
	};
    }

    return $res;
}

sub upid_wait {
    my ($upid, $waitfunc, $sleep_intervall) = @_;

    my $task = PVE::Tools::upid_decode($upid);

    $sleep_intervall = $sleep_intervall ? $sleep_intervall : 1;

    my $next_time = time + $sleep_intervall;

    while (check_process_running($task->{pid}, $task->{pstart})) {

	if (time >= $next_time && $waitfunc && ref($waitfunc) eq 'CODE'){
	    &$waitfunc($task);
	    $next_time = time + $sleep_intervall;
	}

	CORE::sleep(1);
    }
}

# struct ifreq { // FOR SIOCGIFFLAGS:
#   char ifrn_name[IFNAMSIZ]
#   short ifru_flags
# };
my $STRUCT_IFREQ_SIOCGIFFLAGS = 'Z' . IFNAMSIZ . 's1';
sub get_active_network_interfaces {
    # Use the interface name list from /proc/net/dev
    open my $fh, '<', '/proc/net/dev'
	or die "failed to open /proc/net/dev: $!\n";
    # And filter by IFF_UP flag fetched via a PF_INET6 socket ioctl:
    my $sock;
    socket($sock, PF_INET6, SOCK_DGRAM, &IPPROTO_IP)
    or socket($sock, PF_INET, SOCK_DGRAM, &IPPROTO_IP)
    or return [];

    my $ifaces = [];
    while(defined(my $line = <$fh>)) {
	next if $line !~ /^\s*([^:\s]+):/;
	my $ifname = $1;
	my $ifreq = pack($STRUCT_IFREQ_SIOCGIFFLAGS, $ifname, 0);
	if (!defined(ioctl($sock, SIOCGIFFLAGS, $ifreq))) {
	    warn "failed to get interface flags for: $ifname\n";
	    next;
	}
	my ($name, $flags) = unpack($STRUCT_IFREQ_SIOCGIFFLAGS, $ifreq);
	push @$ifaces, $ifname if ($flags & IFF_UP);
    }
    close $fh;
    close $sock;
    return $ifaces;
}

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