tc.pm

# OpenTrafficShaper Linux tc traffic shaping
# Copyright (C) 2007-2015, AllWorldIT
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.



package opentrafficshaper::plugins::tc;

use strict;
use warnings;

use POE qw(
	Wheel::Run Filter::Line
);

use awitpt::util qw(
	toHex
);
use opentrafficshaper::constants;
use opentrafficshaper::logger;
use opentrafficshaper::plugins::configmanager qw(
	getPool
	getPoolAttribute
	setPoolAttribute
	removePoolAttribute
	getPoolTxInterface
	getPoolRxInterface
	setPoolShaperState
	unsetPoolShaperState
	getPoolShaperState

	getEffectivePool

	getPoolMember
	setPoolMemberAttribute
	getPoolMemberAttribute
	removePoolMemberAttribute
	getPoolMemberMatchPriority
	setPoolMemberShaperState
	unsetPoolMemberShaperState
	getPoolMemberShaperState

	getTrafficClassPriority

	getAllTrafficClasses

	getInterface
	getInterfaces
	getInterfaceDefaultPool
	getEffectiveInterfaceTrafficClass2
	isInterfaceTrafficClassValid
	setInterfaceTrafficClassShaperState
	unsetInterfaceTrafficClassShaperState
);


# Exporter stuff
require Exporter;
our (@ISA,@EXPORT,@EXPORT_OK);
@ISA = qw(Exporter);
@EXPORT = qw(
);
@EXPORT_OK = qw(
);

use constant {
	VERSION => '0.1.2',

	# 5% of a link can be used for very high priority traffic
	PROTO_RATE_LIMIT => 5,
	PROTO_RATE_BURST_MIN => 16, # With a minimum burst of 8KiB
	PROTO_RATE_BURST_MAXM => 1.5, # Multiplier for burst min to get to burst max

	# High priority traffic gets the first 20% of the bandidth to itself
	PRIO_RATE_LIMIT => 20,
	PRIO_RATE_BURST_MIN => 32, # With a minimum burst of 40KiB
	PRIO_RATE_BURST_MAXM => 1.5, # Multiplier for burst min to get to burst max

	TC_ROOT_CLASS => 1,
};


# Plugin info
our $pluginInfo = {
	Name => "Linux tc Interface",
	Version => VERSION,

	Init => \&plugin_init,
	Start => \&plugin_start,
};


# Our globals
my $globals;
# Copy of system logger
my $logger;

# Our configuration
my $config = {
	'ip_protocol' => "ip",
	'iphdr_offset' => 0,
};

#
# TASK QUEUE
#
# $globals->{'TaskQueue'}

#
# TC CLASSES & FILTERS
#
# $globals->{'TcClasses'}
# $globals->{'TcFilterMappings'}
# $globals->{'TcFilters'}


# Initialize plugin
sub plugin_init
{
	my $system = shift;


	# Setup our environment
	$logger = $system->{'logger'};

	$logger->log(LOG_NOTICE,"[TC] OpenTrafficShaper tc Integration v%s - Copyright (c) 2007-2014, AllWorldIT",VERSION);

	# Initialize
	$globals->{'TaskQueue'} = [ ];
	$globals->{'TcClasses'} = { };
	$globals->{'TcFilterMappings'} = { };
	$globals->{'TcFilters'} = { };

	# Grab some of our config we need
	if (defined(my $proto = $system->{'file.config'}->{'plugin.tc'}->{'protocol'})) {
		$logger->log(LOG_INFO,"[TC] Set protocol to '%s'",$proto);
		$config->{'ip_protocol'} = $proto;
	}
	if (defined(my $offset = $system->{'file.config'}->{'plugin.tc'}->{'iphdr_offset'})) {
		$logger->log(LOG_INFO,"[TC] Set IP header offset to '%s'",$offset);
		$config->{'iphdr_offset'} = $offset;
	}


	# We going to queue the initialization in plugin initialization so nothing at all can come before us
	my $changeSet = TC::ChangeSet->new();
	# Loop with the configured interfaces and initialize them
	foreach my $interfaceID (getInterfaces()) {
		my $interface = getInterface($interfaceID);
		# Initialize interface
		$logger->log(LOG_INFO,"[TC] Queuing tasks to initialize '%s'",$interface->{'Device'});
		_tc_iface_init($changeSet,$interfaceID);
	}
	_task_add_to_queue($changeSet);


	# This session is our main session, its alias is "shaper"
	POE::Session->create(
		inline_states => {
			_start => \&_session_start,
			_stop => \&_session_stop,

			class_change => \&_session_class_change,

			pool_add => \&_session_pool_add,
			pool_remove => \&_session_pool_remove,
			pool_change => \&_session_pool_change,

			poolmember_add => \&_session_poolmember_add,
			poolmember_remove => \&_session_poolmember_remove,
		}
	);

	# This is our session for communicating directly with tc, its alias is _tc
	POE::Session->create(
		inline_states => {
			_start => \&_task_session_start,
			_stop => sub { },
			# Signals
			_SIGCHLD => \&_task_SIGCHLD,
			_SIGINT => \&_task_SIGINT,

			# Public'ish
			queue => \&_task_queue,

			# Internal
			_task_child_stdout => \&_task_child_stdout,
			_task_child_stderr => \&_task_child_stderr,
			_task_child_stdin => \&_task_child_stdin,
			_task_child_close => \&_task_child_close,
			_task_child_error => \&_task_child_error,
			_task_run_next => \&_task_run_next,
		}
	);

	return 1;
}



