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

package PVE::ProcFSTools;

use strict;
use warnings;
use POSIX;
use Time::HiRes qw (gettimeofday);
use IO::File;
use PVE::Tools;
use Cwd qw();

use Socket qw(PF_INET PF_INET6 SOCK_DGRAM IPPROTO_IP);

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 $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) {
	    $idhash->{$1} = 1;
	}
    }

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

    $res->{sockets} = scalar(keys %$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, '', '');
}

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;
}

my $last_proc_stat;

sub read_proc_stat {
    my $res = { user => 0, nice => 0, system => 0, idle => 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|) {
		$res->{user} = $1;
		$res->{nice} = $2;
		$res->{system} = $3;
		$res->{idle} = $4;
		$res->{used} = $1+$2+$3;
		$res->{iowait} = $5;
	    } elsif ($line =~ m|^cpu\d+\s|) {
		$cpucount++;
	    }
	}
	$fh->close;
    }

    $cpucount = 1 if !$cpucount;

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

    $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;
	$res->{cpu} = $useddiff/$diff;

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

	$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,
    };

    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");
    $res->{memshared} = int($spages) * 4096;

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