# Start the plugin
sub plugin_start
{
	$logger->log(LOG_INFO,"[TC] Started");
}



# Initialize this plugins main POE session
sub _session_start
{
	my ($kernel,$heap) = @_[KERNEL,HEAP];


	# Set our alias
	$kernel->alias_set("shaper");

	$logger->log(LOG_DEBUG,"[TC] Initialized");
}



# Initialize this plugins main POE session
sub _session_stop
{
	my ($kernel,$heap) = @_[KERNEL,HEAP];


	# Remove our alias
	$kernel->alias_remove("shaper");

	# Blow away data
	$globals = undef;

	$logger->log(LOG_DEBUG,"[TC] Shutdown");

	$logger = undef;
}



# Event handler for changing a class
sub _session_class_change
{
	my ($kernel, $interfaceTrafficClassID) = @_[KERNEL, ARG0, ARG1];


	# Grab our effective class
	my $effectiveInterfaceTrafficClass = getEffectiveInterfaceTrafficClass2($interfaceTrafficClassID);

	# Grab interface ID
	my $interfaceID = $effectiveInterfaceTrafficClass->{'InterfaceID'};
	# Grab interface from config manager
	my $interface = getInterface($interfaceID);

	# Grab traffic class ID
	my $trafficClassID = $effectiveInterfaceTrafficClass->{'TrafficClassID'};

	$logger->log(LOG_INFO,"[TC] Processing interface class changes for '%s' traffic class ID '%s'",
			$interface->{'Device'},
			$trafficClassID
	);

	# Grab tc interface
	my $tcInterface = $globals->{'Interfaces'}->{$interfaceID};
	# Grab interface traffic class
	my $interfaceTrafficClass = $tcInterface->{'TrafficClasses'}->{$trafficClassID};

	# Grab the traffic class
	my $majorTcClass = $tcInterface->{'TcClass'};
	my $minorTcClass = $interfaceTrafficClass->{"TcClass"};

	# Generate changeset
	my $changeSet = TC::ChangeSet->new();

	# If we're a normal class we are treated differently than if we're a main/root class below (interface main speed)
	if ($minorTcClass > 1) {
		_tc_class_change($changeSet,$interfaceID,$majorTcClass,"",$minorTcClass,
				$effectiveInterfaceTrafficClass->{'CIR'},
				$effectiveInterfaceTrafficClass->{'Limit'}
		);
	# XXX: This will be the actual interface, we set limit and burst to the same
	} else {
		_tc_class_change($changeSet,$interfaceID,TC_ROOT_CLASS,"",$minorTcClass,$effectiveInterfaceTrafficClass->{'Limit'});
	}

	# Post changeset
	$kernel->post("_tc" => "queue" => $changeSet);

	# Mark as live
	unsetInterfaceTrafficClassShaperState($interfaceTrafficClassID,SHAPER_NOTLIVE|SHAPER_PENDING);
	setInterfaceTrafficClassShaperState($interfaceTrafficClassID,SHAPER_LIVE);
}



# Event handler for adding a pool
sub _session_pool_add
{
	my ($kernel,$heap,$pid) = @_[KERNEL, HEAP, ARG0];


	# Grab pool
	my $pool;
	if (!defined($pool = getPool($pid))) {
		$logger->log(LOG_ERR,"[TC] Shaper 'add' event with non existing pool '%s'",$pid);
		return;
	}

	$logger->log(LOG_INFO,"[TC] Add pool '%s' [%s] to interface group '%s'",
			$pool->{'Name'},
			$pool->{'ID'},
			$pool->{'InterfaceGroupID'},
	);

	# Grab our effective pool
	my $effectivePool = getEffectivePool($pool->{'ID'});

	my $changeSet = TC::ChangeSet->new();

	# Grab some things we need from the main pool
	my $txInterfaceID = getPoolTxInterface($pool->{'ID'});
	my $rxInterfaceID = getPoolRxInterface($pool->{'ID'});

	# Grab effective config
	my $trafficClassID = $effectivePool->{'TrafficClassID'};
	my $txCIR = $effectivePool->{'TxCIR'};
	my $txLimit = $effectivePool->{'TxLimit'};
	my $rxCIR = $effectivePool->{'RxCIR'};
	my $rxLimit = $effectivePool->{'RxLimit'};
	my $trafficPriority = getTrafficClassPriority($effectivePool->{'TrafficClassID'});

	# Get the Tx traffic classes TC class
	my $tcClass_TxTrafficClass = _getTcClassFromTrafficClassID($txInterfaceID,$trafficClassID);
	# Generate our pools Tx TC class
	my $tcClass_TxPool = _reserveMinorTcClassByPoolID($txInterfaceID,$pool->{'ID'});
	# Add the main Tx TC class for this pool
	_tc_class_add($changeSet,$txInterfaceID,TC_ROOT_CLASS,$tcClass_TxTrafficClass,$tcClass_TxPool,$txCIR,
			$txLimit,$trafficPriority
	);
	# Add Tx TC optimizations
	_tc_class_optimize($changeSet,$txInterfaceID,$tcClass_TxPool,$txCIR);
	# Set Tx TC class
	setPoolAttribute($pool->{'ID'},'tc.txclass',$tcClass_TxPool);

	# Get the Rx traffic classes TC class
	my $tcClass_RxTrafficClass = _getTcClassFromTrafficClassID($rxInterfaceID,$trafficClassID);
	# Generate our pools Rx TC class
	my $tcClass_RxPool = _reserveMinorTcClassByPoolID($rxInterfaceID,$pool->{'ID'});
	# Add the main Rx TC class for this pool
	_tc_class_add($changeSet,$rxInterfaceID,TC_ROOT_CLASS,$tcClass_RxTrafficClass,$tcClass_RxPool,$rxCIR,
			$rxLimit,$trafficPriority
	);
	# Add Rx TC optimizations
	_tc_class_optimize($changeSet,$rxInterfaceID,$tcClass_RxPool,$rxCIR);
	# Set Rx TC
	setPoolAttribute($pool->{'ID'},'tc.rxclass',$tcClass_RxPool);

	# Post changeset
	$kernel->post("_tc" => "queue" => $changeSet);

	# Set current live values
	setPoolAttribute($pool->{'ID'},'shaper.live.ClassID',$trafficClassID);
	setPoolAttribute($pool->{'ID'},'shaper.live.TxCIR',$txCIR);
	setPoolAttribute($pool->{'ID'},'shaper.live.TxLimit',$txLimit);
	setPoolAttribute($pool->{'ID'},'shaper.live.RxCIR',$rxCIR);
	setPoolAttribute($pool->{'ID'},'shaper.live.RxLimit',$rxLimit);

	# Mark as live
	unsetPoolShaperState($pool->{'ID'},SHAPER_NOTLIVE|SHAPER_PENDING);
	setPoolShaperState($pool->{'ID'},SHAPER_LIVE);
}



# Event handler for removing a pool
sub _session_pool_remove
{
	my ($kernel, $pid) = @_[KERNEL, ARG0];


	my $changeSet = TC::ChangeSet->new();

	# Pull in pool
	my $pool;
	if (!defined($pool = getPool($pid))) {
		$logger->log(LOG_ERR,"[TC] Shaper 'remove' event with non existing pool '%s'",$pid);
		return;
	}

	# Make sure its not NOTLIVE
	if (getPoolShaperState($pid) & SHAPER_NOTLIVE) {
		$logger->log(LOG_WARN,"[TC] Ignoring remove for pool '%s' [%s]",
				$pool->{'Name'},
				$pool->{'ID'}
		);
		return;
	}

	$logger->log(LOG_INFO,"[TC] Removing pool '%s' [%s]",
			$pool->{'Name'},
			$pool->{'ID'}
	);

	# Grab our interfaces
	my $txInterfaceID = getPoolTxInterface($pool->{'ID'});
	my $rxInterfaceID = getPoolRxInterface($pool->{'ID'});
	# Grab the traffic class from the pool
	my $txPoolTcClass = getPoolAttribute($pool->{'ID'},'tc.txclass');
	my $rxPoolTcClass = getPoolAttribute($pool->{'ID'},'tc.rxclass');

	# Grab current class ID
	my $trafficClassID = getPoolAttribute($pool->{'ID'},'shaper.live.ClassID');
	# Grab our minor classes
	my $txTrafficClassTcClass = _getTcClassFromTrafficClassID($txInterfaceID,$trafficClassID);
	my $rxTrafficClassTcClass = _getTcClassFromTrafficClassID($rxInterfaceID,$trafficClassID);

	my $txInterface = getInterface($txInterfaceID);
	my $rxInterface = getInterface($rxInterfaceID);

	# Clear up the class
	$changeSet->add([
			'/sbin/tc','class','del',
				'dev',$txInterface->{'Device'},
				'parent',"1:$txTrafficClassTcClass",
				'classid',"1:$txPoolTcClass",
	]);
	$changeSet->add([
			'/sbin/tc','class','del',
				'dev',$rxInterface->{'Device'},
				'parent',"1:$rxTrafficClassTcClass",
				'classid',"1:$rxPoolTcClass",
	]);

	# And recycle the classs
	_disposePoolTcClass($txInterface->{'Device'},$txPoolTcClass);
	_disposePoolTcClass($rxInterface->{'Device'},$rxPoolTcClass);

	_disposePrioTcClass($txInterface->{'Device'},$txPoolTcClass);
	_disposePrioTcClass($rxInterface->{'Device'},$rxPoolTcClass);

	# Post changeset
	$kernel->post("_tc" => "queue" => $changeSet);

	# Cleanup attributes
	removePoolAttribute($pool->{'ID'},'tc.txclass');
	removePoolAttribute($pool->{'ID'},'tc.rxclass');

	removePoolAttribute($pool->{'ID'},'shaper.live.ClassID');
	removePoolAttribute($pool->{'ID'},'shaper.live.TxCIR');
	removePoolAttribute($pool->{'ID'},'shaper.live.TxLimit');
	removePoolAttribute($pool->{'ID'},'shaper.live.RxCIR');
	removePoolAttribute($pool->{'ID'},'shaper.live.RxLimit');

	# Mark as not live
	unsetPoolShaperState($pool->{'ID'},SHAPER_LIVE|SHAPER_PENDING);
	setPoolShaperState($pool->{'ID'},SHAPER_NOTLIVE);
}



## Event handler for changing a pool
sub _session_pool_change
{
	my ($kernel, $pid) = @_[KERNEL, ARG0];


	# Grab pool
	my $pool = getPool($pid);

	$logger->log(LOG_INFO,"[TC] Processing changes for '%s' [%s]",$pool->{'Name'},$pool->{'ID'});

	# Grab our effective pool
	my $effectivePool = getEffectivePool($pool->{'ID'});

	# Grab our interfaces
	my $txInterfaceID = getPoolTxInterface($pool->{'ID'});
	my $rxInterfaceID = getPoolRxInterface($pool->{'ID'});
	# Grab the traffic class from the pool
	my $txPoolTcClass = getPoolAttribute($pool->{'ID'},'tc.txclass');
	my $rxPoolTcClass = getPoolAttribute($pool->{'ID'},'tc.rxclass');

	# Grab effective config
	my $trafficClassID = $effectivePool->{'TrafficClassID'};
	my $txCIR = $effectivePool->{'TxCIR'};
	my $txLimit = $effectivePool->{'TxLimit'};
	my $rxCIR = $effectivePool->{'RxCIR'};
	my $rxLimit = $effectivePool->{'RxLimit'};
	my $trafficPriority = getTrafficClassPriority($trafficClassID);

	# Grab our minor classes
	my $txTrafficClassTcClass = _getTcClassFromTrafficClassID($txInterfaceID,$trafficClassID);
	my $rxTrafficClassTcClass = _getTcClassFromTrafficClassID($rxInterfaceID,$trafficClassID);

	# Generate changeset
	my $changeSet = TC::ChangeSet->new();

	_tc_class_change($changeSet,$txInterfaceID,TC_ROOT_CLASS,$txTrafficClassTcClass,$txPoolTcClass,$txCIR,
			$txLimit,$trafficPriority);
	_tc_class_change($changeSet,$rxInterfaceID,TC_ROOT_CLASS,$rxTrafficClassTcClass,$rxPoolTcClass,$rxCIR,
			$rxLimit,$trafficPriority);

	# Post changeset
	$kernel->post("_tc" => "queue" => $changeSet);

	setPoolAttribute($pool->{'ID'},'shaper.live.ClassID',$trafficClassID);
	setPoolAttribute($pool->{'ID'},'shaper.live.TxCIR',$txCIR);
	setPoolAttribute($pool->{'ID'},'shaper.live.TxLimit',$txLimit);
	setPoolAttribute($pool->{'ID'},'shaper.live.RxCIR',$rxCIR);
	setPoolAttribute($pool->{'ID'},'shaper.live.RxLimit',$rxLimit);

	# Mark as live
	unsetPoolShaperState($pool->{'ID'},SHAPER_NOTLIVE|SHAPER_PENDING);
	setPoolShaperState($pool->{'ID'},SHAPER_LIVE);
}



# Event handler for adding a pool member
sub _session_poolmember_add
{
	my ($kernel,$heap,$pmid) = @_[KERNEL, HEAP, ARG0];


	# Grab pool
	my $poolMember;
	if (!defined($poolMember = getPoolMember($pmid))) {
		$logger->log(LOG_ERR,"[TC] Shaper 'add' event with non existing pool member '%s'",$pmid);
		return;
	}

	# Grab the pool members associated pool
	my $pool;
	if (!defined($pool = getPool($poolMember->{'PoolID'}))) {
		$logger->log(LOG_ERR,"[TC] Shaper 'poolmember_add' event with invalid PoolID");
		return;
	}

	$logger->log(LOG_INFO,"[TC] Add pool member '%s' [%s] with IP '%s' to pool '%s' [%s]",
			$poolMember->{'Username'},
			$poolMember->{'ID'},
			$poolMember->{'IPAddress'},
			$pool->{'Name'},
			$pool->{'ID'}
	);

	my $changeSet = TC::ChangeSet->new();

	# Filter levels for the IP components
	my @components = split(/\./,$poolMember->{'IPAddress'});
	my $ip1 = $components[0];
	my $ip2 = $components[1];
	my $ip3 = $components[2];
	my $ip4 = $components[3];
	# Hex IP components
	my $ip1Hex = sprintf('%02s',toHex($ip1));
	my $ip2Hex = sprintf('%02s',toHex($ip2));
	my $ip3Hex = sprintf('%02s',toHex($ip3));
	my $ip4Hex = sprintf('%02s',toHex($ip4));

	# Grab some variables we going to need below
	my $txInterfaceID = getPoolTxInterface($pool->{'ID'});
	my $rxInterfaceID = getPoolRxInterface($pool->{'ID'});
	my $trafficPriority = getTrafficClassPriority($pool->{'TrafficClassID'});
	my $matchPriority = getPoolMemberMatchPriority($poolMember->{'ID'});

	# Check if we have a entry for the /8, if not we must create our 2nd level hash table and link it
	if (!defined($globals->{'TcFilterMappings'}->{$txInterfaceID}->{'dst'}->{$matchPriority}->{$ip1})) {
		# Grab filter ID's for 2nd level
		my $filterID = _reserveTcFilter($txInterfaceID,$matchPriority,$pool->{'ID'});
		# Track our mapping
		$globals->{'TcFilterMappings'}->{$txInterfaceID}->{'dst'}->{$matchPriority}->{$ip1}->{'id'} = $filterID;
		$logger->log(LOG_DEBUG,"[TC] Linking 2nd level TX hash table to '%s' to '%s.0.0.0/8', priority '%s'",
				$filterID,
				$ip1,
				$matchPriority
		);
		_tc_filter_add_dstlink($changeSet,$txInterfaceID,TC_ROOT_CLASS,$matchPriority,$filterID,$config->{'ip_protocol'},800,"",
				"$ip1.0.0.0/8","00ff0000");
	}
	if (!defined($globals->{'TcFilterMappings'}->{$rxInterfaceID}->{'src'}->{$matchPriority}->{$ip1})) {
		# Grab filter ID's for 2nd level
		my $filterID = _reserveTcFilter($rxInterfaceID,$matchPriority,$pool->{'ID'});
		# Track our mapping
		$globals->{'TcFilterMappings'}->{$rxInterfaceID}->{'src'}->{$matchPriority}->{$ip1}->{'id'} = $filterID;
		$logger->log(LOG_DEBUG,"[TC] Linking 2nd level RX hash table to '%s' to '%s.0.0.0/8', priority '%s'",
				$filterID,
				$ip1,
				$matchPriority
		);
		_tc_filter_add_srclink($changeSet,$rxInterfaceID,TC_ROOT_CLASS,$matchPriority,$filterID,$config->{'ip_protocol'},800,"",
				"$ip1.0.0.0/8","00ff0000");
	}

	# Check if we have our /16 hash entry, if not we must create the 3rd level hash table
	if (!defined($globals->{'TcFilterMappings'}->{$txInterfaceID}->{'dst'}->{$matchPriority}->{$ip1}->{$ip2})) {
		# Grab filter ID's for 3rd level
		my $filterID = _reserveTcFilter($txInterfaceID,$matchPriority,$pool->{'ID'});
		# Track our mapping
		$globals->{'TcFilterMappings'}->{$txInterfaceID}->{'dst'}->{$matchPriority}->{$ip1}->{$ip2}->{'id'} = $filterID;
		# Grab some hash table ID's we need
		my $ip1HtHex = $globals->{'TcFilterMappings'}->{$txInterfaceID}->{'dst'}->{$matchPriority}->{$ip1}->{'id'};
		$logger->log(LOG_DEBUG,"[TC] Linking 3rd level TX hash table to '%s' to '%s.%s.0.0/16', priority '%s'",
				$filterID,
				$ip1,
				$ip2,
				$matchPriority
		);
		_tc_filter_add_dstlink($changeSet,$txInterfaceID,TC_ROOT_CLASS,$matchPriority,$filterID,$config->{'ip_protocol'},$ip1HtHex,
				$ip2Hex,"$ip1.$ip2.0.0/16","0000ff00");
	}
	if (!defined($globals->{'TcFilterMappings'}->{$rxInterfaceID}->{'src'}->{$matchPriority}->{$ip1}->{$ip2})) {
		# Grab filter ID's for 3rd level
		my $filterID = _reserveTcFilter($rxInterfaceID,$matchPriority,$pool->{'ID'});
		# Track our mapping
		$globals->{'TcFilterMappings'}->{$rxInterfaceID}->{'src'}->{$matchPriority}->{$ip1}->{$ip2}->{'id'} = $filterID;
		# Grab some hash table ID's we need
		my $ip1HtHex = $globals->{'TcFilterMappings'}->{$rxInterfaceID}->{'src'}->{$matchPriority}->{$ip1}->{'id'};
		$logger->log(LOG_DEBUG,"[TC] Linking 3rd level RX hash table to '%s' to '%s.%s.0.0/16', priority '%s'",
				$filterID,
				$ip1,
				$ip2,
				$matchPriority
		);
		_tc_filter_add_srclink($changeSet,$rxInterfaceID,TC_ROOT_CLASS,$matchPriority,$filterID,$config->{'ip_protocol'},$ip1HtHex,
				$ip2Hex,"$ip1.$ip2.0.0/16","0000ff00");
	}

	# Check if we have our /24 hash entry, if not we must create the 4th level hash table
	if (!defined($globals->{'TcFilterMappings'}->{$txInterfaceID}->{'dst'}->{$matchPriority}->{$ip1}->{$ip2}->{$ip3})) {
		# Grab filter ID's for 4th level
		my $filterID = _reserveTcFilter($txInterfaceID,$matchPriority,$pool->{'ID'});
		# Track our mapping
		$globals->{'TcFilterMappings'}->{$txInterfaceID}->{'dst'}->{$matchPriority}->{$ip1}->{$ip2}->{$ip3}->{'id'} = $filterID;
		# Grab some hash table ID's we need
		my $ip2HtHex = $globals->{'TcFilterMappings'}->{$txInterfaceID}->{'dst'}->{$matchPriority}->{$ip1}->{$ip2}->{'id'};
		$logger->log(LOG_DEBUG,"[TC] Linking 4th level TX hash table to '%s' to '%s.%s.%s.0/24', priority '%s'",
				$filterID,
				$ip1,
				$ip2,
				$ip3,
				$matchPriority
		);
		_tc_filter_add_dstlink($changeSet,$txInterfaceID,TC_ROOT_CLASS,$matchPriority,$filterID,$config->{'ip_protocol'},$ip2HtHex,
				$ip3Hex,"$ip1.$ip2.$ip3.0/24","000000ff");
	}
	if (!defined($globals->{'TcFilterMappings'}->{$rxInterfaceID}->{'src'}->{$matchPriority}->{$ip1}->{$ip2}->{$ip3})) {
		# Grab filter ID's for 4th level
		my $filterID = _reserveTcFilter($rxInterfaceID,$matchPriority,$pool->{'ID'});
		# Track our mapping
		$globals->{'TcFilterMappings'}->{$rxInterfaceID}->{'src'}->{$matchPriority}->{$ip1}->{$ip2}->{$ip3}->{'id'} = $filterID;
		# Grab some hash table ID's we need
		my $ip2HtHex = $globals->{'TcFilterMappings'}->{$rxInterfaceID}->{'src'}->{$matchPriority}->{$ip1}->{$ip2}->{'id'};
		$logger->log(LOG_DEBUG,"[TC] Linking 4th level RX hash table to '%s' to '%s.%s.%s.0/24', priority '%s'",
				$filterID,
				$ip1,
				$ip2,
				$ip3,
				$matchPriority
		);
		_tc_filter_add_srclink($changeSet,$rxInterfaceID,TC_ROOT_CLASS,$matchPriority,$filterID,$config->{'ip_protocol'},$ip2HtHex,
				$ip3Hex,"$ip1.$ip2.$ip3.0/24","000000ff");
	}

	#
	# For sake of simplicity and so things loook all nice and similar, we going to do these 2 blocks in { }
	#

	# Only if we have TX limits setup process them
	{
		# Get the TX class
		my $tcClass_trafficClass = getPoolAttribute($pool->{'ID'},'tc.txclass');
		# Grab some hash table ID's we need
		my $ip3HtHex = $globals->{'TcFilterMappings'}->{$txInterfaceID}->{'dst'}->{$matchPriority}->{$ip1}->{$ip2}->{$ip3}->{'id'};
		$logger->log(LOG_DEBUG,"[TC] Linking pool member IP '%s' to class '%s' at hash endpoint '%s:%s'",
				$poolMember->{'IPAddress'},
				$tcClass_trafficClass,
				$ip3HtHex,
				$ip4Hex
		);

		# Link filter to traffic flow (class)
		_tc_filter_add_flowlink($changeSet,$txInterfaceID,TC_ROOT_CLASS,$trafficPriority,$config->{'ip_protocol'},$ip3HtHex,
				$ip4Hex,"dst",16,$poolMember->{'IPAddress'},$tcClass_trafficClass);

		# Save pool member filter ID
		setPoolMemberAttribute($poolMember->{'ID'},'tc.txfilter',"${ip3HtHex}:${ip4Hex}:1");
	}
	# Only if we have RX limits setup process them
	{
		# Generate our limit TC class
		my $tcClass_trafficClass = getPoolAttribute($pool->{'ID'},'tc.rxclass');
		# Grab some hash table ID's we need
		my $ip3HtHex = $globals->{'TcFilterMappings'}->{$rxInterfaceID}->{'src'}->{$matchPriority}->{$ip1}->{$ip2}->{$ip3}->{'id'};
		$logger->log(LOG_DEBUG,"[TC] Linking RX IP '%s' to class '%s' at hash endpoint '%s:%s'",
				$poolMember->{'IPAddress'},
				$tcClass_trafficClass,
				$ip3HtHex,
				$ip4Hex
		);

		# Link filter to traffic flow (class)
		_tc_filter_add_flowlink($changeSet,$rxInterfaceID,TC_ROOT_CLASS,$trafficPriority,$config->{'ip_protocol'},$ip3HtHex,
				$ip4Hex,"src",12,$poolMember->{'IPAddress'},$tcClass_trafficClass);

		# Save pool member filter ID
		setPoolMemberAttribute($poolMember->{'ID'},'tc.rxfilter',"${ip3HtHex}:${ip4Hex}:1");
	}

	# Post changeset
	$kernel->post("_tc" => "queue" => $changeSet);

	# Mark pool member as live
	unsetPoolMemberShaperState($poolMember->{'ID'},SHAPER_NOTLIVE|SHAPER_PENDING);
	setPoolMemberShaperState($poolMember->{'ID'},SHAPER_LIVE);
}



# Event handler for removing a pool member
sub _session_poolmember_remove
{
	my ($kernel, $pmid) = @_[KERNEL, ARG0];


	# Pull in pool member
	my $poolMember;
	if (!defined($poolMember = getPoolMember($pmid))) {
		$logger->log(LOG_ERR,"[TC] Shaper 'remove' event with non existing pool member '%s'",$pmid);
		return;
	}

	# Grab the pool members associated pool
	my $pool = getPool($poolMember->{'PoolID'});

	# Make sure its not NOTLIVE
	if (getPoolMemberShaperState($pmid) & SHAPER_NOTLIVE) {
		$logger->log(LOG_WARN,"[TC] Ignoring remove for pool member '%s' with IP '%s' [%s] from pool '%s'",
				$poolMember->{'Username'},
				$poolMember->{'IPAddress'},
				$poolMember->{'ID'},
				$pool->{'Name'}
		);
		return;
	}

	$logger->log(LOG_INFO,"[TC] Remove pool member '%s' [%s] with IP '%s' from pool '%s' [%s]",
			$poolMember->{'Username'},
			$poolMember->{'ID'},
			$poolMember->{'IPAddress'},
			$pool->{'Name'},
			$pool->{'ID'}
	);

	# Grab our interfaces
	my $txInterfaceID = getPoolTxInterface($pool->{'ID'});
	my $rxInterfaceID = getPoolRxInterface($pool->{'ID'});
	# Grab the filter ID's from the pool member which is linked to the traffic class
	my $txFilter = getPoolMemberAttribute($poolMember->{'ID'},'tc.txfilter');
	my $rxFilter = getPoolMemberAttribute($poolMember->{'ID'},'tc.rxfilter');

	# Grab current class ID
	my $trafficClassID = getPoolAttribute($pool->{'ID'},'shaper.live.ClassID');
	my $trafficPriority = getTrafficClassPriority($trafficClassID);

	my $txInterface = getInterface($txInterfaceID);
	my $rxInterface = getInterface($rxInterfaceID);

	my $changeSet = TC::ChangeSet->new();

	# Clear up the filter
	$changeSet->add([
			'/sbin/tc','filter','del',
				'dev',$txInterface->{'Device'},
				'parent','1:',
				'prio',$trafficPriority,
				'handle',$txFilter,
				'protocol',$config->{'ip_protocol'},
				'u32',
	]);
	$changeSet->add([
			'/sbin/tc','filter','del',
				'dev',$rxInterface->{'Device'},
				'parent','1:',
				'prio',$trafficPriority,
				'handle',$rxFilter,
				'protocol',$config->{'ip_protocol'},
				'u32',
	]);

	# Post changeset
	$kernel->post("_tc" => "queue" => $changeSet);

	# Cleanup attributes
	removePoolMemberAttribute($poolMember->{'ID'},'tc.txfilter');
	removePoolMemberAttribute($poolMember->{'ID'},'tc.rxfilter');

	# Mark as not live
	unsetPoolMemberShaperState($poolMember->{'ID'},SHAPER_LIVE|SHAPER_PENDING);
	setPoolMemberShaperState($poolMember->{'ID'},SHAPER_NOTLIVE);
}



# Grab pool ID from TC class
sub getPIDFromTcClass
{
	my ($interfaceID,$majorTcClass,$minorTcClass) = @_;


	# Return the pool ID if found
	my $ref = __getRefByMinorTcClass($interfaceID,$majorTcClass,$minorTcClass);
	if (!defined($ref) || substr($ref,0,13) ne "_pool_class_:") {
		return;
	}

	return substr($ref,13);
}



# Function to return if this is linked to a pool's class
sub isPoolTcClass
{
	my ($interfaceID,$majorTcClass,$minorTcClass) = @_;


	my $pid = getPIDFromTcClass($interfaceID,$majorTcClass,$minorTcClass);
	if (!defined($pid)) {
		return;
	}

	return $minorTcClass;
}



# Return the ClassID from a TC class
# This is similar to isTcTrafficClassValid() but returns the ref, not the minor class
sub getCIDFromTcClass
{
	my ($interfaceID,$majorTcClass,$minorTcClass) = @_;


	# Grab ref
	my $ref = __getRefByMinorTcClass($interfaceID,$majorTcClass,$minorTcClass);

	# If we're undefined return
	if (!defined($ref)) {
		return;
	}

	# If we're not a traffic class, just return
	if (substr($ref,0,16) ne "_traffic_class_:") {
		return;
	}

	# Else return the part after the above tag
	return substr($ref,16);
}


#
# Internal functions
#


# Function to initialize an interface
sub _tc_iface_init
{
	my ($changeSet,$interfaceID) = @_;


	# Grab our interface rate
	my $interface = getInterface($interfaceID);

### --- Interface Setup

	# Clear the qdisc from the interface
	$changeSet->add([
			'/sbin/tc','qdisc','del',
				'dev',$interface->{'Device'},
				'root',
	]);

	# Initialize the major TC class
	my $interfaceTcClass = _reserveMajorTcClass($interfaceID,"root");

	# Set interface RootClass
	$globals->{'Interfaces'}->{$interfaceID} = {
		'TcClass' => $interfaceTcClass
	};

### --- Interface Traffic Class Setup

	# Reserve our parent TC classes
	my @trafficClasses = getAllTrafficClasses();
	foreach my $trafficClassID (sort {$a <=> $b} @trafficClasses) {
		# Record the class we get for this interface traffic class ID
		my $interfaceTrafficClassTcClass = _reserveMinorTcClassByTrafficClassID($interfaceID,$trafficClassID);
	}

	# Do we have a default pool? if so we must direct traffic there
	my @qdiscOpts = ( );
	my $defaultPool = getInterfaceDefaultPool($interfaceID);
	my $defaultPoolTcClass;
	if (defined($defaultPool)) {
		# Push unclassified traffic to this class
		$defaultPoolTcClass = _getTcClassFromTrafficClassID($interfaceID,$defaultPool);
		push(@qdiscOpts,'default',$defaultPoolTcClass);
	}


### --- Interface Setup Part 2

	# Add root qdisc
	$changeSet->add([
			'/sbin/tc','qdisc','add',
				'dev',$interface->{'Device'},
				'root',
				'handle','1:',
				'htb',
					@qdiscOpts
	]);

	# Attach our main limit on the qdisc
	my $burst = int($interface->{'Limit'}/8); # Allow the entire interface to be emptied with a burst
	$changeSet->add([
			'/sbin/tc','class','add',